Pagina de start a forumului backtracking.MyForum.ro backtracking.MyForum.ro
Fa-ti si tu propriul forum, pe www.myforum.ro!
 
 FAQFAQ   CautareCautare   MembriMembri   GrupuriGrupuri   InregistrareInregistrare 
 ProfilProfil   Mesaje privateMesaje private   AutentificareAutentificare 

pr 6 (varianta corecta)

 
Creaza un subiect nou   Raspunde la subiect    Pagina de start a forumului backtracking.MyForum.ro -> Teme pentru acasa
Subiectul anterior :: Subiectul urmator  
Autor Mesaj
Moshu
Junior
Junior


Data inscrierii: 08/Noi/2007
Mesaje: 6
Localitate: Ploiesti

MesajTrimis: 15/11/2007 11:59    Titlul subiectului: pr 6 (varianta corecta) Raspunde cu citat (quote)

Cod:
var n,j,m:integer;s1:string;
    a:array [1..20] of char;v:array [1..20] of string;
    s:array [1..10] of integer;
procedure init(k:integer);
begin
s[k]:=0;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n+1);
end;
procedure afisare(k:integer);
var i:integer;
begin
inc(m);
for i:=1 to n do
    v[m]:=v[m]+a[s[i]];
end;
function valid(k:integer):boolean;
var i,i1,nr,nr2:integer; s2:string;
begin
valid:=true;
if k=n then
   begin
   s1:='';i:=1;
   for i:=1 to k do
       s1:=s1+a[s[i]];
   for i:=1 to n do
       begin
       nr:=0;nr2:=0;   s2:=s1;
       while pos(a[i],s2)<>0 do begin
                                inc(nr);
                                delete(s2,pos(a[i],s2),1);
                                end;
       for i1:=1 to k do
           if a[i1]=a[i] then inc(nr2);
       if nr<>nr2 then valid:=false;
       end;
   for i:=1 to m do
       if s1=v[i] then valid:=false;
   end;
end;
function succesor(k:integer):boolean;
begin
if s[k]<n then begin
            s[k]:=s[k]+1;
            succesor:=true;
            end
            else succesor:=false;
end;
procedure back(k:integer);
begin
if solutie(k) then afisare(k)
              else begin
                   init(k);
                   while succesor(k) do
                         if valid(k) then back(k+1);
                   end;
end;
begin
write('n=');readln(n);
for j:=1 to n do
    begin
    write('a[',j,']=');readln(a[j]);
    end;
for j:=1 to n do
    v[1]:=v[1]+a[j];
m:=1;
writeln;
back(1);
for j:=2 to m do
    writeln(v[j]);
readln
end.
Sus
Vezi profilul utilizatorului Trimite mesaj privat
Afiseaza mesajele pentru a le previzualiza:   
Creaza un subiect nou   Raspunde la subiect    Pagina de start a forumului backtracking.MyForum.ro -> Teme pentru acasa Ora este GMT + 3 ore
Pagina 1 din 1

 
Mergi direct la:  
Nu puteti crea un subiect nou in acest forum
Nu puteti raspunde in subiectele acestui forum
Nu puteti modifica mesajele proprii din acest forum
Nu puteti sterge mesajele proprii din acest forum
Nu puteti vota in chestionarele din acest forum


Powered by phpBB © 2001, 2005 phpBB Group
Fa-ti si tu propriul forum GRATUIT, pe www.myforum.ro