Cod sursa(job #71442)

Utilizator mlazariLazari Mihai mlazari Data 10 iulie 2007 15:36:46
Problema Lacate Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
Program Lacate;
var key : array[1..256,1..255] of integer;
    nkeys : array[1..256] of integer;
    L,C,N : word;

procedure Citeste;
var Intrare : text;
begin
  assign(Intrare,'lacate.in');
  reset(Intrare);
  read(Intrare,N);
  close(Intrare);
end;

procedure Calculeaza;
var ch,i,j : integer;
begin
  L:=N*(N-1) div 2;
  C:=N-1;
  for i:=1 to N do nkeys[i]:=0;
  ch:=1;
  for i:=1 to N-1 do
   for j:=i+1 to N do
    begin
      nkeys[i]:=nkeys[i]+1;
      nkeys[j]:=nkeys[j]+1;
      key[i,nkeys[i]]:=ch;
      key[j,nkeys[j]]:=ch;
      ch:=ch+1;
    end;
end;

procedure Scrie;
var Iesire : text;
    i,j : integer;
begin
  assign(Iesire,'lacate.out');
  rewrite(Iesire);
  writeln(Iesire,L,' ',C);
  for i:=1 to N do
   begin
     for j:=1 to C-1 do write(Iesire,key[i,j],' ');
     writeln(Iesire,key[i,C]);
   end;
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.