Listato di BEN 8 da correggere

[Roby]

Intanto usciamo dal post precedente dove si trattava altro argomento,

questo listato è mio soltanto per il 10%, se non mi dici cosa vuoi come ti aiuto?

devo sapere cosa intendi fare, cosa deve cercare il listato, dopo vedo se riesco a ragionarci,

la tua mail non l'ho vista, la mia eccola -

ciao danilo



Sub main()
Dim m1(45000,9)
Dim nn(10)
Dim ruota(12)

nru=InputBox("Su quale ruota, ",,12)
nes=InputBox("Inserisci 0 ultima, 1 prima, ....",,12)
ne=InputBox("Numero estrazioni:",,50)
perc=InputBox("Percentuale minima (60-90%):",,40)
ncg=InputBox("Numero colpi di gioco",,3)

ruota(1)=eval(nru)
casi=0

ini=EstrazioneFin-ne
fin=EstrazioneFin

For x1=1 To 45000
m1(x1,1)=0 : m1(x1,2)=0 : m1(x1,3)=0 : m1(x1,4)=0 : m1(x1,5)=0 : m1(x1,6)=0
m1(x1,7)=0 : m1(x1,8)=0 : m1(x1,9)=0
Next

For es=ini To fin
If eval(nes)=0 Then
If IndiceMensile(es+1)=1 Then

casi=casi+1
o1=0
For r1=1 To 12
If r1=11 Then r1=12
For p1=1 To 4
For n1=1 To 90
For r2=1 To 12
If r2=11 Then r2=12
For p2=p1+1 To 5
For n2=1 To 90
o1=o1+1
t1=0

a1=Estratto(es,r1,p1)
b1=Fuori90(a1+n1)
a2=Estratto(es,r2,p2)
b2=Fuori90(a2+n2)
nn(1)=b1
nn(2)=b2


esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=EstrazioneFin End If
t1=SerieFreq(es+1,esncg,nn,ruota,1)
If t1>0 Then

m1(o1,1)=o1
m1(o1,2)=r1
m1(o1,3)=p1
m1(o1,4)=n1
m1(o1,5)=r2
m1(o1,6)=p2
m1(o1,7)=n2
m1(o1,8)=m1(o1,8)+1
m1(o1,9)=m1(o1,9)+t1

End If
Next
Next
Next
Next
Next
Next
End If

Else

If IndiceMensile(es)=eval(nes) Then

casi=casi+1
o1=0
For r1=1 To 12
If r1=11 Then r1=12
For p1=1 To 4
For n1=1 To 90
For r2=1 To 12
If r2=11 Then r2=12
For p2=p1+1 To 5
For n2=1 To 90
o1=o1+1
t1=0
a1=Estratto(es,r1,p1)
b1=Fuori90(a1+n1)
a2=Estratto(es,r2,p2)
b2=Fuori90(a2+n2)
nn(1)=b1
nn(2)=b2

esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=EstrazioneFin End If
t1=SerieFreq(es+1,esncg,nn,ruota,1)
If t1>0 Then

m1(o1,1)=o1
m1(o1,2)=r1
m1(o1,3)=p1
m1(o1,4)=n1
m1(o1,5)=r2
m1(o1,6)=p2
m1(o1,7)=n2
m1(o1,8)=m1(o1,8)+1
m1(o1,9)=m1(o1,9)+t1

End If
Next
Next
Next
Next
Next
Next
End If
End If
Next

c1=0

ColoreTesto 1
Scrivi "ANALISI Dal "& DataEstrazione(ini)&" al "& DataEstrazione(fin),1
Scrivi

If eval(nes)=0 Then

Scrivi "ESTRAZIONE DI CALCOLO : "& "Ultima del mese",1

Else

Scrivi "ESTRAZIONE DI CALCOLO : "& eval(nes)&"° del mese",1

End If

Scrivi "RUOTA DI GIOCO : "& NomeRuota(nru),1
Scrivi "COLPI DI GIOCO : "& ncg,1
Scrivi "CASI ANALIZZATI : "& casi,1
Scrivi : ColoreTesto 0

per=Int((casi/100)*perc)
For c1=1 To 45000
If eval(m1(c1,8))=>per Then

Scrivi eval(m1(c1,3))& "°" & Left(NomeRuota(eval(m1(c1,2))),2)&" + "&_
Format2(m1(c1,4))&" & "& eval(m1(c1,6))& "°" & Left(NomeRuota(eval(m1(c1,5))),2)&" + "&_
Format2(m1(c1,7))&" su "&FormatSpace(NomeRuota(nru),9)&" è uscito "&_
FormatSpace(m1(c1,8),3)&"su "&FormatSpace(casi,3)&"casi - AMBATE TOTALI: "&_
FormatSpace(m1(c1,9),3)

End If
Next
End Sub


Danilo by cs1

 

[Ben8]

Ciao Danilo!
Mi spiego meglio, il listato originale, esegue una ricerca sommativa, generando un numero e il suo vertibile, per il gioco di ambata elencando anche la percentuale di uscita.
Esempio:

5°Fi + 38 e Vert. su Bari è uscito 4 su 4 casi - AMBATE TOTALI: 4

Segue listato:

quote:
Sub main()
Dim ambi(4500,6),nn(10),ruota(12)
nru=InputBox("Su quale ruota, ",,1)
nes=InputBox("Inserisci 0 ultima, 1 prima, ....",,9)
ne=InputBox("Numero estrazioni:",,50)
perc=InputBox("Percentuale minima (60-90%):",,100)
ncg=InputBox("Numero colpi di gioco",,3)
ruota(1)=eval(nru)
casi=0
ini=EstrazioneFin-ne
fin=EstrazioneFin
For x=1 To 4500
ambi(x,1)=0 : ambi(x,2)=0 : ambi(x,3)=0 : ambi(x,4)=0 : ambi(x,5)=0 : ambi(x,6)=0
Next
For es=ini To fin
If eval(nes)=0 Then
If IndiceMensile(es+1)=1 Then
casi=casi+1
co=0
For r=1 To 10
For p=1 To 5
For nu=1 To 90
co=co+1
c=0
a=Estratto(es,r,p)
b=Fuori90(a+nu)
nn(1)=b ': nn(2)=Vert(b)
esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=EstrazioneFin End If
c=SerieFreq(es+1,esncg,nn,ruota,1)
If c>0 Then
ambi(co,1)=co
ambi(co,2)=r
ambi(co,3)=p
ambi(co,4)=nu
ambi(co,5)=ambi(co,5)+1
ambi(co,6)=ambi(co,6)+c
End If
Next
Next
Next
End If
Else
If IndiceMensile(es)=eval(nes) Then
casi=casi+1
co=0
For r=1 To 10
For p=1 To 5
For nu=1 To 90
co=co+1
c=0
a=Estratto(es,r,p)
b=Fuori90(a+nu)
nn(1)=b ': nn(2)=Vert(b)
esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=EstrazioneFin End If
c=SerieFreq(es+1,esncg,nn,ruota,1)
If c>0 Then
ambi(co,1)=co
ambi(co,2)=r
ambi(co,3)=p
ambi(co,4)=nu
ambi(co,5)=ambi(co,5)+1
ambi(co,6)=ambi(co,6)+c
End If
Next
Next
Next
End If
End If
Next
ca=0
ColoreTesto 1
Scrivi "ANALISI Dal "& DataEstrazione(ini)&" al "& DataEstrazione(fin),1
Scrivi
If eval(nes)=0 Then
Scrivi "ESTRAZIONE DI CALCOLO : "& "Ultima del mese",1
Else
Scrivi "ESTRAZIONE DI CALCOLO : "& eval(nes)&"° del mese",1
End If
Scrivi "RUOTA DI GIOCO : "& NomeRuota(nru),1
Scrivi "COLPI DI GIOCO : "& ncg,1
Scrivi "CASI ANALIZZATI : "& casi,1
Scrivi : ColoreTesto 0
per=Int((casi/100)*perc)
For ca=1 To 4500
If eval(ambi(ca,5))=>per Then
Scrivi eval(ambi(ca,3))& "°" & Left(NomeRuota(eval(ambi(ca,2))),2)&" + "&_
Format2(ambi(ca,4))&" e Vert. su "& FormatSpace(NomeRuota(nru),9)&" è uscito "&_
FormatSpace(ambi(ca,5),3)&" su "&FormatSpace(casi,3) &" casi - AMBATE TOTALI: "&_
FormatSpace(ambi(ca,6),3)
End If
Next
End Sub

Ora, io con la mia modifica, cercavo di eliminare il vertibile e al suo posto aggiungere un numero generato con lo stesso sistema con il quale genera il primo, sempre per sorte di ambata.
Esempio:

5°Fi + 38 e 3°Ge + 65 su Bari è uscito 4 su 4 casi - AMBATE TOTALI: 4

Segue listato:

quote:
Sub main()
Dim m1(45000,9)
Dim nn(10)
Dim ruota(12)

nru=InputBox("Su quale ruota, ",,12)
nes=InputBox("Inserisci 0 ultima, 1 prima, ....",,12)
ne=InputBox("Numero estrazioni:",,50)
perc=InputBox("Percentuale minima (60-90%):",,40)
ncg=InputBox("Numero colpi di gioco",,3)

ruota(1)=eval(nru)
casi=0

ini=EstrazioneFin-ne
fin=EstrazioneFin

For x1=1 To 45000
m1(x1,1)=0 : m1(x1,2)=0 : m1(x1,3)=0 : m1(x1,4)=0 : m1(x1,5)=0 : m1(x1,6)=0
m1(x1,7)=0 : m1(x1,8)=0 : m1(x1,9)=0
Next

For es=ini To fin
If eval(nes)=0 Then
If IndiceMensile(es+1)=1 Then

casi=casi+1
o1=0
For r1=1 To 12
If r1=11 Then r1=12
For p1=1 To 4
For n1=1 To 90
For r2=1 To 12
If r2=11 Then r2=12
For p2=p1+1 To 5
For n2=1 To 90
o1=o1+1
t1=0

a1=Estratto(es,r1,p1)
b1=Fuori90(a1+n1)
a2=Estratto(es,r2,p2)
b2=Fuori90(a2+n2)
nn(1)=b1
nn(2)=b2


esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=E

 

[danilo]

Questo è il listato funzionante, naturalmente non puoi usare tutte le combinazioni
in una volta, il programma andrebbe sempre in errore di memoria esaurita, troppe
sono le combinazioni che scaturiscono da questa analisi, come vedi ho impostato
ora il numero sommato da 1 a 10, poi si imposterà da 11 a 20 ecc. ecc.

per eseguire tutta la ricerca, windows permettendo, servirebbero almeno 6-8 Giga di memoria
senza garanzie di riuscita, tempi di analisi all'ordine di ore ecc. ecc.


ciao danilo




Sub main()
Dim ambi(2500000,9),nn(10),ruota(12)
nru=InputBox("Su quale ruota, ",,1)
nes=InputBox("Inserisci 0 ultima, 1 prima, ....",,1)
ne=InputBox("Numero estrazioni:",,100)
perc=InputBox("Percentuale minima (60-90%):",,100)
ncg=InputBox("Numero colpi di gioco",,4)
ruota(1)=eval(nru)
casi=0
ini=EstrazioneFin-ne
fin=EstrazioneFin
For es=ini To fin
If eval(nes)=0 Then
If IndiceMensile(es+1)=1 Then
casi=casi+1
co=0 : c=0
For r=1 To 10
For p=1 To 5
For nu=1 To 10
a=Estratto(es,r,p)
b=Fuori90(a+nu)
nn(1)=b
For r1=1 To 10
For p1=1 To 5
For nu1=1 To 10
co=co+1 : c=0
a1=Estratto(es,r1,p1)
b1=Fuori90(a1+nu1)
nn(2)=b1
esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=EstrazioneFin End If
c=SerieFreq(es+1,esncg,nn,ruota,1)
If c>0 Then
ambi(co,1)=co
ambi(co,2)=r
ambi(co,3)=p
ambi(co,4)=nu
ambi(co,5)=r1
ambi(co,6)=p1
ambi(co,7)=nu1
ambi(co,8)=ambi(co,8)+1
ambi(co,9)=ambi(co,9)+c
End If
Next
Next
Next
Next
Next
Next
End If
Else
If IndiceMensile(es)=eval(nes) Then
casi=casi+1
co=0 : c=0
For r=1 To 10
For p=1 To 5
For nu=1 To 10
a=Estratto(es,r,p)
b=Fuori90(a+nu)
nn(1)=b
For r1=1 To 10
For p1=1 To 5
For nu1=1 To 10
co=co+1 : c=0
a1=Estratto(es,r1,p1)
b1=Fuori90(a1+nu1)
nn(2)=b1
esncg=es+eval(ncg)
If esncg>EstrazioneFin Then esncg=EstrazioneFin End If
c=SerieFreq(es+1,esncg,nn,ruota,1)
If c>0 Then
ambi(co,1)=co
ambi(co,2)=r
ambi(co,3)=p
ambi(co,4)=nu
ambi(co,5)=r1
ambi(co,6)=p1
ambi(co,7)=nu1
ambi(co,8)=ambi(co,8)+1
ambi(co,9)=ambi(co,9)+c
End If
Next
Next
Next
Next
Next
Next
End If
End If
Next
ColoreTesto 1
Scrivi "ANALISI Dal "& DataEstrazione(ini)&" al "& DataEstrazione(fin),1
Scrivi
If eval(nes)=0 Then
Scrivi "ESTRAZIONE DI CALCOLO : "& "Ultima del mese",1
Else
Scrivi "ESTRAZIONE DI CALCOLO : "& eval(nes)&"° del mese",1
End If
Scrivi "RUOTA DI GIOCO : "& NomeRuota(nru),1
Scrivi "COLPI DI GIOCO : "& ncg,1
Scrivi "CASI ANALIZZATI : "& casi,1
Scrivi : ColoreTesto 0
per=Int((casi/100)*perc)
For ca=1 To co
If eval(ambi(ca,8))=>per Then
s=" "& eval(ambi(ca,3))& "°" & Left(NomeRuota(eval(ambi(ca,2))),2)&" + "& Format2(ambi(ca,4))
s=s&" con il "&eval(ambi(ca,6))& "°" & Left(NomeRuota(eval(ambi(ca,5))),2)&" + "& Format2(ambi(ca,7))
s=s&" su "& FormatSpace(NomeRuota(nru),9)&" è uscito "&FormatSpace(ambi(ca,8),3)&" su "
s=s&FormatSpace(casi,3) &" casi - AMBATE TOTALI: "&FormatSpace(ambi(ca,9),3)
Scrivi s
End If
Next
End Sub


Danilo by cs1

 

[Ben8]

Grazie Danilo!
Avevo immaginato qualcosa del genere.
Pazienza, ripiegherò su qualche altro metodo.

Ciao e buon Ferragosto!!

Ben[8] </u>

 

[Ben8]

Ciao cipisto, cosa ne pensi? Si può fare qualcosa?
Quello che non capisco, è perchè lo script alla matrice "Dim ambi(2500000,9)",non va oltre i (4500000,9), se ci provo,mi da "errore 7 memoria esaurita", anche se ho ancora 1 gb di memoria disponibile.
E' forse una limitazione del programma?
Secondo te, si può ovviare al problema, magari seguendo una strada diversa in alternativa all'utilizzo estremo della matrice?
Ti ringrazio in anticipo per l'eventuale aiuto che potrai darmi.

Ben[8] </u>

 

[maisgordo]

X DANILO
Scusa, come posso modificare il listato se anzichè scegliere quale estrazione (1° o 2° 0 3° ecc.) scegliessi tutte le estrazioni (ad ogni estrazione metti in gioco il listato).
Grazie

 

[cipisto]

quote:Originally posted by Ben8
Ciao cipisto, cosa ne pensi? Si può fare qualcosa?
Quello che non capisco, è perchè lo script alla matrice "Dim ambi(2500000,9)",non va oltre i (4500000,9), se ci provo,mi da "errore 7 memoria esaurita", anche se ho ancora 1 gb di memoria disponibile.
E' forse una limitazione del programma?
Secondo te, si può ovviare al problema, magari seguendo una strada diversa in alternativa all'utilizzo estremo della matrice?
Ti ringrazio in anticipo per l'eventuale aiuto che potrai darmi.

quote:Originally posted by Danilo
Questo è il listato funzionante, naturalmente non puoi usare tutte le combinazioni in una volta, il programma andrebbe sempre in errore di memoria esaurita, troppe sono le combinazioni che scaturiscono da questa analisi, come vedi ho impostato ora il numero sommato da 1 a 10, poi si imposterà da 11 a 20 ecc. ecc. per eseguire tutta la ricerca, windows permettendo, servirebbero almeno 6-8 Giga di memoria
senza garanzie di riuscita, tempi di analisi all'ordine di ore ecc. ecc.

Ciao Ben8, partiamo col dire che secondo me Danilo è stato abbastanza palese nel spiegare il discorso di elaborazione. Quando facciamo girare un listato o comunque un programma in generale, non si deve tenere conto della solo memoria occupata ma anche della percentuale di utilizzo del processore, processi attivi ecc ecc. Ho provato a far girare il listato con le impostazioni base portando la percentuale minima al 90%, risultato circa mezzo giga di memoria occupata ed il processore che variava dal 50% al 60% di utilizzo (stiamo parlando comunque di un pentium IV 3.2 con 2 giga di memoria in dual channel). In conclusione credo, a mio modesto parere, che spingere oltre questo listato sia inutile, anche non volendo utilizzare una matrice cosa pensi si possa utilizzare? Beh così al volo mi viene da pensare ad una tabella di appoggio in access da utilizzarsi (con ADO ovviamente) con continue chiamate che magari ti riducono la memoria occupata ma ti allungano di parecchio l'elaborazione. Chiudo dicendo, che il tuo modo di chiedere il mio parere (anche se in buona fede) potrebbe risultare antipatico per Danilo che si è già prodigato per aiutarti e spiegare.
Buona Giornata.

Esistono solo due cose infinite: l'universo e la stupidità umana. Sulla prima delle due non ho prove.(A.Einstein)

 

[Ben8]

Grazie cipisto per avermi risposto.
La mia richiesta di richiedere un tuo parere riguardo questo listato, non credo possa offendere Danilo.
Infatti ti ho chiesto se ci fosse un'altro modo per aggirare l'ostacolo.
Per quanto riguarda memoria e processore, non ho problemi, visto che uso un server.
Ad ogni modo conto di realizzare a pieno questo script, anche perchè ci lavoro da tempo e non mi arrendo facilmente.

Cordiali saluti a tutti.

Ben[8] </u>