Armonia Quadratica - di Fabarri

[salvo50]

Non c'è voluto molto, ho preso il penultimo script ed ho tolto la seconda parte, per i calcoli sono uguali, perchè li faccio fare con la function, comunque darò uno sguardo anche al penultimo e vedrò di migliorarlo

 'Progetto - ARMONIA QUADRATICA - by FABARRI
'Script   - by Salvo50 con la collaborazione di Enplein
'Cerca le combinazioni che hanno la differenza 45 tra gli estratti 1 e 4
Option Explicit
Dim r1,p1,p2,es,r2,clp,esq,caso,casi
Dim fin,Ini,ru(2),poste(5)
Dim idestr,col,esqcol
Dim dist13ve,dist24ve,dist12or,dist34or,dist14in,dist23in
Dim estr1,estr2,estr3,estr4,findiffor,findiffve,findiffin
Dim pestr1,mestr1,pestr2,mestr2,pestr3,mestr3,pestr4,mestr4
Dim e1,e2,nn1(2),nn2(2),nn3(2),nn4(2)
Sub Main
    Scrivi
    Scrivi
    'poste(1) = 1
    poste(2) = 1
    fin = EstrazioneFin
    esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9000)
    clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca",,1))
    col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,30))
    esqcol = esq + col
    If esqcol > fin Then esqcol = fin
    For es = esq To esqcol
        AvanzamentoElab esq,esqcol,es
        ColoreTesto 2
        Scrivi String(99,"*") & " Estraz. " & Format2(es)
        ColoreTesto 0
        Scrivi
        caso = 0
        For r1 = 1 To 10
            For r2 = r1 + 1 To 11
                If r2 = 11 Then r2 = 12
                For p1 = 1 To 4
                    For p2 = p1 + 1 To 5
                        estr1 = Estratto(es,r1,p1)
                        estr2 = Estratto(es,r1,p2)
                        estr3 = Estratto(es,r2,p1)
                        estr4 = Estratto(es,r2,p2)
                        e1 = estr1
                        e2 = estr2
                        ru(1) = r1
                        ru(2) = r2
                        If Differenza(estr1,estr4) = 45 Then
                            If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
                                If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
                                    If Differenza(estr2,estr3) <> 45 Then
                                        quadratura ' calcoli per differenze
                                        If findiffor = findiffve And findiffor <> findiffin Or findiffor = findiffin And findiffor <> findiffve Or findiffve = findiffin And findiffve <> findiffor Then
                                            pestr2 = Fuori90((estr1) + dist12or)
                                            mestr2 = Fuori90((estr1) - dist12or)
                                            If pestr2 = estr2 Then estr2 = mestr2
                                        Else
                                            estr2 = pestr2
                                        End If
                                        quadratura ' calcoli per differenze
                                        If findiffor = findiffve And findiffor = findiffin And findiffve = findiffin Then
                                            If Differenza(estr1,estr4) = 45 Then
                                                scriv
                                                nn1(1) = estr1
                                                nn1(2) = estr2
                                                ImpostaGiocata 1,nn1,ru,poste,clp
                                                nn2(1) = estr3
                                                nn2(2) = estr4
                                                ImpostaGiocata 2,nn2,ru,poste,clp
                                            End If
                                            Gioca es
                                            estr2 = e2
                                            quadratura
                                            pestr3 = Fuori90((estr4) + dist34or)
                                            mestr3 = Fuori90((estr4) - dist34or)
                                            If pestr3 = estr3 Then estr3 = mestr3
                                        Else
                                            estr3 = pestr3
                                        End If
                                        quadratura ' calcoli per differenze
                                        If findiffor = findiffve And findiffor = findiffin And findiffve = findiffin Then
                                            scriv
                                            If Differenza(estr1,estr4) = 45 Then
                                                nn3(1) = estr1
                                                nn3(2) = estr2
                                                ImpostaGiocata 3,nn3,ru,poste,clp
                                                nn4(1) = estr3
                                                nn4(2) = estr4
                                                ImpostaGiocata 4,nn4,ru,poste,clp
                                            End If
                                            Gioca es
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next
                Next
            Next
        Next
    Next
    ScriviResoconto
End Sub
Function quadratura
    'distanze orizzontali tra i due ambi
    dist12or = Distanza(estr1,estr2)
    dist34or = Distanza(estr3,estr4)
    'distanze verticali tra i due ambi
    dist13ve = Distanza(estr1,estr3)
    dist24ve = Distanza(estr2,estr4)
    'distanze incrociate tra i due ambi
    dist14in = Distanza(estr1,estr4)
    dist23in = Distanza(estr2,estr3)
    'differenze finali
    findiffor = Differenza(dist12or,dist34or)
    findiffve = Differenza(dist13ve,dist24ve)
    findiffin = Differenza(dist14in,dist23in)
End Function
Function scriv
    caso = caso + 1
    casi = casi + 1
    ColoreTesto 1
    Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
    Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
    Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
    Scrivi "  " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & "   Seconda Ruota " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2),1
    Scrivi " Ambi comp. " & Space(6) & " Diff. Oriz" & Space(10) & " Diff. Vert." & Space(10) & "Diff. incr. "
    Scrivi "  " & Format2(estr1) & Space(1) & Format2(estr2) & Space(16) & Format2(dist12or) & Space(19) & Format2(dist13ve) & Space(19) & Format2(dist14in)
    Scrivi "  " & Format2(estr3) & Space(1) & Format2(estr4) & Space(16) & Format2(dist34or) & Space(19) & Format2(dist24ve) & Space(19) & Format2(dist23in)
    Scrivi "---------------------------------------------------------------------------------------"
    Scrivi "Armonia Quadratica     " & Format2(findiffor) & Space(19) & Format2(findiffve) & Space(19) & Format2(findiffin)
    ColoreTesto 0
End Function

 

[salvo50]

Ho modificato gli ultimi 3 script, ho messo l'inizio delle estrazioni a 9000 per un colpo e per 30 estrazioni successive alla 9000, in quello che trova la differenza 45 tra gli estratti 1 e 4 si sono verificati 152 casi giocabili con 3 ambi.
In quello che trova la differenza 45 tra gli estratti 2 e 3 si sono verificati 196 casi giocabili con 2 ambi.

In quello che trova la differenza 45 negli estratti 1 e 4 e negli estratti 2 e 3 la somma degli ambi e la somma dei casi giocabili, per gli ambi sono 5 ed i casi giocabili sono 348, che sono la somma degli altri due script, quindi lo script di pg 37 adesso è a posto, prima c'era un piccolo errore che però sballava tutto, non faceva leggere tutta la seconda parte quella che trova la differenza 45 tra gli estratti 2 e 3.