Macro pour quadrillageRésolu

Question

Bonjour,

je souhaiterai créer une matrice qui contient toutes les combinaisons vérifiant les contraintes suivantes : 

- x est le nombre de colonne (x est choisit par l'utilisateur)
- 1 point de la matrice est compris entre 0 et 1 avec un pas donné (imposé par l'utilisateur)
- la somme de tous les points d'une même ligne doit être égale exactement à 1
Par exemple, j'aimerai que quadri(4, 0.5) où x 4 et pas 0.5 devra donner le résultat : 
1       0       0        0
0.5    0.5    0        0
0        1        0         0
0.5    0        0.5     0
0        0.5    0.5    0
0        0        1        0
0.5   0      0       0.5
0      0.5   0       0.5
0        0        0.5     0.5
0        0        0         1

ou quadri (3,0.25) devra donner le résultat : 
1          0            0            
0.75      0.25      0            
0.5         0.5         0
0.25      0.75      0
0             1             0
0.75     0          0.25
0.5         0.25      0.25
0.25      0.5         0.25
0           0.75      0.25
0.25     0.25     0.5
0.5         0             0.5
0             0.5         0.5
0.25      0             0.75
0             0.25      0.75
0             0             1

Je pense qu'il faut utiliser une macro récursive mais je n'arrive pas à la construire. Pouvez-vous m'aider ?

cs_Jack · Accepted Answer

Re
Mais de rien, il y avait longtemps que je n'avais programmé et ça m'a semblé un cas intéressant pour occuper ma nuit.
Le Unload Me ne sert qu'à refermer la forme en VB6 : j'aurai dû le supprimer moi même, j'ai oublié.

Quant aux résultats, comme je te l'ai dit, les autres solutions ne sont que des combinaisons des solutions de base, c'est à dire qu'il n'y a plus qu'à mélanger l'ordre des chiffres.
Je te laisse cette partie, creuse toi un peu la tête, un empilement de 3 ou 4 "For-Next" devrait suffire à créer les lignes de matrice manquantes.
Pour ajouter des lignes au tableau maMatrice, il te suffit de t'inspirer du "Redim Preserve" utilisé dans mes lignes.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_Jack · Answer

Salut Problème amusant ... et casse tête. Je me suis essayé. Voilà le code que j'ai pondu pour trouver les combinaisons de base. Il ne te reste qu'à créer les combinaisons suivantes qui ne sont que des mélanges de celles de base. Colle ce code dans un nouveau projet pour l'essayer. Nota : Tu as posté ta question dans la catégorie VB6, je te fournis donc un programme en VB6 Comme tu parles de "macro", il y a fort à parier que tu travailles sous Excel, Word ou Access. La syntaxe est la même - Adapte-le

Option Explicit Private Type monType Col() As Single End Type Private maMatrice() As monType Private IndexMatrice As Long Private mesCol() As Single

Private Sub Form_Load() Dim NbColonnes As Integer Dim Pas As Single Dim r As Integer Dim t As Single NbColonnes = 4 ' \ Les deux paramètres Pas = 0.25 ' / ' Initialise la matrice IndexMatrice = 1 ReDim maMatrice(1 To IndexMatrice) ' Recherche les combinaisons de base t = 1 Do While t >= 0.5 ' Initialise la ligne en cours ReDim mesCol(1 To NbColonnes) ' Donnée de départ mesCol(1) = t Call CalculeSuivants(1, Pas, 2, NbColonnes) ' Décrémente la 1ere colonne t = t - Pas DoEvents Loop ' Supprime la dernière ligne qui est vide IndexMatrice = IndexMatrice - 1 ReDim Preserve maMatrice(1 To IndexMatrice) ' Affiche les résultats Debug.Print "----------------------------" Debug.Print IndexMatrice; " lignes de base :" For r = 1 To IndexMatrice For t = 1 To NbColonnes Debug.Print maMatrice(r).Col(t), Next t Debug.Print Next r Unload Me End Sub

Private Sub CalculeSuivants(ByVal ValeurDépart As Single, _ ByRef Pas As Single, _ ByVal IndexDépart As Integer, _ ByRef IndexMax As Integer) ' Sub qui s'appelle elle-même - attention aux modifs Dim r As Integer Dim s As Single ' Recalcule la somme actuelle For r = 1 To (IndexDépart - 1) s = s + mesCol(r) Next r DoEvents Select Case (s + ValeurDépart) Case 1 ' On est arrivé au bout ' Mémorise cette dernière valeur mesCol(IndexDépart) = ValeurDépart ' Mémorise cette ligne maMatrice(IndexMatrice).Col = mesCol ' Prépare la ligne de matrice suivante IndexMatrice = IndexMatrice + 1 ReDim Preserve maMatrice(1 To IndexMatrice) ' Si la valeur actuelle n'est pas le mini If (ValeurDépart - Pas) >= 0 Then ' On recommence avec valeur inférieure sans changer d'index Call CalculeSuivants(ValeurDépart - Pas, Pas, IndexDépart, IndexMax) End If Case Is < 1 ' On insère et on continue ' Mémorise cette dernière valeur mesCol(IndexDépart) = ValeurDépart ' Recherche valeur suivante (index suivant) If IndexDépart < IndexMax Then Call CalculeSuivants(ValeurDépart, Pas, IndexDépart + 1, IndexMax) End If Case Is > 1 ' Perdu ' Teste valeur plus petite (sans changer d'index) If (ValeurDépart - Pas) >= 0 Then Call CalculeSuivants(ValeurDépart - Pas, Pas, IndexDépart, IndexMax) End If End Select End Sub

Vala Jack, MVP VB NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Estelle_BNP · Answer

Bonjour, en effet c'est un vrai casse-tête et je n'arrive pas à m'en sortir. Tout d'abord je tiens à vous remercier pour votre aide. Vous avez du passer pas mal de temps sur cet algorithme et je vous en remercie vivement. Lorsque je fais tourner votre programme j'ai un message d'erreur sur la ligne Upload Me donc je l'ai mise en commentaire. Lorsque je le teste ensuite avec les paramètres 4 et 0.5, j'ai la matrice ---- 1, 0, 0, 0, ---- 0.5, 0.5, 0, 0 et lorsque je le teste ensuite avec les paramètres 3 et 0.25, j'ai la matrice ---- 1, 0, 0, ---- 0.75, 0.25, 0, ---- 0.5, 0.5, 0, ---- 0.5, 0.25, 0.25 Il manque des cas. J'ai essayé de comprendre comment fonctionner votre programme pour l'adapter mais je n'y arrive pas. J'ai beaucoup de mal avec les fonctions récursives qui s'appelle elle-même. Pouvez-vous m'aider ?

Macro pour quadrillage

3 réponses

Votre réponse

Discussions similaires