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