questo è l'ultimo che ho fatto, decisamente il più efficiente.
La variabile ok scrivi è un vettore booleano di tanti elementi quante sono le righe della matrice, inizializzati tutti a false tranne il primo elemento(che sarebbe la riga 1). La prima parte confronta tutte le righe con la prima (1-2-3-4-5-6 che è true perchè è la prima anche nel ridotto) dichiarandole true se hanno più di 4 elementi comuni. La seconda parte entra in gioco se la riga R non è scartata al confronto con la prima. Il ragionamento sarebbe: "Scorri le altre righe sopra di te, e se ne trovi una true confrontati con quella, altrimenti sei da scartare"
Quelle vere devono essere 1,6,15,24
L'algoritmo riconosce vere 1-6, ma al confronto tra 15 e 6 dichiara la 15 falsa e la scarta! quindi prosegue..confrontando tutte le righe solo con le prime 2 che trova TRUE.
bin=numero di righe=28
elemscelti=6
combiS=è la matrice 28x6
(in fondo posto anche il codice per generare le combinazioni)
codice:'' riga di confronto è la 1.. 1-2-3-4-5-6 For R = 2 To bin Conta = 0 For c = 1 To ElemScelti If CombiS(R, c) = CombiS(1, c) Then Conta = Conta + 1 If Conta > 4 Then '' vai alla riga successiva GoTo RigaSuccessiva End If GoTo ColonnaSuccessiva Else For K = 1 To ElemScelti If CombiS(R, K) = CombiS(1, c) Then Conta = Conta + 1 If Conta > 4 Then '' vai alla riga successiva GoTo RigaSuccessiva End If GoTo ColonnaSuccessiva End If Next End If ColonnaSuccessiva: Next I = 2 Do While I < R Conta = 0 If okScrivi(I) = False Then GoTo RigaSuccessiva2 Else '' confronto con la riga I For c = 1 To ElemScelti If CombiS(R, c) = CombiS(I, c) Then Conta = Conta + 1 If Conta > 4 Then '' vai alla riga successiva GoTo RigaSuccessiva End If GoTo ColonnaSuccessiva2 Else For K = 1 To ElemScelti If CombiS(R, K) = CombiS(I, c) Then Conta = Conta + 1 If Conta > 4 Then GoTo RigaSuccessiva End If End If Next ' GoTo ColonnaSuccessiva2 End If ColonnaSuccessiva2: Next '' fai il debug fino qui, noterai che la colonna 15(R=15) '' al confronto con la 6(I=6) risulta misteriosamente falsa, quando invece è vera okScrivi(R) = True GoTo RigaSuccessiva End If RigaSuccessiva2: I = I + 1 Loop okScrivi(R) = True RigaSuccessiva: Next
codice:Public Function CombinazioniS(ByVal N%, ByVal K%, CombiS&()) As Boolean ' ' Ritorna, nella matrice CombiS(Cnk(N, K), K) con N >= K ' e K > 0, le combinazioni semplici di N oggetti della classe K: ' ' N = Val(lblSelezionati.Caption) ' K = Val(ElemScelti) Dim R&, NR As Long Dim c&, P As Integer Dim progresso As Double progresso = 0 ' On Error GoTo CombinazioniS_ERR ' NR = Cnk(N, K) ' Numero delle righe. ReDim CombiS(1 To NR, 1 To K) ' ' Scrivo la prima riga: For c = 1 To K CombiS(1, c) = c Next c ' ' Righe rimanenti: For R = 2 To NR ' P = K Do Until CombiS(R - 1, P) < N - K + P P = P - 1 Loop For c = 1 To P - 1 CombiS(R, c) = CombiS(R - 1, c) Next c ' CombiS(R, P) = CombiS(R - 1, P) + 1 ' For c = P + 1 To K CombiS(R, c) = CombiS(R, c - 1) + 1 Next c progresso = progresso + 1 ProgressBar.Value = progresso * 100 / NR ' Next R ' ' CombinazioniS_ERR: CombinazioniS = (Err = 0) If (Err <> 0) Then Dim M$ M$ = "Err. N° " & Err.Number & " " & Err.Description & vbNewLine MsgBox M$, vbCritical, " Function CombinazioniS" End If ' ' End Function

Rispondi quotando