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

Lazarus Pascal Discussion :

Transpositions d'une chaîne de caractères


Sujet :

Lazarus Pascal

  1. #1
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut Transpositions d'une chaîne de caractères
    Bonsoir !

    Je viens d'écrire mon premier programme avec Lazarus.

    C'est une application console, pardon c'est un projet de type programme.

    Ce programme, par un savant mélange d'itération et de récursion , génère toutes les transpositions possibles d'une chaîne de caractères.

    J'ai utilisé le type tStringList (ce qui n'est pas très difficile).

    Je vous propose mon code. Si je peux j'en ferai une version "fenêtre".

    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
     
    program Transpositions;
     
    { Génération de toutes les transpositions d'une chaîne de caractères.
      Le résultat est recueilli dans une liste de chaînes (tStringList).
     
      wiki.freepascal.org/TString_List-TString_Tutorial
      lazarus.developpez.com/cours/mots-croises/?page=pg_02
     
      Programme testé avec Lazarus 1.0.2.
    }
     
    {$APPTYPE CONSOLE}
    {$mode objfpc}{$H+}
     
    uses
      Classes, Console, Crt;
     
    {$R Icone}
     
    var
      Liste: tStringList;
     
    procedure Proc1(var vS: string; const cI: integer);
     
    { vS = abcde
      cI = 3
     
      abcde
        ---
         3
     
      ..cde
      ..cd e
      ..e cd
      ..ecd
     
      abecd
    }
    var
      n, i: integer;
      lS: string;
    begin
      n := Length(vS);
      if (cI > n) or (cI < 1) then
        Exit;
      lS := vS;
     
      lS[n - cI + 1] := vS[n];
     
      for i := n - cI + 2 to n do lS[i] := vS[i - 1];
     
      vS := lS;
    end;
     
    procedure Proc2(const cS: string; const cI: integer);
    var
      lS: string;
      i: integer;
    begin
      lS := cS;
      for i := 1 to cI do
      begin
      { Autant de fois qu'il y a de caractères concernés, on applique le
        traitement précédent à une copie locale de la chaîne passée en
        paramètre. }
        Proc1(lS, cI);
        if cI = 2 then
        { S'il n'y a plus que deux caractères concernés, on enregistre le
          résultat. }
          Liste.Add(lS)
        else
        { Autrement on refait la même chose avec un caractère de moins. }
          Proc2(lS, cI - 1);
      end;
    end;
     
    procedure Proc3(const cS: string);
    { Le traitement précédent, appliqué à toute la longueur d'une chaîne . }
    begin
      Proc2(cS, Length(cS));
    end;
     
    var
      sTest: string;
      i, d: integer;
     
    begin
      TextBackground(LightGray);
      ClrScr;
      TextColor(Black);
      Console.Intitule('Lazarus');
      WriteLn(#13#10'Transpositions d''une chaine de caracteres.'#10);
     
      Write('Veuillez saisir une chaine : ');
      TextColor(Red);
      ReadLn(sTest);
      TextColor(Black);
     
      if Length(sTest) > 0 then
      begin
        Liste := tStringList.Create;
        Proc3(sTest);
        WriteLn(#13#10'Nombre de transpositions : ', Liste.Count);
     
        Write(#10, Liste.Count, ' = ');
        i := Liste.Count;
        d := 1 ;
        while (i > 1) and not keyPressed do
        begin
          i := i div d;
          Write(d);
          if i > 1 then Write(' * ') else WriteLn(#10);
          Inc(d);
        end;
     
        Liste.SaveToFile(sTest + '.txt');
        WriteLn('Resultats enregistres dans le fichier "', sTest, '.txt".'#13#10);
        Liste.Free;
      end;
     
      while not keyPressed do Delay(100);
    end.
    Fichiers attachés Fichiers attachés
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

Discussions similaires

  1. Réponses: 8
    Dernier message: 12/02/2013, 02h08
  2. Saisie et affichage d'une chaîne de caractères
    Par sali dans le forum Assembleur
    Réponses: 2
    Dernier message: 31/03/2004, 19h01
  3. [Debutant(e)] Analyse d'une chaîne de caractères
    Par maire106 dans le forum Langage
    Réponses: 6
    Dernier message: 22/03/2004, 16h04
  4. Inverser une chaîne de caractères
    Par DBBB dans le forum Assembleur
    Réponses: 2
    Dernier message: 30/03/2003, 12h09
  5. Réponses: 3
    Dernier message: 09/05/2002, 02h39

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