programmation pascal anagramme Résolu/Fermé

Question

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.

KX · Accepted Answer

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;

greatpapi · Answer

ya bcp derror ds ton code result é boolean ou????
c zarbi

KX · Answer

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

greatpapi · Answer

ok g compris u mavé donné la methode recursive

greatpapi · Answer

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

greatpapi · Answer

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

greatpapi · Answer

ok je vien de comprendre merci de mavoir aider jusqau bout

najehchok · Answer

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.

najehchok · Answer

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.

Programmation pascal anagramme

9 réponses

Discussions similaires