Cod sursa(job #238112)

Utilizator DanielGGlodeanu Ioan Daniel DanielG Data 31 decembrie 2008 16:52:41
Problema Tablete Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
var a:array[1..1000,1..1000] of longint;
v:array[1..1000000] of 0..1;
buf:array[1..32768] of byte;
n,k:integer;  spatiu,i,j,nr,ind:longint;
f:text;
procedure citire;
begin
assign(f,'tablete.in');
reset(f);
read(f,n,k);
close(f);
end;
procedure scrie;
var i,j:integer;
begin
assign(f,'tablete.out');
settextbuf(f,buf,32768);
rewrite(f);
for i:=1 to n do
    begin
    for j:=1 to n do
        write(f,a[i,j],' ');
    writeln(f);
    end;
close(f);
end;
begin
for i:=1 to 1000000 do v[i]:=0;
citire; nr:=2;
for i:=1 to n do
     begin
     spatiu:=i*k;
     if spatiu<=nr then  begin
                        a[i,k]:=nr;
                        v[nr]:=1;
                        end
     else
         begin
         while spatiu>nr do nr:=nr+2;
         a[i,k]:=nr;
         v[nr]:=1;
         end;
     end;
ind:=1;
for i:=1 to n do
    for j:=1 to k-1 do
         begin
         if v[ind]=1 then       begin
                                inc(ind);
                                a[i,j]:=ind;
                                inc(ind);
                                end
             else begin
                  a[i,j]:=ind;
                  inc(ind);
                  end;
         end;
for i:=1 to n do
    for j:=k+1 to n do
    begin
         if v[ind]=1 then       begin
                                inc(ind);
                                a[i,j]:=ind;
                                inc(ind);
                                end
             else begin
                  a[i,j]:=ind;
                  inc(ind);
                  end;
   end;
scrie;
end.