Voici 5 procédures récursives permettant de générer 4 sortes de combinaisons.
Fact(x) factorielle de x est ici pour permettre le calcul dans chaque procédure, par cohérence elle est aussi récursive
Combin_tot() génère des arrangements avec remise
Combin() génère des combinaisons l’ordre n’ importe pas 012 ,021 ….210 ne compte que pour 1 combinaison
Arrang() génère des arrangements sans remise ici l’ordre différent donne des combinaisons différentes
Permute() génère des permutations
Chacune de ces procédures doit être déterminée par
1) Un nombre de cases à générer
2) Un minimum à obtenir pour chaque case
3) un maximum à obtenir pour chaque case
Chaque combinaison est un vecteur d’indice obtenu dans une table à une dimension.
Ceci permet pour chaque combinaison de générer des groupes de caractères ou des groupes de nombres dans l’ordre de l’indice de la combinaison
Ces générateurs peuvent par exemple générer en binaire les 256 combinaisons d’un octet
Init(8,0,1) => nombre de cases 8 cases minimum 0 maximum 1 => génère avec la procédure combin_tot()
Init(x,y,z) est la procédure d’initiation avec
x=nombre de case
y=indice minimum dans une case
z=indice maximum dans une case.
Pour l’exemple j’ai utilisé la fameuse phrase de Molière :
, "Belle Marquise, vos beaux yeux, me font mourir, d'amour ",
Elle contient 9 mots fact(9)= 362880 beaucoup trop important
j’ai donc limité à 4 groupes avec pour délimiteur virgule (3 virgules) donc 4 groupes fact(4)= 24
Avec ces deux instructions :
I
Code : Tout sélectionner
Global Dim Table_car$(0)
CreateRegularExpression(0, "[A-Za-z']+[^,]+");;;; retirer les espaces la virgule et , ; :
NbResults = ExtractRegularExpression(0, "Belle Marquise, vos beaux yeux, me font mourir, d'amour ", Table_car$())Code : Tout sélectionner
; Macro _Q (__Q)
; _q_t_#__Q#=_q_t_+Str(__Q)+" "
; EndMacro
; Macro _n (__n)
; _q_t_#__n#=_q_t_+Str(__n)+" "
; EndMacro
EnableExplicit
Procedure init(nbcas,Minca,maxca)
; Global Dim vect_permut(0)
Global Dim Table_car$(0)
Global nb=0,nb1=0,nb2=0, nbpermute.q=0
Global NBcase=8 ,Mincase=0 ,MAXcase=3 ;;;; prendre 0 pour generer à partir de 0 ou 1 pour generer à partir de 1
Global Dim tab(MAXcase+100)
; Debug "Mincase ="+Str(Minca)+" NBcase = "+Str(NBcase)+" MAXcase = "+Str(MAXca)
nbcase=nbcas
maxcase=maxca
If Minca < maxca
Mincase=Minca
Else
Mincase=MAXcase
EndIf
Debug " NBcase = "+Str(NBcase)+" ,Mincase = "+Str(Mincase)+" ,MAXcase = "+Str(MAXcase)
EndProcedure
; ProcedureDLL.q FACT(Nb.q)
; Define result.q
; If Nb < 2
; result.q = 1
; Else
; result.q = Fact(Nb-1)*Nb
; EndIf
; ProcedureReturn result
; EndProcedure
Procedure.q Fact(n.q)
If n<2
ProcedureReturn 1
Else
ProcedureReturn n*Fact(n-1)
EndIf
EndProcedure
; Procedure vtab()
; res$=""
; For vi=1 To Nbcase
; res$+Str(Tab(vi))+","
; Next
; Debug res$
; EndProcedure
; Procedure exploite_ind(chaine$)
; result$=""
; ; max=Len(chaine$)
; For ixi=1 To nbcase
; ; result$+Mid(chaine$,Random(Len(chaine$)),1)
; result$+Mid(chaine$,tab(ixi),1)
; Next
; Debug chaine$+" "+result$
; EndProcedure
Procedure Combin_tout(ind=1)
Define nbcombintot.q, i, j, deb$
Static xx
If xx=0 ;;; test pour exécuter une seule fois au premier appel avec l'option static xx
xx+1
Debug "******** Combinaison avec répétition ou arrangement avec remise ********"
nbcombintot.q=Pow(maxcase+(1-Mincase),Nbcase)
Debug " Arrangements avec remise = pow("+Str(maxcase+(1-Mincase))+","+Str(nbcase)+") = "+Str(nbcombintot)
EndIf
If ind<NBcase+1
For i=Mincase To MAXcase ; prendre 0 pour generer à partir de 0 ou 1 pour generer à partir de 1
tab(ind)=i
Combin_tout(ind+1)
Next
Else
deb$=""
For j=1 To NBcase
deb$+Str(tab(j))+","
; tab(j)=0
Next
nb+1
Debug deb$+" ="+Str(nb)
; exploite_ind("Pierre")
EndIf
EndProcedure
Procedure combin(ind=1)
Define nbcombin.q, i, j, deb$ , ix
Static xx
If xx=0 ;;; test pour exécuter une seule fois au premier appel avec l'option static xx
xx+1
Debug "******** Combinaisons sans répétition ********"
nbcombin.q=fact(maxcase+(1-Mincase))/(fact(maxcase+(1-Mincase)-Nbcase)*fact(nbcase))
Debug " Combinaisons s = fact("+Str(maxcase+(1-Mincase))+") / (fact("+Str(maxcase+(1-Mincase)-nbcase)+") * fact("+Str(nbcase)+") = "+Str(nbcombin)
EndIf
If ind<NBcase+1
If ind>1
ix=tab(ind-1)+1
Else
ix=Mincase
EndIf
For i=ix To MAXcase ; prendre 0 pour generer à partir de 0 ou 1 pour generer à partir de 1
tab(ind)=i
combin(ind+1)
Next
Else
deb$=""
For j=1 To NBcase
deb$+Str(tab(j))+","
; tab(j)=0
Next
nb1+1
Debug deb$+" ="+Str(nb1)
; exploite_ind("Pierre")
; vtab()
EndIf
EndProcedure
Procedure arrang(ind=1)
Define nbarrang.q, ic, jc, deb$, imp, result$, i,vp,resu$
Static xx
If xx=0 ;;; test pour exécuter une seule fois au premier appel avec l'option static xx
xx+1
Debug "******** Arrangements sana remise ********"
If (maxcase+(1-Mincase)-Nbcase)>-1
nbarrang.q=fact(maxcase+(1-Mincase))/(fact(maxcase+(1-Mincase)-Nbcase))
Else
nbarrang.q=0
EndIf
Debug " Arrangements sans remise s = fact("+Str(maxcase+(1-Mincase))+") / fact("+Str(maxcase+(1-Mincase)-nbcase)+") = "+Str(nbarrang)
EndIf
If ind<NBcase+1
For i=Mincase To MAXcase ; prendre 0 pour generer à partir de 0 ou 1 pour generer à partir de 1
tab(ind)=i
arrang(ind+1)
Next
Else
result$=""
For ic=1 To Nbcase
For jc=ic+1 To Nbcase
If tab(ic)<>tab(jc)
Else
imp-1
Break
result$=""
EndIf
Next
;;;;;********** test pour passer de la table des indices à la genération on peut utiliser cette option
;;;;;; pour les autres fonctions combin_tout combin
If Table_car$(0)=""
result$+Str(tab(ic))+","
Else
result$+table_car$(tab(ic))+" "
EndIf
;;;;;********** fin du test pour passer de la table des indices à la genération
Next
If imp=0
nb2+1
Debug result$+" ="+Str(nb2)
; exploite_ind("Pierre")
; vtab()
; exploite_ind("Pierre")
EndIf
imp=0
EndIf
EndProcedure
Procedure permute()
Global M_nbcase, m_mincase,m_maxcase
Static xx
If xx=0 ;;; test pour exécuter une seule fois au premier appel avec l'option static xx
M_nbcase=nbcase
m_mincase=mincase
m_maxcase=maxcase
; Debug _nl+_n(nbcase)+_n(mincase)+_n(maxcase)
If nbcase>(maxcase+1-mincase)
nbcase=maxcase+1-mincase
EndIf
xx+1
Debug "******** permutations ********"
; Debug "Mincase ="+Str(Mincase)+" NBcase = "+Str(NBcase)+" MAXcase = "+Str(MAXcase)
nbpermute.q=fact(Nbcase)
; ReDim vect_permut(nbcase)
Debug " Permutations = fact("+Str(nbcase)+") = "+Str(nbpermute)
nb2=0
EndIf
; Debug _nl+_n(nbcase)+_n(mincase)+_n(maxcase)
mincase=0
maxcase=nbcase-(1-Mincase)
arrang()
; Debug _nl+_n(nbcase)+_n(mincase)+_n(maxcase)
nbcase=M_nbcase
mincase=m_mincase
maxcase=m_maxcase
; Debug _nl+_n(nbcase)+_n(mincase)+_n(maxcase)
; Debug _nl+_n(m_nbcase)+_n(m_mincase)+_n(m_maxcase)
EndProcedure
;;;init(nbcas,Mincase,maxcase)
init(3,0,4)
Combin_tout()
combin()
arrang()
permute()
DisableExplicit
; ;;;*************Création d'une table de caractères ******"
; ;;; If CreateRegularExpression(0, "[A-Za-z']+[^ ,;:]+");;;; retirer les espaces la virgule et , ; :
If CreateRegularExpression(0, "[A-Za-z']+[^,]+");;;; retirer les espaces la virgule et , ; :
NbResults = ExtractRegularExpression(0, "Belle Marquise, vos beaux yeux, me font mourir, d'amour ", Table_car$())
; Debug "Nb matchs found: " + NbResults
; For i = 0 To NbResults - 1
; Debug Table_car$(i)
; Next
Else
MessageRequester("Error", RegularExpressionError())
EndIf
nbcase=ArraySize(Table_car$())+1
nbpermut.q=fact(Nbcase)
Debug " ******* Permutations du groupe de caractères = fact("+Str(nbcase)+") = "+Str(nbpermut)
nb2=0
permute()