ELEMENTI DI PROGRAMMAZIONE PER IL CALCOLO COMBINATORIO
Permutazioni senza ripetizioni (Fattoriale):
Funzione per il calcolo del fattoriale utilizzata successivamente per effettuare le operazioni di calcolo combinatorio; la funzione fattoriale fornisce il numero di permutazioni che è possibile ottenere da [n] elementi; notare inoltre che la permutazione è un caso particolare di disposizione semplice senza ripetizione avente il numero di elementi di raggruppamento uguale al numero totale di elementi disponibili:
VBA : CodiceCalcoloCombinatorio001
| 01 : | Function Fattoriale(ByVal n As Long) As Long
|
| 03 : | Dim Risultato As Long
|
| 06 : | Risultato = Risultato * i
|
| 08 : | Fattoriale = Risultato
|
Per il calcolo delle permutazioni senza ripetizione un buon algoritmo sembrerebbe essere lo "Steinhaus Johnson Trotter algorithm"; qui di seguito l'ho implementato in VBA :
VBA : CodiceCalcoloCombinatorio007
| 01 : | Private Sub Genera_Click()
|
| 02 : | Call GeneraPermutazioni("lovaz")
|
| 04 : | ' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
|
| 05 : | Function GeneraPermutazioni(ByVal Testo As String)
|
| 06 : | ' Dichiarazione delle variabili
|
| 07 : | Dim TempoInizio As Double
|
| 08 : | Dim TempoFine As Double
|
| 09 : | Dim MessaggioErrore As String
|
| 10 : | Dim NomeFile As String
|
| 11 : | Dim StringaPermutazione As String
|
| 12 : | Dim StringaScambi As String
|
| 13 : | Dim StringaDirezioni As String
|
| 14 : | Dim Iterazioni As Long
|
| 15 : | Dim MaxIterazioni As Long
|
| 16 : | Dim NumElementi As Integer
|
| 17 : | Dim Contatore As Long
|
| 21 : | Dim RicercaPermutazione As Boolean
|
| 22 : | Dim Posizione As Integer
|
| 23 : | Dim Valore As Integer
|
| 24 : | Dim Maggiore As Boolean
|
| 25 : | Dim Mobile As Boolean
|
| 26 : | Dim PosMag As Integer 'Posizione dell' elemento maggiore
|
| 27 : | Dim LimiteMag As Integer 'Limite per la selezione del maggiore
|
| 28 : | Dim CambiaDirezione As Boolean
|
| 29 : | Dim arrayElementi() As String
|
| 30 : | Dim ArrayScambi() As Integer
|
| 31 : | Dim ArrayDirezioni() As Integer
|
| 32 : | ' Settaggio delle variabili e degli array
|
| 34 : | NomeFile = "LovazTestPermutazioni.txt"
|
| 35 : | RicercaPermutazione = True
|
| 37 : | MaxIterazioni = 10000000
|
| 38 : | NumElementi = Len(Testo)
|
| 39 : | ReDim arrayElementi(1 To Len(Testo))
|
| 40 : | For Contatore = 1 To NumElementi
|
| 41 : | arrayElementi(Contatore) = Mid(Testo, Contatore, 1)
|
| 43 : | ReDim ArrayScambi(1 To Len(Testo))
|
| 44 : | For Contatore = 1 To NumElementi
|
| 45 : | ArrayScambi(Contatore) = Contatore
|
| 47 : | ReDim ArrayDirezioni(1 To Len(Testo))
|
| 48 : | For Contatore = 1 To NumElementi
|
| 49 : | ArrayDirezioni(Contatore) = -1
|
| 51 : | ' INIZIA LA GENERAZIONE DELLE PERMUTAZIONI
|
| 52 : | ' Apri il file in scrittura per l'output dei dati
|
| 53 : | Open NomeFile For Output As #1
|
| 54 : | Print #1, "Lovaz - Generatore permutazioni"
|
| 55 : | ' Inizia il ciclo di elaborazione e scrittura delle permutazioni
|
| 56 : | Do While RicercaPermutazione
|
| 57 : | ' Libera il testo contenuto nelle stringhe di output
|
| 58 : | StringaPermutazione = ""
|
| 60 : | StringaDirezioni = ""
|
| 61 : | ' Genera le stringhe di output
|
| 62 : | For Contatore = 1 To NumElementi
|
| 63 : | StringaPermutazione = StringaPermutazione & arrayElementi(Contatore)
|
| 64 : | StringaScambi = StringaScambi & ArrayScambi(Contatore)
|
| 65 : | If ArrayDirezioni(Contatore) = -1 Then
|
| 66 : | StringaDirezioni = StringaDirezioni & "-"
|
| 68 : | StringaDirezioni = StringaDirezioni & "+"
|
| 71 : | ' Scrivi sul file di testo le stringhe generate
|
| 72 : | Print #1, StringaPermutazione & "|" & StringaScambi & "|" & StringaDirezioni
|
| 73 : | ' Inizia il ciclo di ricerca del valore mobile più grande e rileva la sua posizione
|
| 74 : | LimiteMag = UBound(arrayElementi) + 1
|
| 78 : | Do Until Maggiore = True And Mobile = True
|
| 80 : | ' Verifca in tutto l'array qual'è il valore maggiore considerando eventuali elementi bloccati
|
| 81 : | For i = LBound(arrayElementi) To UBound(arrayElementi)
|
| 82 : | If (ArrayScambi(i) > Valore And ArrayScambi(i) < LimiteMag) Then
|
| 84 : | Valore = ArrayScambi(i)
|
| 88 : | ' Verifica che l'elemento trovato non sia arrivato ai margini e quindi non possa essere spostato.
|
| 89 : | If (PosMag + ArrayDirezioni(PosMag) < LBound(arrayElementi) Or PosMag + ArrayDirezioni(PosMag) > UBound(arrayElementi)) Then
|
| 91 : | LimiteMag = ArrayScambi(PosMag)
|
| 92 : | CambiaDirezione = True
|
| 93 : | 'MsgBox "Il valore trovato ha direzione tale da puntare all' esterno del margine SX o DX; occorre cercare un nuovo numero inferiore a questo"
|
| 95 : | ' Verifica che l'elemento adiacente a quello da spostare non sia maggiore
|
| 96 : | If (ArrayScambi(PosMag + ArrayDirezioni(PosMag)) > ArrayScambi(PosMag)) Then
|
| 98 : | LimiteMag = ArrayScambi(PosMag)
|
| 99 : | 'MsgBox "Il valore maggiore non può essere spostato in questa direzione perchè ha un numero ancora più grande; occorre cercare il maggiore escluso questo"
|
| 105 : | ' Se è stato impostato come limite maggiore 1 significa che non si riesce più a trovare un numero mobile
|
| 106 : | If LimiteMag = 1 Then Exit Do
|
| 108 : | ' Effettua lo scambio nel caso in cui sia stata trovata una posizione valida
|
| 109 : | If (Posizione <> 0) Then
|
| 111 : | j = i + ArrayDirezioni(i)
|
| 112 : | ' Cambia la direzione a tutti gli elementi maggiori all'ultimo elemento mobile trovato
|
| 113 : | If CambiaDirezione = True Then
|
| 114 : | For Contatore = LBound(arrayElementi) To UBound(arrayElementi)
|
| 115 : | If (ArrayScambi(Contatore) > ArrayScambi(Posizione)) Then
|
| 116 : | ArrayDirezioni(Contatore) = ArrayDirezioni(Contatore) * -1
|
| 119 : | CambiaDirezione = False
|
| 121 : | ' Aggiorna array degli elementi
|
| 122 : | Temp = arrayElementi(i)
|
| 123 : | arrayElementi(i) = arrayElementi(j)
|
| 124 : | arrayElementi(j) = Temp
|
| 125 : | ' Aggiorna array degli scambi
|
| 126 : | Temp = ArrayScambi(i)
|
| 127 : | ArrayScambi(i) = ArrayScambi(j)
|
| 128 : | ArrayScambi(j) = Temp
|
| 129 : | ' Aggiorna array delle direzioni
|
| 130 : | Temp = ArrayDirezioni(i)
|
| 131 : | ArrayDirezioni(i) = ArrayDirezioni(j)
|
| 132 : | ArrayDirezioni(j) = Temp
|
| 134 : | RicercaPermutazione = False
|
| 136 : | ' Verifica del limite di iterazioni per fermare eventuali elaborazioni
|
| 137 : | ' troppo pesanti o bloccare cicli infiniti
|
| 138 : | Iterazioni = Iterazioni + 1
|
| 139 : | If (Iterazioni > MaxIterazioni) Then
|
| 140 : | MessaggioErrore = "Superato limite massimo iterazioni (" & Iterazioni & ")"
|
| 141 : | RicercaPermutazione = False
|
| 144 : | Close #1 'Chiusura File
|
| 146 : | If Not (MessaggioErrore = "") Then MsgBox MessaggioErrore
|
| 147 : | MsgBox "Ciclo di elaborazione concluso in: " & TempoFine - TempoInizio & " secondi" & vbCrLf & "Iterazioni eseguite: " & Iterazioni
|
Dismutazioni:
Calcolo delle permutazioni di [n] elementi in modo tale che gli elementi non compaiano mai nella posizione originaria:
VBA : CodiceCalcoloCombinatorio004
| 01 : | Function Dismutazioni(ByVal n As Long) As Long
|
| 03 : | Dim Risultato As Long
|
| 06 : | Risultato = Risultato + (-1) ^ i * Fattoriale(n) / Fattoriale(i)
|
| 08 : | Dismutazioni = Risultato
|
Disposizioni senza ripetizione:
Calcola i raggruppamenti di [k] elementi scelti dall' insieme di [n] elementi tale che ogni raggruppamento differisca dagli altri o per gli elementi presenti oppure per l'ordinamento degli elementi considerando che ogni elemento può comparire solamente una volta (motivo per cui il numero [k] di elementi del raggruppamento non può essere maggiore degli elementi disponibili nell' insieme di [n] elementi):
VBA : CodiceCalcoloCombinatorio002
| 01 : | Function DisposizioniSenzaRipetizione(ByVal n As Long, ByVal k As Long) As Long
|
| 02 : | Dim Risultato As Long
|
| 04 : | Risultato = Fattoriale(n) / Fattoriale(n - k)
|
| 06 : | Risultato = -1 'Errore il numero di posizioni è maggiore del numero di elementi a disposizione
|
| 08 : | DisposizioniSenzaRipetizione = Risultato |
Disposizioni con ripetizione:
Calcola i raggruppamenti di [k] elementi scelti dall' insieme di [n] elementi tale che ogni raggruppamento differisca dagli altri o per gli elementi presenti oppure per l'ordinamento degli elementi considerando che ogni elemento può comparire più volte:
VBA : CodiceCalcoloCombinatorio003
| 01 : | Function DisposizioniConRipetizione(ByVal n As Long, ByVal k As Long) As Long
|
| 02 : | Dim Risultato As Long
|
| 04 : | DisposizioniConRipetizione = Risultato
|
Combinazioni senza ripetizione:
Calcola quanti raggruppamenti di [k] elementi è possibile generare da un insieme di [n] elementi tenendo conto che non ha importanza l'ordinamento degli elementi all' interno del raggruppamento e ogni raggruppamento non può avere lo stesso elemento ripetuto (NB: risulta uguale al rapporto tra le disposizioni senza ripetizione e le permutazioni ottenibili in base al numero di elementi del raggruppamento):
VBA : CodiceCalcoloCombinatorio005
| 01 : | Function CombinazioniSenzaRipetizione(ByVal n As Long, ByVal k As Long) As Long
|
| 02 : | Dim Risultato As Long
|
| 04 : | Risultato = Fattoriale(n) / (Fattoriale(k) * Fattoriale(n - k))
|
| 06 : | Risultato = -1 'Errore la classe è maggiore del numero di elementi a disposizione
|
| 08 : | CombinazioniSenzaRipetizione = Risultato
|
Combinazioni con ripetizione:
Calcola quanti raggruppamenti di [k] elementi è possibile generare da un insieme di [n] elementi tenendo conto che non ha importanza l'ordinamento degli elementi all' interno del raggruppamento e ogni raggruppamento può avere lo stesso elemento ripetuto:
VBA : CodiceCalcoloCombinatorio006
| 01 : | Function CombinazioniConRipetizione(ByVal n As Long, ByVal k As Long) As Long
|
| 02 : | Dim Risultato As Long
|
| 03 : | Risultato = Fattoriale(n + k - 1) / (Fattoriale(k) * Fattoriale(n - 1))
|
| 04 : | CombinazioniConRipetizione = Risultato
|
