IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Delphi Discussion :

Test possibilités possible longue boucle


Sujet :

Delphi

  1. #21
    Membre du Club
    Inscrit en
    Août 2006
    Messages
    185
    Détails du profil
    Informations forums :
    Inscription : Août 2006
    Messages : 185
    Points : 65
    Points
    65
    Par défaut
    Merci pour toutes vos réponses, en effet je voudrais faire des tests de sécurité via brute force mais peut-être pas avec 20 caractères! Cela étant un exemple...
    Je ne pense pas pouvoir utiliser les anagrammes, si j'ai bien compris ce que j'ai trouver sur internet et en essayant ta procédure : Si je met ABC il va me faire :
    ABC
    ACB
    BAC
    BCA
    CBA
    CAB
    ce qui est faut car le résultat de toutes les possibilités est :
    AAA
    AAB
    AAC
    ABA
    ABB
    ABC
    ACA
    ACB
    ACC
    BAA
    BAB
    BAC
    BBA
    BBB
    BBC
    BCA
    BCB
    BCC
    CAA
    CAB
    CAC
    CBA
    CBB
    CBC
    CCA
    CCB
    CCC
    Le résultat de toutes les possibilités est : NbrCaractères^LonguerChainePossibilités = 3^3 = 27

    Merci d'avance pour vos réponses...

  2. #22
    Modérateur

    Homme Profil pro
    Ingénieur retraité
    Inscrit en
    Octobre 2005
    Messages
    2 396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur retraité

    Informations forums :
    Inscription : Octobre 2005
    Messages : 2 396
    Points : 3 263
    Points
    3 263
    Par défaut
    BATiViR a écrit :
    mais peut-être pas avec 20 caractères
    Je ne pense pas pouvoir utiliser les anagrammes
    Nombre de caractères : Bigre : Pas clair. Maxi = combien ?
    Pourquoi pas les anagrammes ? Puisque :
    - on a le code des anagrammes qui nous génère les factorielle N! permutations correspondantes on a donc résolu le début de la liste,
    - on sait de plus que cette liste contient par définition les arrangements sans répétition des N caractères distincts N à N
    - y'a plus qu'à compléter cette liste avec un algo qui fait le reste c'est à dire les arrangements avec répétition des N caractères qui sont distincts d'origine ['A'..'W','0'..'9] et qui sont nombreux actuellement il y en a 33.

    BATiViR a ajouté :
    le résultat de toutes les possibilités est :

    AAA
    AAB
    AAC
    .....
    .. et celles qui sont plus courtes, qui font également partie des possiblilités comme suit, on les laisse de coté ? :
    A
    B
    C
    ...
    W
    AA
    BB
    CC
    ...
    WW
    ... si on peut ignorer ces dernières cela clarifiera l'énoncé du pb à résoudre avec le 2ème algo et surtout de faciliter la mise au point de cet algo.
    En comparant la liste des anagrammes de la 1ère Citation de BATiViR à la liste de sa 2ième citation je me demande même si on ne pourrait pas créer la 2ième à partir de chaque ligne de la 1ère où l'on introduit chaque fois toutes les combinaisons de répétitions de caractères possibles ?
    Bon tout ce qui précède ne forme pour l'instant qu'un ensemble de pistes de réflexion.
    A+
    N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  3. #23
    Membre du Club
    Inscrit en
    Août 2006
    Messages
    185
    Détails du profil
    Informations forums :
    Inscription : Août 2006
    Messages : 185
    Points : 65
    Points
    65
    Par défaut
    Enfaite la vitesse d'affichage n'est pas très importante car je ne connait pas beaucoup de gens qui veulent voir toutes les possiblitées...

    Je fai un test de securité la génération d'une nouvelle possibilité est beaucoup plus rapide que le "test de securité" de celle-ci.

    La première possibilité ne me permet pas de dire le Nbrde caracteres + les caractères possibles... J'ai pas envie que vous fassiez mon boulot mais si quelqu'un a déjà fait cela ou voit comment simplifier...

  4. #24
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    Ma petite solution sous forme récursive (non testée)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
     
    procedure SafeCombination(Tab: String);
    var
      Size: Integer;
     
      procedure Combination(Niv: Integer; Combin: string);
      var
        i: Integer;
      begin
        if Niv = 0 then
          Memo1.Lines.Add(Combin)
        else
          for i := 1 to Size do
            Combination(Niv-1, Combin+Tab[i]);
      End;
     
    begin
      Memo1.Clear;
      Size := Length(Tab);
      if Size < 1  then
        exit; 
      Combination(Size; '');
    End;
     
    // ...
      SafeCombination('ABC');
    C'est bon ?

    cdlt

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

  5. #25
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    je viens de me rendre compte que ma solution est très proche de la 2ème solution de Gilles Geyer, désolé mais je n'ai pas copié.
    @+

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

  6. #26
    Membre du Club
    Inscrit en
    Août 2006
    Messages
    185
    Détails du profil
    Informations forums :
    Inscription : Août 2006
    Messages : 185
    Points : 65
    Points
    65
    Par défaut
    parfait exactement ce que je cherchais, j'ai réussi a raccourcir ta fonction :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    procedure Combination(NbrCaracters: Integer; CombinCaracters, Caracters: string);
    var
      i: Integer;
    begin
      if NbrCaracters = 0 then
      begin
        Form1.Memo1.Lines.Add(CombinCaracters);
      end
      else
      begin
        for i := 1 to Length(Caracters) do
          Combination(NbrCaracters-1, CombinCaracters+Caracters[i], Caracters);
      end;
    end;
    Merci!

  7. #27
    Modérateur

    Homme Profil pro
    Ingénieur retraité
    Inscrit en
    Octobre 2005
    Messages
    2 396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur retraité

    Informations forums :
    Inscription : Octobre 2005
    Messages : 2 396
    Points : 3 263
    Points
    3 263
    Par défaut
    J'ai testé le dernier code d'Hier de BATiViR :

    Avec par exemple Combination( 3, '', 'ABCD' ); il sort bien toutes les possibiltés AAA, AAB, AAC de 3 char parmi les 3 premiers de 'ABCD' et me rend la main intantanément.

    Par contre si on demande les mêmes possibilités avec la déclaration
    Combination( 3, '', 'ABCDEFGHIJKLMNOPQRSTUVW0123456789'); le code ne rend jamais la main.

    Puis dans la série de tests croissants suivants :
    Combination(4,'', 'ABCD'); //<-- OK
    Combination(5,'', 'ABCDE'); //<-- OK
    Combination(6,'', 'ABCDEF'); //<-- Pas eu la patience d'attendre la fin de la lenteur des récurses ... because le Memo1.Lines.Add ralentisseur en plein dans la récurse (!) ... mais bon il a dit "la vitesse d'affichage n'est pas très importante".
    N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  8. #28
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Juste pour info, la fonction CalculCombinatoire que j'ai faite, répond parfaitement aux attentes, mais manipulent un Tableau au lieu d'un Memo, ce qui nettement plus rapides, car une fois le tableau en mémoire, il est facile d'afficher un fragment du résultat ... de plus, il y a un précalcul des résultats ce qui permet d'allouer la mémoire plus rapidement ... il est possible de gérer cela encore plus rapidement (en runtime) en remplaçant le tableau de string par un tableau de byte encapsulé par un objet.

    Sinon, pour 'ABCDEFGHIJKLMNOPQRSTUVW0123456789' par 3, c'est juste 35 937

    Personnellement, je n'ai pas compris le code récursif, sinon pour faire 0123456789ABCDEF par 5 donc 1 048 576 possiblité, plus que celle du dessus, je n'ai aucun soucis, cela dure une bonne minute c'est tout
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  9. #29
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    Salut

    Le problème de vitesse d'exécution ne remet pas en cause l'algorithme, le surcoût étant lié à l'affichage en cours de calcul, il est facile de l'optimiser avec une structure en mémoire comme un tableau ou une TStringList.

    Remarque pour Bativit : réécrire le code comme tu l'as fait doit être plus réfléchi car j'ai évité de passer trop de paramètres dans la routine récursive pour soulager la mémoire et améliorer un peu la vitesse d'éxecution. En outre, la procédure, qui emballe la routine récursive, contrôle le passage correct de paramètres dans la routine récursive et donc garantit la terminaison de celle-ci.

    cdlt

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

  10. #30
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Le problème de vitesse d'exécution ne remet pas en cause l'algorithme, le surcoût étant lié à l'affichage en cours de calcul, il est facile de l'optimiser avec une structure en mémoire comme un tableau ou une TStringList.
    Facile, oui, mais si l'on ne précalcul pas la valeur, je peux te dire qu'une boucle qui fait 1 millions de fois un SetLength(Tab, Length+1) d'un Tableau sera très lente, car juste pour info, un Memo contient un TStrings, il suffit d'encadrer sa fonction d'un BeginUpdate / EndUpdate de Memo.Lines, le gain de performance sera déjà conséquent ...
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  11. #31
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    Ce n'est pas moi qui est pris le parti de faire un SetLength. Le code initial que j'ai proposé évite de faire trop d'appel de fonctions inutiles comme Length().

    Une optimisation de mon code consiste à tester le niveau de profondeur des appels récursifs Niv à la valeur 1 ce qui éliminera un niveau d'appel, comme ce sont les appels terminaux, le gain ne devrait pas être négligeable.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
     
    procedure SafeCombination(Tab: String);
    var
      Size: Integer;
     
      procedure Combination(Niv: Integer; Combin: string);
      var
        i: Integer;
      begin
        if Niv = 1 then
        begin
          for i := 1 to Size do
            Memo1.Lines.Add(Combin+Tab[i]);
        end
        else
        begin
          for i := 1 to Size do
            Combination(Niv-1, Combin+Tab[i]);
        end;
      End;
     
    begin
      Memo1.Clear;
      Size := Length(Tab);
      if Size < 1  then
        exit; 
      Combination(Size, '');
    End;
     
    // ...
      SafeCombination('ABC');
    Je n'y avais pas pensé au départ.

    cdlt

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

  12. #32
    Modérateur

    Homme Profil pro
    Ingénieur retraité
    Inscrit en
    Octobre 2005
    Messages
    2 396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur retraité

    Informations forums :
    Inscription : Octobre 2005
    Messages : 2 396
    Points : 3 263
    Points
    3 263
    Par défaut
    Autre suggestion : Envoyer les combinaisons à la queu-leu-leu directement et sans intermédiaire dans le tuyau d'un TMemoryStrem ... et comme il s'agit de combinaisons de même longueur on peut très facilement récupérer celles qui son situées entre la position nb1*DeltaL et la positon nb2*DeltaL si on veut en afficher un extrait directement et sans intermédiaire dans un TMemo ou un TRichEdit.

    Suffit de remplacer la ligne Form1.Memo1.Lines.Add(); par un Write dans le MemoryStream et on aura atteint le gain de performance maxi lors de la génération des combinaisons comme pour la relecture ou l'affichage d'extraits.

    Comme j'avais déjà signalé dans mon message du 17/05/2007 16h22 qu'en remplaçant un affichage direct dans un RichEdit par un affichage différé via une StringList PUIS un MemoryStream ce dernier était 77,5 fois plus rapide et que ce facteur d'accélération augmentait paradoxalement avec le nombre d'anagrammes générés (!?) ... en conséquence de quoi je suis persuadé qu'en passant uniquement par un MemoryStream non seulement on aura atteint la vitesse d'éxec maxi et en prime on sera débarassé des inconvénients des autres approches (précalcul pour sortir un SetLength-ralentisseur hors d'une boucle ou d'une récurse)
    N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  13. #33
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Le nombre d'Element renvoyé est toujours le même ! non ? quand je parle de SetLength, je parle aussi de Lines.Add qui fait un Grow Capacity, ...

    L'AlgoRecursif doit effectivement faire moins de boucle grace à sa "mémoire" des valeurs, je l'ai relu depuis, je n'avais pas fait attention à la concaténation de valeur, qui d'ailleurs est un setlength déguisé, donc lenteur au niveau de la concaténation aussi !

    Sinon, la solution du MemoryStream, est excellente, j'y ai songé, le seul soucis c'est d'exploiter le résultat

    // Un 1er gain de rapidité provient du passage par la StringList
    Suffit de mettre BeginUpdate et EndUpdate sur les Lines, et c'est comme la TStringList en terme de performance (le EndUpdate prenant ensuite du temps pour son affichage mais rien de grave)

    Ensuite, l'utilisation du Stream serait très bénéfique en utilisant une PréAllocation de la Mémoire et en créant soit même un binaire de CombinationLength+1 (on ajoute le #10 pour délimité les chaines, mais l'on peut le manipuler exclusivement par OffSet, je suis surbooké aujourd'hui, demain, je pond vite fait un objet pour gérer le résultat d'une combinatoire via un Binaire brut qui pourra contenir les 39 000 000 de combinaison de 5 char sur ABC...789, juste 200Mo ^_^ au fait !)
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  14. #34
    Modérateur

    Homme Profil pro
    Ingénieur retraité
    Inscrit en
    Octobre 2005
    Messages
    2 396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur retraité

    Informations forums :
    Inscription : Octobre 2005
    Messages : 2 396
    Points : 3 263
    Points
    3 263
    Par défaut
    J'ai bien écrit "combinaisons de même longueur" (*) ... et nulle part je n'ai laissé entendre que "Le nombre d'Element renvoyé est toujours le même !"

    (*) : length(ABC) = lenfth(CBA) non ?

    Par contre l'idée d'optimiser encore davantage le MemoryStream avec un binaire de Combination est géniale et ne me serait même pas venue à l'idée
    N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  15. #35
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    Bonjour tout le monde

    J'ai trouvé deux solutions itératives, l'une donne des performances identiques à l'algorithme récursif de manière inattendue, l'autre est beaucoup plus rapide (en tout cas sur mon PC), cette dernière est un simple algorithme de numération avec une simple boucle for. Voici le code de la démo
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
     
    unit CombinationFrms;
     
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, Math;
     
    type
      TCombinationFrm = class(TForm)
        Memo: TMemo;
        btnAlgoRecurs: TButton;
        Edit: TEdit;
        btnAlgoIteratif: TButton;
        btnAlgoNumeral: TButton;
        procedure btnAlgoRecursClick(Sender: TObject);
        procedure btnAlgoIteratifClick(Sender: TObject);
        procedure btnAlgoNumeralClick(Sender: TObject);
      private
        { Déclarations privées }
      public
        { Déclarations publiques }
        function GetBuffSize(CharsLen: integer; LineSepLen: Integer): Integer;
        procedure SafeCombinationRecurs(Tab: String);
        procedure SafeCombinationIterat(const Tab: String);
        procedure SafeCombinationNumeral(const Tab: String);
      end;
     
    var
      CombinationFrm: TCombinationFrm;
     
    implementation
     
    {$R *.dfm}
     
    function _Power(Base, Exponent: Integer): Integer;
    var
      i: Integer;
    begin
      Result := 1;
      for I := 1 to Exponent do
        Result := Result * Base;
    End;
     
    function TCombinationFrm.GetBuffSize(CharsLen: integer; LineSepLen: Integer): Integer;
    begin
      Result := (CharsLen + LineSepLen) * _Power(CharsLen, CharsLen);
      if Result > 16777216 then
        raise Exception.Create('Nombre de caractère trop élevé pour la mémoire !');
    End;
     
    procedure TCombinationFrm.SafeCombinationRecurs(Tab: String);
    var
      Size: Integer;
     
      procedure Combination(Level: Integer; Combin: string);
      var
        i: Integer;
      begin
        if Level = 0 then
        begin
          Memo.Lines.Add(Combin);
        end
        else
        begin
          for i := 1 to Size do
            Combination(Level-1, Combin+Tab[i]);
        end;
      End;
     
    begin
      Memo.Clear;
      Size := Length(Tab);
      if Size < 1  then
        exit;
      Combination(Size, '');
    End;
     
    procedure TCombinationFrm.btnAlgoRecursClick(Sender: TObject);
    var
      d: TDateTime;
    begin
      d := Now;
      SafeCombinationRecurs(Edit.Text);
      ShowMessage('Durée = ' + FormatDateTime('hh:nn:ss:zzz', Now - d));
    End;
     
    procedure TCombinationFrm.SafeCombinationIterat(const Tab: String);
    var
      Levels: array of PChar;
      Size, I: Integer;
      Combin: String;
     
      procedure WriteCombination;
      var
        I : Integer;
      begin
        for I := 1 to Size do
          Combin[I] := Levels[Size-I]^;
        Memo.Lines.Add(Combin);
      End;
     
      function NextCombination: Boolean;
      var
        I: Integer;
      begin
        Result := True;
        I := 0;
        while True do
        begin
          if (Levels[I]+1)^ = #0 then
          begin
            Levels[I] := @Tab[1];
            Inc(I);
            if (I >= Size) then
            begin
              Result := False;
              exit;
            end;
          end
          else
          begin
            Inc(Levels[I]);
            exit;
          end;
        end;
      End;
     
    begin
      Memo.Clear;
      Size := Length(Tab);
      SetLength(Levels, Size);
      SetLength(Combin, Size);
      for I := 0 to Size-1 do
        Levels[I] := @Tab[1];
      repeat
        WriteCombination;
      until not NextCombination;
    End;
    {
    procedure TCombinationFrm.SafeCombinationIterat(Tab: String);
    var
      Levels: array of Integer;
      Size, I: Integer;
      Combin: String;
     
      procedure WriteCombination;
      var
        I : Integer;
      begin
        for I := 1 to Size do
          Combin[I] := Tab[Levels[Size-I]];
        Memo.Lines.Add(Combin);
      End;
     
      function NextCombination: Boolean;
      var
        I: Integer;
      begin
        Result := True;
        I := 0;
        while True do
        begin
          if Levels[I] >= Size then
          begin
            Levels[I] := 1;
            Inc(I);
            if (I >= Size) then
            begin
              Result := False;
              exit;
            end;
          end
          else
          begin
            Inc(Levels[I]);
            exit;
          end;
        end;
      End;
     
    begin
      Memo.Clear;
      Size := Length(Tab);
      SetLength(Levels, Size);
      SetLength(Combin, Size);
      for I := 0 to Size-1 do
        Levels[I] := 1;
      repeat
        WriteCombination;
      until not NextCombination;
    End;
    }
     
    procedure TCombinationFrm.btnAlgoIteratifClick(Sender: TObject);
    var
      d: TDateTime;
    begin
      d := Now;
      SafeCombinationIterat(Edit.Text);
      ShowMessage('Durée = ' + FormatDateTime('hh:nn:ss:zzz', Now - d));
    End;
     
     
    procedure TCombinationFrm.SafeCombinationNumeral(const Tab: String);
    var
      Size, I, MaxValue: Integer;
      Combin: String;
     
      function IntToCombinat(Value: Integer): String;
      var
        Q, R: Word;
        I: Integer;
      begin
        for I := 0 to Size-1 do
        begin
          DivMod(Value, Size, Q, R);
          Combin[Size - I] := Tab[R+1];
          Value := Q;
        End;
      End;
     
    begin
      Memo.Clear;
      Size := Length(Tab);
      SetLength(Combin, Size);
      MaxValue := _Power(Size, Size);
      for I := 0 to MaxValue - 1 do
        Memo.Lines.Add(IntToCombinat(I));
    End;
     
     
    procedure TCombinationFrm.btnAlgoNumeralClick(Sender: TObject);
    var
      d: TDateTime;
    begin
      d := Now;
      SafeCombinationNumeral(Edit.Text);
      ShowMessage('Durée = ' + FormatDateTime('hh:nn:ss:zzz', Now - d));
    End;
     
    END.
    et le dfm
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
     
    object CombinationFrm: TCombinationFrm
      Left = 198
      Top = 107
      Width = 231
      Height = 485
      Caption = 'Combinaisons'
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      OldCreateOrder = False
      PixelsPerInch = 96
      TextHeight = 13
      object Memo: TMemo
        Left = 8
        Top = 40
        Width = 209
        Height = 377
        TabOrder = 0
      end
      object btnAlgoRecurs: TButton
        Left = 8
        Top = 424
        Width = 60
        Height = 25
        Caption = 'Récursif'
        TabOrder = 1
        OnClick = btnAlgoRecursClick
      end
      object Edit: TEdit
        Left = 8
        Top = 8
        Width = 209
        Height = 21
        TabOrder = 2
        Text = 'ABCD'
      end
      object btnAlgoIteratif: TButton
        Left = 80
        Top = 424
        Width = 60
        Height = 25
        Caption = 'Itératif'
        TabOrder = 3
        OnClick = btnAlgoIteratifClick
      end
      object btnAlgoNumeral: TButton
        Left = 157
        Top = 424
        Width = 60
        Height = 25
        Caption = 'Numéral'
        TabOrder = 4
        OnClick = btnAlgoNumeralClick
      end
    end
    Je n'ai pas réglé le problème de la structure en mémoire et je tavaille donc toujours avec une TStrings (contenu dans TMemo).

    cdlt

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

  16. #36
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Alors pour ma part, j'ai testé les algos si dessus, c'est dommage de ne pas utiliser BeginUpdate/EndUpdate de Memo.Lines ...

    Bouton Recursif avec "abcdef" = 22s
    Bouton Recursif avec "abcdef" (BeginUpdate/EndUpdate) = 6s

    Bouton Iteratif avec "abcdef" = 41s
    Bouton Iteratif avec "abcdef" (BeginUpdate/EndUpdate) = 6s

    Bouton Numeral avec "abcdef" = 20s
    Bouton Numeral avec "abcdef" (BeginUpdate/EndUpdate) = 7s
    Bon, Chez Moi, IntToCombinat ne fonctionne pas puisqu'il n'y a pas d'affectation de Result, il faut ajouter "Result := Combin;"

    On peut remarquer qu'il n'y aucune différence avec ces algos à ce nombre de digit, d'ailleurs les 6s ne sont du qu'à l'affichage !
    On peut constater aussi que ces algos ne permettent d'avoir qu'une Combinatoire de la taille de l'ensemble alors qu'il faudrait ajouter le nombre d'élement de l'Arrangement ...

    Aucun des Algos ne sont capable de répondre donc à la demande !

    J'ai moi-même fait un nouvel Algo, mais les temps sont identiques, car c'est l'affichage qui prend du temps ! Donc je l'ai retiré pour tester une grande combinatoire

    Donc les 60 466 176 des combinaisons de 5 parmis 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789', prend juste pour le calcul, 25s et occupe 302 330 880 Octets et voici l'Objet :

    Il suffit de parcourir Items comme ceux d'une TStringList, pour extraire un par un les items, ... par exemple, tu peux les affichier du n° 11 125 001 au 11 126 000, ... page par page ... tu peux aussi du coup faire des recherches, d'avoir tout ceux qui commence par 'ff' ...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    type
      TCombinatoireEngine = class(TObject)
      private
        FData: Pointer;
        FCount: Integer;
        FItemLength: Integer;
        function GetItems(const Index: Integer): string;
      public
        destructor Destroy; override;
        function CalculArrangementsAvecRepetition(NbEmplacements: Integer; Objets: string): Boolean;
        property Items[const Index: Integer]: string read GetItems;
        property Count: Integer read FCount;
        property ItemLength: Integer read FItemLength;
      end;
     
    { TCombinatoireEngine }
     
    function TCombinatoireEngine.CalculArrangementsAvecRepetition(NbEmplacements: Integer; Objets: string): Boolean;
    var
      NbObjets: Integer;
      OffSet: Integer;
      Threshold, iStep: Integer;
      IndexData, IndexObjet: Integer;
    begin
      if Assigned(FData) then
        FreeMem(FData);
     
      FItemLength := NbEmplacements;
      NbObjets := Length(Objets);
      FCount := Trunc(Math.IntPower(NbObjets, NbEmplacements));
     
      GetMem(FData, FCount * FItemLength);
     
      Threshold := FCount;
      for OffSet := 0 to FItemLength - 1 do
      begin
        Threshold := Threshold div NbObjets;
        iStep := 0;
        IndexObjet := 1;
        for IndexData := 0 to FCount - 1 do
        begin
          PChar(Integer(FData) + (IndexData * FItemLength + OffSet))^ := Objets[IndexObjet];
     
          Inc(iStep);
          if iStep = Threshold then
          begin
            iStep := 0;
            Inc(IndexObjet);
            if IndexObjet > NbObjets then
              IndexObjet := 1;
          end;
        end;
      end;
    end;
     
    destructor TCombinatoireEngine.Destroy;
    begin
      if Assigned(FData) then
        FreeMem(FData);
     
      inherited;
    end;
     
    function TCombinatoireEngine.GetItems(const Index: Integer): string;
    begin
      if Index < FCount then
      begin
        SetLength(Result, FItemLength);
        CopyMemory(@Result[1], Pointer(Integer(FData) + Index * FItemLength), FItemLength);
      end else
      begin
        raise EListError.CreateFmt(SListIndexError, [Index]);
      end;
    end;
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  17. #37
    Modérateur

    Homme Profil pro
    Ingénieur retraité
    Inscrit en
    Octobre 2005
    Messages
    2 396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur retraité

    Informations forums :
    Inscription : Octobre 2005
    Messages : 2 396
    Points : 3 263
    Points
    3 263
    Par défaut
    De mon côté j'ai apporté quelques retouches au code de Bativir (version simplifiée du code de e-ric) pour envoyer la rafale de combinaisons-avec-répétitions directement dans un MemoryStream au lieu du RichEdit que j'avais utilisé à la place du Memo1.

    Résultats pour générer la série de 3125 "combinaisons" à partir de ABCDE :
    - avec RichEdit : mis 3104 millisec
    - avec MemoryStream seul : 10 millisec soit 310 fois rapide
    d'où l'intérêt d'exclure de toute boucle-ou-récurse l'appel à un composant d'affichage (TMemo, TRichEdit, etc) tant que la phase de création des "combinaisons" n'est pas achevée d'autant plus qu'on ne voit que le début de la liste sur le composant pendant qu'il ralentit la création du reste de la liste!

    Résultats pour générer la série de 46656 "combinaisons" à partir de ABCDEF :
    - avec RichEdit : pas eu la patience because 310 fois plus lent !!!
    - avec MemoryStream seul : 105 millisec alors que l'on pourrait s'attendre à 10ms*(46656/3125)*((6+1)/(5+1)) = 174 millisec.

    (j'utilise "combinaisons" au sens du langage de la rue)

    Il reste juste un bug dans le code et que je n'ai pas encore trouvé ( ) car l'affichage dans le RichEdit depuis le MemoryStream renvoie des séquences de caractères où le nombre de caractères placés entre les caractères de séparation est exactement le double du résultat attendu comme si le code bégayait AAAABAAAAB au lieu de AAAAB : AAAAAAAAAAAAAABAAAABAAAACAAAACAAAADAAAADAAAAEAAAAEA... Si quelqu'un a une idée sur l'origine de ce bégayement cela m'intéresse. Voiçi de toutes façons le code pour l'histoire des gains de performance.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    var       streamC : TMemoryStream;
    
    procedure EcritStringDansMemStream(MemStream: TMemoryStream; str : string);
    var       longueur, i : integer; c : char;
    begin     longueur:=length(str);
              MemStream.Write(longueur, 1);
              for i:=1 to longueur do
              begin  c:=str[i];
                     MemStream.Write(c, 1);
              end;
              MemStream.Write(PChar(str)^, length(str));
    end;
    procedure Combination(NbrCaracters: Integer; CombinCaracters, Caracters: string);
    var       i: Integer;
    begin     if NbrCaracters = 0
              then begin //Form1.Memo1.Lines.Add(CombinCaracters);
                         //Form1.Red1.Lines.Add(CombinCaracters);
                         EcritStringDansMemStream(StreamC, CombinCaracters);          end else
              begin for i := 1 to Length(Caracters)
                    do Combination(NbrCaracters-1, CombinCaracters+Caracters[i], Caracters);
              end;
    end;
    
    var       ChronoR : oChrono;
              nbCara  : integer;
    procedure TForm1.bCombEtRepetesClick(Sender: TObject);
    var       Caracters: string;
    begin     red1.Clear;
              edRes.text:='';
              // ----------------
              ChronoR.Top(labChronoR);
              nbCara :=5;   //<   3125 Combinaisons  10 millisec avec TMemoryStream et 3104 milli avec RichEd
              nbCara :=6;   //<  46656 Combinaisons 105 millisec avec TMemoryStream
              //nbCara :=7; //< 823543 Combinaisons mais msg plus de mémoire lors de l'extension du flux !
              Caracters:=copy('ABCDEFGHIJKLMNOPQRSTUVW0123456789',1,nbCara);
              streamC:=TMemoryStream.create;
              Combination(nbCara,'', Caracters);          ChronoR.Mis;
              // ----------------
              edRes.text:= intToStr(red1.lines.count)
                           +' Combinaisons avec '+intToStr(nbCara)+'caractères';
    end;
    
    procedure TForm1.bAfficheExtraitClick(Sender: TObject);
    begin     StreamC.position:=0;
              Red1.Lines.LoadFromStream(StreamC); 
             // ok-mais renvoie chaque combinaison dédoublée AAAABAAAAB au lieu de AAAAB : AAAAAAAAAAAAAABAAAABAAAACAAAACAAAADAAAADAAAAEAAAAEA
    end;
    Ayant limité les essais aux "combinaisons" à partir de 'ABCDEF' je me suis contenté pour l'affichage d'un simple Red1.Lines.LoadFromStream(StreamC) il est évident que pour une utilisation sur ordinateur avec une big-mémoire il faudrait remplacer cela par l'affichage d'un extrait de ce qui est situé de MemStream.Position:=debutExtrait à MemStream.Position:=finExtrait; sinon c'est lors de l'affichage qu'il risque d'y avoir des lenteurs.

    e-ric a écrit :Je n'ai pas réglé le problème de la structure en mémoire et je tavaille donc toujours avec une TStrings (contenu dans TMemo).
    : il suffira de remplacer les Memo.Lines.Add(String); par EcritStringDansMemStream(StreamC, String); qui apparaît dans le code ci-dessus quand on aura trouvé l'origine du bégayement évoqué plus haut.

    ShaiLeTroll a écrit :
    d'ailleurs les 6s ne sont du qu'à l'affichage !
    : ces 6000 millisec, c'est quand même 57 fois plus long que les 105 millisec via le MemoryStrem pour le même cas ABCDEF.
    Cela donnerait quoi comme délai d'écécution avec TCombinatoireEngineBis où la génération des "combinaisons" serait entièrement dissociée de l'affichage ?
    N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  18. #38
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    pour ton bug c'est dans
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
     
    procedure EcritStringDansMemStream(MemStream: TMemoryStream; str : string);
    var       longueur, i : integer; c : char;
    begin     longueur:=length(str);
              MemStream.Write(longueur, 1);
              for i:=1 to longueur do
              begin  c:=str[i];
                     MemStream.Write(c, 1);
              end;
              MemStream.Write(PChar(str)^, length(str));
    end;
    qu'il faut chercher, d'une part, tu écris la longueur (sur un caractère) de str dans le flux, cela produit une donnée non imprimable (carac #1, #2 ...ou #N), d'autre part tu écrit deux fois str de manière différente, c'est dommage.

    Ceci devrait être plus correct :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
    procedure EcritStringDansMemStream(MemStream: TMemoryStream; str : string);
    begin
      MemStream.Write(str[1], length(str));
    end;
    Je suis en train de chercher une solution avec un TFileStream mais je n'ai pas fini.

    Question à ShaiLeTroll : Comment calcules-tu le nombre de combinaisons ? Je ne trouve pas du tout les mêmes résultats que toi.

    cdlt

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

  19. #39
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Pour les Arrangements avec Répétition la Fomule c'est n puissance k, n étant le nombre d'élement dans le Set (ABC...789 = 36) et k, la taille du mot souhaité (AA = 2, AAA = 3, ...)

    ABCDE (5), mot de 1 = A, B, C, D, E = 5 Arrangements
    ABCDE (5), mot de 2 = AA, AB, AC, AD, ... = 25 Arrangements
    ABCDE (5), mot de 3 = AAA, AAB, AAC, ... = 125 Arrangements
    ABCDE (5), mot de 4 = AAAA, AAAB, AAAC, ... = 625 Arrangements
    ABCDE (5), mot de 5 = AAAAA, AAAAB, AAAAC, ... = 3125 Arrangements

    ABCDEF (6), mot de 1 = A, B, C, D, E, F = 6 Arrangements
    ABCDEF (6), mot de 2 = AA, AB, AC, AD, ... = 36 Arrangements
    ABCDEF (6), mot de 3 = AAA, AAB, AAC, ... = 1296 Arrangements
    ABCDEF (6), mot de 4 = AAAA, AAAB, AAAC, ... = 7776 Arrangements
    ABCDEF (6), mot de 5 = AAAAA, AAAAB, AAAAC, ... = 46656 Arrangements

    Sinon 105 millisec pour 46656, mon algo est à 22 000 ms pour 39 000 000 (juste le calcul), et l'objet modifié propose l'enregistrement dans un fichier

    Pour la Gestion Mémoire, il faut allouer au départ la mémoire, d'un coup tout le bloc, car si tu l'appel à MemStream.Write fait des réallocations mémoires couteuses en temps et en mémoire, je n'utilise qu'un simple pointer, c'est beaucoup moins compliqué à comprendre, c'est brut mais simple !

    Sinon, l'écriture du fichier sans Delimiter c'est une bonne minutes, avec séparateurs, j'ai eu le temps de taper ce message 413 Mo écrit par packet de 5 et de 2 (en plus en debug) c'est long évidemment !

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
     
    type
      TCombinatoireEngine = class(TObject)
      private
        FData: Pointer;
        FCount: Integer;
        FItemLength: Integer;
        function GetItems(const Index: Integer): string;
      public
        destructor Destroy; override;
        function CalculArrangementsAvecRepetition(NbEmplacements: Integer; Objets: string): Boolean;
        procedure SaveToFile(const FileName, Delimiter: string);
        property Items[const Index: Integer]: string read GetItems;
        property Count: Integer read FCount;
        property ItemLength: Integer read FItemLength;
      end;
     
    { TCombinatoireEngine }
     
    function TCombinatoireEngine.CalculArrangementsAvecRepetition(NbEmplacements: Integer; Objets: string): Boolean;
    var
      NbObjets: Integer;
      OffSet: Integer;
      Threshold, iStep: Integer;
      IndexData, IndexObjet: Integer;
    begin
      if Assigned(FData) then
        FreeMem(FData);
     
      FItemLength := NbEmplacements;
      NbObjets := Length(Objets);
      FCount := Trunc(Math.IntPower(NbObjets, NbEmplacements));
     
      GetMem(FData, FCount * FItemLength);
     
      Threshold := FCount;
      for OffSet := 0 to FItemLength - 1 do
      begin
        Threshold := Threshold div NbObjets;
        iStep := 0;
        IndexObjet := 1;
        for IndexData := 0 to FCount - 1 do
        begin
          PChar(Integer(FData) + (IndexData * FItemLength + OffSet))^ := Objets[IndexObjet];
     
          Inc(iStep);
          if iStep = Threshold then
          begin
            iStep := 0;
            Inc(IndexObjet);
            if IndexObjet > NbObjets then
              IndexObjet := 1;
          end;
        end;
      end;
    end;
     
    procedure TCombinatoireEngine.SaveToFile(const FileName, Delimiter: string);
    var
      OutFile: file;
      IndexData: Integer;
    begin
      AssignFile(OutFile, FileName);
      ReWrite(OutFile, 1);
      try
        if Delimiter = '' then
        begin
          BlockWrite(OutFile, PChar(FData)^, FCount * FItemLength);
        end
        else
        begin
          for IndexData := 0 to FCount - 1 do
          begin
            BlockWrite(OutFile, PChar(Integer(FData) + IndexData * FItemLength)^, FItemLength);
            BlockWrite(OutFile, Delimiter[1], Length(Delimiter));
          end;
        end;
      finally
        CloseFile(OutFile);
      end;
    end;
     
    destructor TCombinatoireEngine.Destroy;
    begin
      if Assigned(FData) then
        FreeMem(FData);
     
      inherited;
    end;
     
    function TCombinatoireEngine.GetItems(const Index: Integer): string;
    begin
      if Index < FCount then
      begin
        SetLength(Result, FItemLength);
        CopyMemory(@Result[1], Pointer(Integer(FData) + Index * FItemLength), FItemLength);
      end else
      begin
        raise EListError.CreateFmt(SListIndexError, [Index]);
      end;
    end;
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
     
    procedure TFrmTestDivers.btnAlgoObjetClick(Sender: TObject);
    var
      CE: TCombinatoireEngine;
      I: Integer;
      d: TDateTime;
    begin
      d := Now;
      CE := TCombinatoireEngine.Create();
      try
        CE.CalculArrangementsAvecRepetition(StrToInt(EdCombinatoireLength.Text), EdCombinatoireSet.Text);
    // CE.CalculArrangementsAvecRepetition(5, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789');
     
        CE.SaveToFile('CalculArrangementsAvecRepetition.Txt', #13#10);
      finally
        CE.Free();
      end;
      ShowMessage('Durée = ' + FormatDateTime('hh:nn:ss:zzz', Now - d));
    end;
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  20. #40
    Membre expert
    Avatar de e-ric
    Homme Profil pro
    Apprenti chat, bienfaiteur de tritons et autres bestioles
    Inscrit en
    Mars 2002
    Messages
    1 559
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Apprenti chat, bienfaiteur de tritons et autres bestioles

    Informations forums :
    Inscription : Mars 2002
    Messages : 1 559
    Points : 3 946
    Points
    3 946
    Par défaut
    J'ai cru comprendre (et je ne suis pas le seul) que c'était les combinaisons qui étaient recherchées pas les arrangements.

    cdlt

    M E N S . A G I T A T . M O L E M
    Debian 64bit, Lazarus + FPC -> n'oubliez pas de consulter les FAQ Delphi et Pascal ainsi que les cours et tutoriels Delphi et Pascal

    "La théorie, c'est quand on sait tout, mais que rien ne marche. La pratique, c'est quand tout marche, mais qu'on ne sait pas pourquoi. En informatique, la théorie et la pratique sont réunies: rien ne marche et on ne sait pas pourquoi!".
    Mais Emmanuel Kant disait aussi : "La théorie sans la pratique est inutile, la pratique sans la théorie est aveugle."

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 3
    Dernier message: 26/02/2009, 14h51
  2. Test possibilité de mise à jour.
    Par brsoft.org dans le forum Accès aux données
    Réponses: 3
    Dernier message: 05/06/2007, 18h54
  3. $_post["$test"] c possible ??
    Par fongus dans le forum Langage
    Réponses: 6
    Dernier message: 07/06/2006, 20h56
  4. Longue boucle ?
    Par choas dans le forum Langage
    Réponses: 9
    Dernier message: 11/03/2006, 20h19
  5. Réponses: 4
    Dernier message: 09/12/2005, 08h25

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo