Terni consecutivi

[Reacher]

Messaggio 6
Risposta tua:
Se hai uno script da correggere, posso cercare di aggiungere il mio aiuto.

Farlo io, no.

 

[joe]

I 5 cicli nidificati che hai inserito nel tuo script

non li avevo provati ma mi era ovvio che non funzionassero a dovere.

In primis per questioni di efficienza.

5 * 5 * 5 * 5 * 5 è uguale ad un numero spropositato di combinazioni

dal quale estratte 10 terni. (ma il Pc lo farebbe).

Pero:

Scritti come erano scritti, non funzionano e generano 1 solo ciclo.

UNO.

Questo è il quanto:

Option Explicit
Sub Main
 Dim p1,p2,p3,p4,p5
 For p1 = 1 To 5
  For p2 = p1 + 1 To 5
   For p3 = p2 + 1 To 5
    For p4 = p3 + 1 To 5
     For p5 = p4 + 1 To 5
      Scrivi p1 & " " & p2 & " " & p3 & " " & p4 & " " & p5
     Next
    Next
   Next
  Next
 Next
End Sub

Messaggio 6
Risposta tua:
Se hai uno script da correggere, posso cercare di aggiungere il mio aiuto.

Farlo io, no.

Leggo che c'è uno script da correggere e lo sto facendo.

 

[SatuRno17]

Ciao a tutti, non uso spaziometria da molto ma mi ricordo ancora qualcosa.... e tante cose me le ha insegnate proprio Joe, che ringrazio.
Prova con questo Reacher

Sub Main
Dim es,r,E,E1,E2,p,P1,P2 
For es = 1 to 2600
For r = 1 to 11
For p = 1 to 5
E = estratto(es,r,p)
For P1 = 1 to 5
E1 = estratto(es,r,P1)
If distanza(E,E1) = 1 Then
For P2 = 1 to 5
E2 = estratto(es,r,P2)
If fuori90(E+1)= E2 then
Scrivi dataestrazione(es) 'inserire qui ciò che si vuole stampare
Exit for
End if
Next
End if
Next
Next
Next
Next
End sub

 

[joe]

Il calcolo delle combinazioni (Combinatorio) è la parte più difficile da gestire e delicata da affrontare.

Nel ringraziare Saturno aggiungo che con più di 40 anni di esperienza ... si può fare!

Dunque considerando che i numeri sono 5 da combinarsi in Terni ...

le tabelle statistiche ci indicano che ci devono essere 10 Combinazioni (semplici).

Questa routine che uso da anni lo fa egregiamente e pertanto la propongo come soluzione.

Option Explicit
Sub Main
 Dim A,B,C
 For A = 1 To 3
  For B = A + 1 To 4
   For C = B + 1 To 5
    Scrivi A & "° " & B & "° " & C & "°"
   Next
  Next
 Next
End Sub

L'output dimostra come a-b-c possono indicare la posizione dei 5 estratti,

in 10 modi diversi - ordinati - utili ad essere 10 Terni senza errori, mancanze, ripetizioni.

 

[joe]

La struttura principale dello script è quella proposta inizialmente.

Option Explicit
Sub Main
 Dim Ini,Fin,Es,R,P,E(5)
 Ini = 10805 : Fin = 10805
 For Es = Ini To Fin
  For R = 1 To 12 : If R = 11 Then R = 12
   Scrivi NomeRuota(R),1
   For P = 1 To 5
    E(P) = Estratto(Es,R,P)
   Next
   ''''  Output di controllo/debug
   For P = 1 To 5
    Scrivi E(P)
   Next
   Scrivi String(9,"-")
   ''''
  Next
 Next
End Sub

Nella zona attualmente preposta al debug, andrà semplicemente sostituita con quella

per lo sviluppo dei Terni e poi sarà necessario il filtro per escludere tutti quelli che non sono consegutivi.


NB: Questo script è molto simile, nella sua struttura a quello proposto da Saturno.

 

[joe]

Nel fondere i 2 script ... abbiamo un primo passo verso la soluzione definitiva

e la possibilità di notare alcune cose che elencherò dopo lo script ed i suoi risultati.

Option Explicit
Sub Main
 Dim Ini,Fin,Es,R,P,E(5)
 Dim A,B,C
 Ini = 10805 : Fin = 10805
 For Es = Ini To Fin
  For R = 1 To 1'2 : If R = 11 Then R = 12
   Scrivi NomeRuota(R),1
   For P = 1 To 5
    E(P) = Estratto(Es,R,P)
   Next
   ''''  Sviluppo Combinazioni
   For A = 1 To 3
    For B = A + 1 To 4
     For C = B + 1 To 5
      Scrivi E(A) & " " & E(B) & " " & E(C)
     Next
    Next
   Next
   ''''
  Next
 Next
End Sub

Che produce :

Bari
40 72 47
40 72 39
40 72 63
40 47 39
40 47 63
40 39 63
72 47 39
72 47 63
72 39 63
47 39 63

E' un buon risultato perché ci sono i 10 terni giusti.

Sono però "scombussolati" ovvero sono DISORDINATI.

Semplicemente perché per il Lotto gli Estratti ci vengono proposti

in ordine temporale e non numerico.

Per semplicità e non complicare lo script si può usare OrdinaMatrice e si ottiene:

Bari
39 40 47
39 40 63
39 40 72
39 47 63
39 47 72
39 63 72
40 47 63
40 47 72
40 63 72
47 63 72

 

[Reacher]

Grazie proverò a lanciarli