Cod sursa(job #37750)

Utilizator ProtomanAndrei Purice Protoman Data 25 martie 2007 12:21:50
Problema Dezastru Scor 10
Compilator fpc Status done
Runda preONI 2007, Runda 4, Clasa a 9-a si gimnaziu Marime 1.84 kb
{generarea permutarilor}

program backtracking;
type sir=array[1..1000] of integer;
var st:sir;
    f,g:text;
    p,q:array[1..1000] of real;
    n,k,k1,i:integer;
    as,ev:boolean;
    s:real;
    nr:longint;

procedure citire;
var i:integer;
begin
     assign(f,'dezastru.in');reset(f);
     readln(f,n,k1);
     for i:=1 to n do read(f,p[i]);
     close(f);
end;

procedure initializare(k:integer;var st:sir);
begin
     st[k]:=0;
end;

procedure succesor(var as:boolean;var st:sir;k:integer);
begin
     if st[k]<n then
                    begin
                         st[k]:=st[k]+1;
                         as:=true;
                    end
                 else as:=false;
end;

procedure validare(var ev:boolean;st:sir;k:integer);
var i:integer;
begin
     ev:=true;
     for i:=1 to k-1 do
              if st[k]=st[i] then ev:=false;
end;

function solutie(k:integer):boolean;
begin
     solutie:=(k=n);
end;

procedure tiparire;
var i:integer;
begin
     inc(nr);
     q[nr]:=1;
     for i:=1 to k1 do q[nr]:=q[nr]*p[st[i]];
end;

BEGIN
     k:=1;
     citire;
     nr:=0;
     initializare(k,st);
     while k>0 do
           begin
                repeat
                      succesor(as,st,k);
                      if as then validare(ev,st,k);
                until (not as) or (as and ev);
                if as then
                   if solutie(k) then tiparire
                                 else
                                     begin
                                          k:=k+1;
                                          initializare(k,st);
                                     end
                       else k:=k-1;
           end;
     s:=0;
     for i:=1 to nr do s:=s+q[i]/nr;
     assign(g,'dezastru.out');rewrite(g);
     writeln(g,s:0:6);
     close(g);
END.