Cod sursa(job #201778)

Utilizator Cristian_BBerceanu Cristian Cristian_B Data 3 august 2008 17:41:48
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.41 kb
var f,g:text;
  ic,sc,i,j,n,k,l:byte;
  a:array[1..150,1..150] of byte;
  c{aracteristic,},cd{oada}:array[1..150] of byte;
procedure load;
var i,j:byte;
begin
  assign(f,'flori.in');reset(f);
  assign(g,'flori.out');rewrite(g);
  readln(f,n,k);
  for i:=1 to n do
  begin
   for j:=1 to k do
   read(f,a[i,j]);
   readln(f);
  end;
close(f);
end; {load}

procedure init_coada;
var i:byte;
begin
 for i:=1 to n do
 cd[i]:=0;
 ic:=1;sc:=1;
end;{init_coada}

procedure sort_coada;
var aux,i,j:byte;
begin
 for i:=1 to sc-1 do
  for j:=i+1 to sc do
  if cd[i]>cd[j] then
  begin aux:=cd[i];cd[i]:=cd[j];cd[j]:=aux; end;
end;{sort_coada}

procedure init_c;
var i:byte;
begin
 for i:=1 to n do
 c[i]:=0;
end;{init caracteristic}


function comun(l1,l2:byte):boolean;
var i,j:byte;
    ok:boolean;
begin
 ok:=false;
 for i:=1 to k do
 for j:=1 to k do
 if a[l1,i]=a[l2,j] then ok:=true;
 comun:=ok;
end;{comun}


BEGIN
 load;
 init_c;
  for i:=1 to n do
  if c[i]=0 then
   begin
    init_coada;
    cd[ic]:=i;
    c[i]:=1;
     while ic<=sc do
       begin
        for j:=1 to n do
          if (c[j]=0) and comun(cd[ic],j) and (ic<>j)  then
          begin
           c[j]:=1;
           sc:=sc+1;
           cd[sc]:=j;
          end;
        ic:=ic+1;
      end;
     sort_coada;
     for l:=1 to sc do
     write(g,cd[l],' ');
     writeln(g);
   end;
 close(g)
END.