lotto_tom75
Advanced Premium Member
Piccola rivisitazione di test...
Codice:
Option Explicit
'piccola rivisitazione by lottotom75 dello script del maestro i legend creato x cinzia
'in questa versione si cerca di verificare gli esiti dei clp voluti della
'coppia di ambi consecutivi aventi somma massima dei rispettivi rit x A su TT
'nessuna certezza e solo poca probabilità per gli eventuali output risultanti
'volendo si può integrare con la base numerica di confronto già predisposta
'e selezionabile da tabella colorata (per il momento disattivata-commentata)
Sub Main
Dim i,j,m,k,E
Dim nColT
Dim nConv
Dim aR(1)
Dim aAmbi(89)
Dim sConv
Dim IniRange,FinRange
IniRange = 1
FinRange = EstrazioneFin
nColT = Combinazioni(89,2)
ReDim aStat(nColT,3)
aR(1) = 11
Dim sortediverifica
sortediverifica = 2
Dim Valoredesiderato
Dim Basenumericadiconfronto
Dim anum
'Basenumericadiconfronto = ScegliNumeri(anum)
'Scrivi
'Scrivi "Base numerica di confronto "
'Scrivi
Dim d
'For d = 0 To UBound(anum)
' Scrivi anum(d) & ".",,False
'Next
Scrivi
Dim coppiedocbyfiltrovoluto
coppiedocbyfiltrovoluto = Array(0)
Dim Estrazioneprogressiva
Dim Inizioanalisi
Dim fine
Dim quanticasianalizzare
Dim sommaritmax
Dim colpomaxrilevato
colpomaxrilevato = 0
Dim crtminrilevato
crtminrilevato = EstrazioneFin
Dim Formazioneconcrtminrilevato
Formazioneconcrtminrilevato = Array(0)
Dim Formazioneconsommaritardimax
Formazioneconsommaritardimax = Array(0)
Dim colpiteoricirestantirispettocolpomaxrilevato
Dim casipositivi
Dim casinegativi
Dim casincorso
casipositivi = 0
casinegativi = 0
casincorso = 0
Dim entroclp1,entroclp2,entroclp3,entroclp4,entroclp5,entroclp6,entroclp7,entroclp8,entroclp9,entroclp10,entroclp11
Dim entroclp12,entroclp13,entroclp14,entroclp15,entroclp16,entroclp17,entroclp18,entroclp19,entroclp20,entroclp21,entroclp22
Dim entroclp23,entroclp24,entroclp25,entroclp26,entroclp27,entroclp28,entroclp29,entroclp30,entroclp31,entroclp32
Dim entroclp33,entroclp34,entroclp35,entroclp36,entroclp37,entroclp38,entroclp39,entroclp40,entroclp41,entroclp42,entroclp43
Dim entroclp44,entroclp45,entroclp46,entroclp47,entroclp48,entroclp49,entroclp50,entroclp51,entroclp52,entroclp53,entroclp54
Dim entroclp55,entroclp56,entroclp57,entroclp58,entroclp59,entroclp60
Dim contatorematch1
Dim contatorematch2
contatorematch1 = 0
contatorematch2 = 0
Dim colpidiverifica,Esitoverifica,Entroilcolpo,Estratti,idestrazsfald
colpidiverifica = 60
quanticasianalizzare = InputBox("Quanti casi analizzare","quanti casi",90)
fine = InputBox("Estrazione finale","estrazione finale",EstrazioneFin)
Inizioanalisi = fine - quanticasianalizzare
Dim Es
Es = 0
For Estrazioneprogressiva = Inizioanalisi To fine
Scrivi
Scrivi "<font size=3>Estrazione n. " & Estrazioneprogressiva & " N. " & Es & " </font>"
Scrivi
Es = Es + 1
Call ResetTimer
Call CaricaArrayAmbiConsecutivi(aAmbi)
m = 0
For i = 1 To UBound(aAmbi) - 1
If ScriptInterrotto Then Exit For
ReDim aRit(0),aIdE(0)
Call ElencoRitardiTurbo(aAmbi(i),aR,2,IniRange,Estrazioneprogressiva,aRit,aIdE)
For j = i + 1 To UBound(aAmbi)
If ScriptInterrotto Then Exit For
ReDim aRit1(0),aIdE1(0)
Call ElencoRitardiTurbo(aAmbi(j),aR,2,IniRange,Estrazioneprogressiva,aRit1,aIdE1)
m = m + 1
nConv = 0
sConv = ""
For k = 1 To UBound(aIdE1) - 1
If ScriptInterrotto Then Exit For
E = aIdE1(k)
If RicercaElementoInLista(aIdE,E) = 1 Then ' non cambiare questa riga =1 è il risultato che la funzione da se l elemento è presente nella lista
nConv = nConv + 1
sConv = sConv & E & ";"
End If
Next
Dim sommaritardi
sommaritardi = Int(FormatSpace(aRit(UBound(aRit)),3)) + Int(FormatSpace(aRit1(UBound(aRit1)),3))
If sommaritardi > sommaritmax Then
sommaritmax = sommaritardi
Erase Formazioneconsommaritardimax
Formazioneconsommaritardimax = Array(0)
Formazioneconsommaritardimax = array_push(Formazioneconsommaritardimax,StringaNumeri(aAmbi(i)) & "." & StringaNumeri(aAmbi(j)))
End If
Dim coppiadaverificare1
Dim coppiadaverificare2
Dim f
Call SplitByChar(StringaNumeri(aAmbi(i)),".",coppiadaverificare1)
Call SplitByChar(StringaNumeri(aAmbi(j)),".",coppiadaverificare2)
' For f = 1 To UBound(anum)
' If Int(anum(f)) = Int(coppiadaverificare1(0)) Then
' contatorematch1 = contatorematch1 + 1
' End If
' If Int(anum(f)) = Int(coppiadaverificare1(1)) Then
' contatorematch1 = contatorematch1 + 1
' End If
' If Int(anum(f)) = Int(coppiadaverificare2(0)) Then
' contatorematch2 = contatorematch2 + 1
' End If
' If Int(anum(f)) = Int(coppiadaverificare2(1)) Then
' contatorematch2 = contatorematch2 + 1
' End If
' Next
Dim vettorexverificaquartinabycoppiaambiconsecutividocxfiltro
Call SplitByChar("." & StringaNumeri(aAmbi(i)) & "." & StringaNumeri(aAmbi(j)) & ".",".",vettorexverificaquartinabycoppiaambiconsecutividocxfiltro)
If Estrazioneprogressiva = fine Then
coppiedocbyfiltrovoluto = array_push(coppiedocbyfiltrovoluto,StringaNumeri(aAmbi(i)) & "-" & StringaNumeri(aAmbi(j)))
End If
contatorematch1 = 0
contatorematch2 = 0
Erase vettorexverificaquartinabycoppiaambiconsecutividocxfiltro
vettorexverificaquartinabycoppiaambiconsecutividocxfiltro = Array(0)
Call Messaggio("R1+R2 " & Int(FormatSpace(aRit(UBound(aRit)),3)) + Int(FormatSpace(aRit1(UBound(aRit1)),3)) & " es. " & Estrazioneprogressiva & " la n. " & Es & " di " & quanticasianalizzare & " c+ " & casipositivi & " c- " & casinegativi & " ca " & casincorso & " clpdiverif " & colpidiverifica & " clpmaxril " & colpomaxrilevato)
Call AvanzamentoElab(1,nColT,m)
Next
Next
Dim aIdCol(2),aIdV(2)
aIdCol(1) = 2:aIdCol(2) = 1
aIdV(1) = 1:aIdV(2) = 1
Call OrdinaMatrice2(aStat,aIdCol,aIdV)
Scrivi TempoTrascorso
Dim sChrSep
For i = 1 To UBound(aStat)
For j = 1 To UBound(aStat,2)
sChrSep = " | "
If j > 2 Then sChrSep = " "
Next
Next
Scrivi
Scrivi "Per questa estrazione n. <font color=red>" & Estrazioneprogressiva & "</font> la formazione con somma ritardi max pari a " & sommaritmax & " è " & StringaNumeri(Formazioneconsommaritardimax)
Scrivi
Dim vettorexulterioreverificaformazioneconsommaritardimax
Call SplitByChar(StringaNumeri(Formazioneconsommaritardimax),".",vettorexulterioreverificaformazioneconsommaritardimax)
Call VerificaEsito(vettorexulterioreverificaformazioneconsommaritardimax,aR,Estrazioneprogressiva + 1,sortediverifica,colpidiverifica,,Esitoverifica,Entroilcolpo,Estratti,idestrazsfald)
If Esitoverifica <> "" Then
Scrivi "<strong><font color=blue>ok anche la verifica della formazione con somma ritardi max</font></strong>"
Scrivi StringaNumeri(vettorexulterioreverificaformazioneconsommaritardimax) & " al clp n. " & Entroilcolpo & " estratti " & Estratti & " all'estrazione n. " & idestrazsfald
casipositivi = casipositivi + 1
If Entroilcolpo > colpomaxrilevato Then
colpomaxrilevato = Entroilcolpo
End If
Select Case(Entroilcolpo)
Case 1
entroclp1 = entroclp1 + 1
Case 2
entroclp2 = entroclp2 + 1
Case 3
entroclp3 = entroclp3 + 1
Case 4
entroclp4 = entroclp4 + 1
Case 5
entroclp5 = entroclp5 + 1
Case 6
entroclp6 = entroclp6 + 1
Case 7
entroclp7 = entroclp7 + 1
Case 8
entroclp8 = entroclp8 + 1
Case 9
entroclp9 = entroclp9 + 1
Case 10
entroclp10 = entroclp10 + 1
Case 11
entroclp11 = entroclp11 + 1
Case 12
entroclp12 = entroclp12 + 1
Case 13
entroclp13 = entroclp13 + 1
Case 14
entroclp14 = entroclp14 + 1
Case 15
entroclp15 = entroclp15 + 1
Case 16
entroclp16 = entroclp16 + 1
Case 17
entroclp17 = entroclp17 + 1
Case 18
entroclp18 = entroclp18 + 1
Case 19
entroclp19 = entroclp19 + 1
Case 20
entroclp20 = entroclp20 + 1
Case 21
entroclp21 = entroclp21 + 1
Case 22
entroclp22 = entroclp22 + 1
Case 23
entroclp23 = entroclp23 + 1
Case 24
entroclp24 = entroclp24 + 1
Case 25
entroclp25 = entroclp25 + 1
Case 26
entroclp26 = entroclp26 + 1
Case 27
entroclp27 = entroclp27 + 1
Case 28
entroclp28 = entroclp28 + 1
Case 29
entroclp29 = entroclp29 + 1
Case 30
entroclp30 = entroclp30 + 1
Case 31
entroclp31 = entroclp31 + 1
Case 32
entroclp32 = entroclp32 + 1
Case 33
entroclp33 = entroclp33 + 1
Case 34
entroclp34 = entroclp34 + 1
Case 35
entroclp35 = entroclp35 + 1
Case 36
entroclp36 = entroclp36 + 1
Case 37
entroclp37 = entroclp37 + 1
Case 38
entroclp38 = entroclp38 + 1
Case 39
entroclp39 = entroclp39 + 1
Case 40
entroclp40 = entroclp40 + 1
Case 41
entroclp41 = entroclp41 + 1
Case 42
entroclp42 = entroclp42 + 1
Case 43
entroclp43 = entroclp43 + 1
Case 44
entroclp44 = entroclp44 + 1
Case 45
entroclp45 = entroclp45 + 1
Case 46
entroclp46 = entroclp46 + 1
Case 47
entroclp47 = entroclp47 + 1
Case 48
entroclp48 = entroclp48 + 1
Case 49
entroclp49 = entroclp49 + 1
Case 50
entroclp50 = entroclp50 + 1
Case 51
entroclp51 = entroclp51 + 1
Case 52
entroclp52 = entroclp52 + 1
Case 53
entroclp53 = entroclp53 + 1
Case 54
entroclp54 = entroclp54 + 1
Case 55
entroclp55 = entroclp55 + 1
Case 56
entroclp56 = entroclp56 + 1
Case 57
entroclp57 = entroclp57 + 1
Case 58
entroclp58 = entroclp58 + 1
Case 59
entroclp59 = entroclp59 + 1
Case 60
entroclp60 = entroclp60 + 1
End Select
Else
Scrivi "no"
colpiteoricirestantirispettocolpomaxrilevato = colpomaxrilevato -(fine - Estrazioneprogressiva)
If colpiteoricirestantirispettocolpomaxrilevato < 0 Then
casinegativi = casinegativi + 1
Scrivi StringaNumeri(vettorexulterioreverificaformazioneconsommaritardimax)
Scrivi "<font color=black size=1> Colpi restanti teorici rispetto colpo max rilevato " & colpiteoricirestantirispettocolpomaxrilevato & "</font>"
Else
casincorso = casincorso + 1
Scrivi StringaNumeri(vettorexulterioreverificaformazioneconsommaritardimax)
Scrivi "<font color=green size=3> Colpi restanti teorici rispetto colpo max rilevato " & colpiteoricirestantirispettocolpomaxrilevato & "</font>"
If colpiteoricirestantirispettocolpomaxrilevato < crtminrilevato Then
crtminrilevato = colpiteoricirestantirispettocolpomaxrilevato
Formazioneconcrtminrilevato = array_push(Formazioneconcrtminrilevato,StringaNumeri(vettorexverificaquartinabycoppiaambiconsecutividocxfiltro))
End If
End If
End If
sommaritmax = 0
If ScriptInterrotto Then Exit For
Next ' x estraz progr
Scrivi
Scrivi
Scrivi "Riassuntino elaborazione finale con filtro voluto somma ritardi >= " & Valoredesiderato
Scrivi
Scrivi "La/e coppia/e con somma ritardi >= " & Valoredesiderato & " relativamente all'ultima estrazione e'/sono le seguenti: "
Scrivi
Dim c
For c = 1 To UBound(coppiedocbyfiltrovoluto)
Scrivi coppiedocbyfiltrovoluto(c)
Next
Scrivi
Scrivi "La somma ritardi massima per adesso rilevata per questo tipo di ricerca è " & sommaritmax
Scrivi
Scrivi "c+ " & casipositivi
Scrivi "c- " & casinegativi
Scrivi "ca " & casincorso
Scrivi "clp di verif " & colpidiverifica
Scrivi "clp max ril " & colpomaxrilevato
Scrivi "crt min ril " & crtminrilevato
Scrivi "formazione(i) con crt min ril "
Dim q
For q = 0 To UBound(Formazioneconcrtminrilevato)
Scrivi "<font color=blue>" & StringaNumeri(Formazioneconcrtminrilevato(q)) & "</font>"
Next
Scrivi StringaNumeri(Formazioneconcrtminrilevato)
Scrivi
Scrivi "Distribuzione esiti secondo i vari colpi"
Scrivi
Scrivi "entro colpi 1 " & " " & entroclp1
Scrivi "entro colpi 2 " & " " & entroclp2
Scrivi "entro colpi 3 " & " " & entroclp3
Scrivi "entro colpi 4 " & " " & entroclp4
Scrivi "entro colpi 5 " & " " & entroclp5
Scrivi "entro colpi 6 " & " " & entroclp6
Scrivi "entro colpi 7 " & " " & entroclp7
Scrivi "entro colpi 8 " & " " & entroclp8
Scrivi "entro colpi 9 " & " " & entroclp9
Scrivi "entro colpi 10 " & " " & entroclp10
Scrivi "entro colpi 11 " & " " & entroclp11
Scrivi "entro colpi 12 " & " " & entroclp12
Scrivi "entro colpi 13 " & " " & entroclp13
Scrivi "entro colpi 14 " & " " & entroclp14
Scrivi "entro colpi 15 " & " " & entroclp15
Scrivi "entro colpi 16 " & " " & entroclp16
Scrivi "entro colpi 17 " & " " & entroclp17
Scrivi "entro colpi 18 " & " " & entroclp18
Scrivi "entro colpi 19 " & " " & entroclp19
Scrivi "entro colpi 20 " & " " & entroclp20
Scrivi "entro colpi 21 " & " " & entroclp21
Scrivi "entro colpi 22 " & " " & entroclp22
Scrivi "entro colpi 23 " & " " & entroclp23
Scrivi "entro colpi 24 " & " " & entroclp24
Scrivi "entro colpi 25 " & " " & entroclp25
Scrivi "entro colpi 26 " & " " & entroclp26
Scrivi "entro colpi 27 " & " " & entroclp27
Scrivi "entro colpi 28 " & " " & entroclp28
Scrivi "entro colpi 29 " & " " & entroclp29
Scrivi "entro colpi 30 " & " " & entroclp30
Scrivi "entro colpi 31 " & " " & entroclp31
Scrivi "entro colpi 32 " & " " & entroclp32
Scrivi "entro colpi 33 " & " " & entroclp33
Scrivi "entro colpi 34 " & " " & entroclp34
Scrivi "entro colpi 35 " & " " & entroclp35
Scrivi "entro colpi 36 " & " " & entroclp36
Scrivi "entro colpi 37 " & " " & entroclp37
Scrivi "entro colpi 38 " & " " & entroclp38
Scrivi "entro colpi 39 " & " " & entroclp39
Scrivi "entro colpi 40 " & " " & entroclp40
Scrivi "entro colpi 41 " & " " & entroclp41
Scrivi "entro colpi 42 " & " " & entroclp42
Scrivi "entro colpi 43 " & " " & entroclp43
Scrivi "entro colpi 44 " & " " & entroclp44
Scrivi "entro colpi 45 " & " " & entroclp45
Scrivi "entro colpi 46 " & " " & entroclp46
Scrivi "entro colpi 47 " & " " & entroclp47
Scrivi "entro colpi 48 " & " " & entroclp48
Scrivi "entro colpi 49 " & " " & entroclp49
Scrivi "entro colpi 50 " & " " & entroclp50
Scrivi "entro colpi 51 " & " " & entroclp51
Scrivi "entro colpi 52 " & " " & entroclp52
Scrivi "entro colpi 53 " & " " & entroclp53
Scrivi "entro colpi 54 " & " " & entroclp54
Scrivi "entro colpi 55 " & " " & entroclp55
Scrivi "entro colpi 56 " & " " & entroclp56
Scrivi "entro colpi 57 " & " " & entroclp57
Scrivi "entro colpi 58 " & " " & entroclp58
Scrivi "entro colpi 59 " & " " & entroclp59
Scrivi "entro colpi 60 " & " " & entroclp60
End Sub
Sub CaricaArrayAmbiConsecutivi(aAmbi)
Dim n1,n2
For n1 = 1 To 89
n2 = n1 + 1
aAmbi(n1) = Array(0,n1,n2)
Next
End Sub
Function RicercaElementoInLista(aLista,E)
Dim Primo_
Dim Ultimo
Dim Mezzo
Dim tro
tro = - 1
Primo_ = 1
Ultimo = UBound(aLista) - 1
Do While(Primo_ <= Ultimo And tro = - 1)
Mezzo = Fix((Primo_ + Ultimo)/2)
If aLista(Mezzo) < E Then
Primo_ = Mezzo + 1
ElseIf aLista(Mezzo) = E Then
tro = 1
ElseIf aLista(Mezzo) > E Then
Ultimo = Mezzo - 1
End If
Loop
RicercaElementoInLista = tro
End Function
Function array_push(arr,vars)
Dim k,newelem,newarrsize,elem
If IsArray(arr) Then
If Len(vars) > 0 Then
If InStr(vars,",") = False Then
newarrsize = CInt(UBound(arr) + 1)
ReDim Preserve arr(newarrsize)
arr(newarrsize) = vars
Else
k =(UBound(arr) + 1)
newelem = Split(vars,",")
newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
ReDim Preserve arr(newarrsize)
For Each elem In newelem
arr(k) = Trim(elem)
k = k + 1
Next
End If
End If
array_push = arr
Else
array_push = False
End If
End Function
Function SelEsito
Dim ret
Dim aVoci
For ret = 1 To 1
SelEsito = ret
Next
End Function
In sostanza verifica gli sfaldamenti entro tot colpi voluti della sorte (es. A) su TT della quartina composta dalle due coppie di ambi consecutivi la cui somma dei ritardi x A su TT e' massima rispetto tutte le altre estrazione dopo estrazione...
