Cele mai bune solutii pentru problema
"Buget de vacanta"
(ziua2, problema3)

Punctaj Maxim : 75 puncte

Solutii :
Andoni Alexandru - R. Moldova -
Erzse Gabriel - Bihor
Andoni Alexandru - R.Moldova
Drula Catalin - Bucuresti
Batog Bogdan - Bucuresti
Comisia Centrala
Fisierele de teste

Program realizat de elevul Podeanu Dan - rezultat final : premiu II - 112 puncte

program vacanta;
const
  fni='critici.in';
  fno='critici.out';
type
  Tdd=record
       v,r:byte;
      end;
var
  fi,fo:text;
  nsol,n,i,j,c,r,q,w,k:integer;
  s:array[1..100]of set of byte;
  card:array[1..100]of byte;
  g:array[1..100,1..100]of byte;
  d:array[1..100]of Tdd;
  no:boolean;
  sol:array[1..100]of record
                       i,j:integer;
                      end;

function calcCard(z:integer):integer;
var
  i,j:integer;
begin
 j:=0;
 for i:=1 to 20 do if i in s[z] then j:=j+1;
 calcCard:=j;
end;

function compat(i,j:integer):boolean;
begin
 compat:=true;
 q:=card[i];w:=card[j];
 if (abs(q-w)=1)and((s[i]-s[j]=[])or(s[j]-s[i]=[])) then exit;
 compat:=false;
end;

procedure calcD;
begin
 for i:=1 to n do begin
   d[i].v:=0;d[i].r:=i;
   for j:=1 to n do if g[i,j]=1 then inc(d[i].v);
  end;
end;

procedure sortD1;
var
  fiu,tata:byte;z:Tdd;
begin
 for i:=2 to n do begin
   fiu:=i;tata:=fiu div 2;z:=d[i];
   while (tata>0)and(d[tata].v>z.v) do begin
     d[fiu]:=d[tata];fiu:=tata;tata:=fiu div 2;
    end;
   d[fiu]:=z;
  end;
 for i:=n downto 2 do begin
   z:=d[i];d[i]:=d[1];d[1]:=z;
   tata:=1;
   fiu:=2;
   if (fiu+1<i)and(d[fiu+1].v<d[fiu].v) then fiu:=fiu+1;
   while (fiu<i)and(d[fiu].v<z.v)do begin
     d[tata]:=d[fiu];tata:=fiu;
     fiu:=tata*2;
     if (fiu+1<i)and(d[fiu+1].v<d[fiu].v) then fiu:=fiu+1;
    end;
   d[tata]:=z;
  end;
end;

begin
 assign(fi,fni);reset(fi);
 readLn(fi,c,r);
 for i:=1 to c do begin
   s[i]:=[];
   while not seekEOLn(fi) do begin
     read(fi,j);s[i]:=s[i]+[j];
    end;
   readLn(fi);
  end;
 close(fi);
 for i:=1 to c do card[i]:=calcCard(i);
 for i:=1 to c-1 do for j:=i+1 to c do if compat(i,j) then begin
   g[i,j]:=1;g[j,i]:=1;
  end else begin g[i,j]:=0;g[j,i]:=0;end;
 n:=c;nsol:=0;
 repeat
  no:=true;
  calcD;
  sortD1;
  for i:=n downto 1 do if d[i].v>0 then break;
  if d[i].v>0 then begin
    q:=d[i].r;
    for j:=n downto 1 do if g[q,d[j].r]=1 then begin
      w:=d[j].r;
      for k:=1 to n do begin g[q,k]:=0;g[k,q]:=0;end;
      for k:=1 to n do begin g[w,k]:=0;g[k,w]:=0;end;
      break;
     end;
    inc(nsol);sol[nsol].i:=q;sol[nsol].j:=w;
    no:=false;
   end;
 until no;
 assign(fo,fno);reWrite(fo);
 writeLn(fo,nsol);
 for i:=1 to nsol do writeLn(fo,sol[i].i,' ',sol[i].j);
 close(fo);
end.

[BACK]

Program realizat de Comisia Centrala a Olimpiadei Nationale de Informatica

[BACK]

Fisierele de teste :

[BACK]