Programmation pascal anagramme

Résolu
greatpapi -  
Bonjour,
eskil ny yauré pas plus court k ca pour un programme qui permet de déterminé que deux mots sont anagrammes.

program anagramme;
uses crt;
var m1,m2:string;anag:boolean;
function ana(mot1,mot2:string):boolean;{pour déterminer si anagramme ou pa}
var i,j:integer;
function delchar(k:integer;mot:string):string; {elimination succesive des lettres trouvé}
begin
if k=1
then
delchar:=copy(mot,2,length(mot));
if k=length(mot)
then
delchar:=copy(mot,1,length(mot)-1);
if (k<>1)and(k<>length(mot))
then
delchar:=copy(mot,1,k-1)+copy(mot,k+1,length(mot));
end;

begin
i:=1;
repeat
j:=1;
repeat
if copy(mot1,i,1)=copy(mot2,j,1)
then
begin
anag:=true;
ana:=true;
mot2:=delchar(j,mot2);
end
else
begin
anag:=false;
ana:=false;
j:=j+1;
end;
until (anag=true)or(j=length(mot2)+1);
i:=i+1;
until (anag=false)or(i=length(mot1));
end;

begin{program principale}
clrscr;
writeln('mot1?');
readln(m1);
writeln('mot2?');
readln(m2);
anag:=ana(m1,m2);
if anag
then
writeln('ils sont anagrammes')
else
writeln('ils ne sont pas anagrammes');
readkey
end.
Configuration: Windows XP
Safari 525.27.1

9 réponses

  1.  KX Modérateur
    J'avoue ne pas avoir regardé ton code en détail, mais voici plus court : 
    function anagramme(mot1,mot2:string):boolean; // mot1 est-il anagramme de mot2 ?
var i:integer;
begin
i:=pos(mot1[1],mot2);
if i=0 then result:=mot1=''
       else result:=anagramme(copy(mot1,2,length(mot1)-1),
                              copy(mot2,1,i-1)+copy(mot2,i+1,length(mot2)-i));
end;

    3
    1. Skander
      Merci
      0
  2. greatpapi Auteur
    ya bcp derror ds ton code result é boolean ou????
    c zarbi
    1
    1. KX Modérateur
      Ce n'est pas une erreur, on peut écrire comme on veut soit result:= soit anagramme:=
      La seule petite erreur qui peut y avoir c'est que ton program s"appelle anagramme, et la fonction aussi
      Mais si tu renommes ton program (ou la fonction) ça marche impeccable
      0
      1. greatpapi Auteur
        ok g compris u mavé donné la methode recursive
        0
        2. greatpapi Auteur
          mais g detecté une petite erreur dans ton code car si i=1, ton i-1 pour mot2 il va debordé mais merci ta resolu mon blem
          0
          1. KX Modérateur
            En fait non, et je m'explique : copy(mot2,1,i-1) renvoi bien ce qu'on veut pour i>1
            Mais (et c'est là qu'est une partie de l'astuce) si i<=1 il renverra la chaine vide ''

            Et pour te convaincre voici le programme de test 
            program SansTitre;
 
function anagramme(mot1,mot2:string):boolean; // mot1 est-il anagramme de mot2 ?
var i:integer;
begin
i:=pos(mot1[1],mot2);
if i=0 then result:=mot1=''
       else result:=anagramme(copy(mot1,2,length(mot1)-1),
                              copy(mot2,1,i-1)+copy(mot2,i+1,length(mot2)-i));
end;

var mot1,mot2:string;
begin 
 
writeln('mot1 : '); readln(mot1); 
writeln('mot2 : '); readln(mot2);

 
if anagramme(mot1,mot2) then writeln(mot1,' est un anagramme de ',mot2) 
   else writeln(mot1,' n''est pas un anagramme de ',mot2);

writeln; write('Fin du programme. Appuyer sur Entre'); readln;
end.
            Mais effectivement ma méthode est bien récursive, ce qui est évidemment le plus concis...
            0
        3. greatpapi Auteur
          non pas dacor si i=1 ca rentre dans le else et labas i-1 sera 0 et yaura a copier de 1 a 0 . donc retest ton prog
          0
          1. KX Modérateur
            Je pense que cette mésentente vient de ta mauvaise compréhension de la fonction copy :
            on a : function copy(s:string; i:integer; n:integer):string;
            où i est l'indice de départ et n est le nombre de caractères à copier et non pas l'indice de fin

            Donc effectivement pour i=1 on rentre dans le else, cependant on aura copy(mot2,1,0)
            c'est à dire 0 caractère à partir du caractère 1 (donc rien) et non pas la copie des caractères de 0 à 1...

            J'ai testé et retesté mon programme dès ma première réponse, mais si tu trouves un couple (mot1,mot2) qui avec mon programme ne donne pas le résultat attendu, alors donne moi ce couple et je modifierai mon code, mais avec tout les cas que j'ai testé ça marche très bien...
            0
        4. greatpapi Auteur
          ok je vien de comprendre merci de mavoir aider jusqau bout
          0
          1. najehchok
            votre solution est incorrecte (exécuter avec l'exemple suivant : "test" et " tess")

            Voici une solution fiable à 100%

            program anagramme;
            uses wincrt;
            var mot1,mot2:string;
            function anag(ch1,ch2:string):boolean;
            var ana1,ana2:boolean;
            j:integer;
            begin
            ana1:=true;
            if length(ch1)=length(ch2) then
            begin
            repeat
            ana2:=false;
            j:=1;
            repeat
            if ch1[1]=ch2[j] then
            begin
            delete(ch2,j,1);
            ana2:=true;
            end
            else
            j:=j+1;
            until(ana2=true) or (j>length(ch2));
            if (ana2)then
            delete(ch1,1,1)
            else
            ana1:=false;
            until((length(ch1)=0) and(length(ch2)=0))or (ana1=false);
            end
            else
            ana1:=false;
            anag:=ana1;
            end;
            begin{program principale}
            clrscr;
            writeln('mot1?');
            readln(mot1);
            writeln('mot2?');
            readln(mot2);

            if anag(mot1,mot2)
            then
            writeln('ils sont anagrammes')
            else
            writeln('ils ne sont pas anagrammes');
            readkey
            end.
            0
            1. najehchok
              ou bien

              program anagramme;
              uses wincrt;
              var mot1,mot2:string;
              function anag(ch1,ch2:string):boolean;
              var ana1,ana2:boolean;
              p:integer;
              begin
              ana1:=true;

              if length(ch1)=length(ch2) then
              begin
              repeat
              ana2:=false;
              p:= pos(ch1[1],ch2);
              if p<>0 then
              begin
              delete(ch2,p,1);
              ana2:=true;
              end;
              if (ana2)then
              delete(ch1,1,1)
              else
              ana1:=false;
              until((length(ch1)=0)and(length(ch2)=0))or(ana1=false);
              end
              else
              ana1:=false;
              anag:=ana1;
              end;
              begin{program principale}
              clrscr;
              writeln('mot1?');
              readln(mot1);
              writeln('mot2?');
              readln(mot2);

              if anag(mot1,mot2)
              then
              writeln('ils sont anagrammes')
              else
              writeln('ils ne sont pas anagrammes');
              readkey
              end.
              0
              1. KX Modérateur
                Je suis d'accord, tes deux codes marchent (en tout cas je n'ai pas trouvé de contre exemple).

                J'ai essayé avec "test" et "tess" et mon code me dit bien qu'ils ne sont pas anagrammes, donc ma solution est bien correcte.

                À noter cependant que mon code est une petite variante de la recherche d'anagrammes, puisqu'il permet de savoir si un mot en compose un autre.
                Par exemple dans mon programme, "bon" est un anagramme de "bonjour".
                0

            Discussions similaires

            commande en Pascal
            pijahema

            12 réponses
            Code source Triangle de Pascal Matlab
            Michelangelo

            7 réponses
            Affichage d'une matrice en pascal
            Pogan

            1 réponse