j'ai besoin de votre aide. j'ai un programme qui marche partielement bien. je doit introduire un mot el le programme me donne toutes les mots qui se forment avec les lettres du mot donne. le programme marche pur les mots qui n'ont pas des lettres qui apparaissent plusieurs fois. mais pour les mots du type 'flamme" qui a double 'm' ne fonction pas corectement. il me montre les solutions plusieurs fois. que'ce que je dois faire? je vous laisse ici mon programme. merci beaucoup
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
 
program probl107042007;
type vector=array[1..100]of string;
var v,w:vector;
    n,i,j:integer;
    s,aux:string;
 
procedure sort;
begin
  for i:=1 to n do
      v[i]:=s[i];
   for i:=1 to n-1 do
      for j:=i+1 to n do
       if v[i]>v[j] then
         begin
           aux:=v[i];
           v[i]:=v[j];
           v[j]:=aux;
         end;
end;
 
function apar(p,ss:string):integer;
var d,c:integer;
begin
   c:=0;
   ss:=ss+'';
   while ss<>'' do
      begin
         d:=pos(p,ss);
         if d<>0 then
           begin
            inc(c);
            delete(ss,1,d);
           end
             else ss:='';
      end;
   apar:=c;
end;
 
function valid(k:integer):boolean;
var ok:boolean;
    j,i,m:integer;
begin
   j:=apar(w[k],s);
   m:=0;
   ok:=true;
   for i:=1 to k-1 do
      if w[k]=w[i] then
         if j=1 then ok:=false
              else
                  inc(m);
   if m>=j then ok:=false;
   valid:=ok;
end;
 
function final(k:integer):boolean;
begin
    final:=(k=n);
end;
 
procedure scrie(k:integer);
var i:integer;
begin
    for i:=1 to k do
       write(w[i],' ');
    writeln;
end;
 
procedure back(k:integer);
var i:integer;
begin
   for i:=1 to n do
      begin
      w[k]:=v[i];
      if valid(k) then
         if final(k) then scrie(k)
            else back(k+1);
      end;
end;
 
begin
   write('s=');readln(s);
   n:=length(s);
   sort;
   back(1);
readln;
end.