All pastes #916086 Raw Edit

Untitled

public text v1 · immutable
#916086 ·published 2008-02-24 10:04 UTC
rendered paste body
type vek=array[1..50] of byte;
     lista=^elem;
     elem=record
           kov:array[1..50] of lista;
           p:vek;
           n:byte;
          end;

var x:vek;
    m:byte;
    b:lista;

procedure be;
var f:text;
    i:byte;
begin
 new(b);
 assign(f,'nunta.in');
 reset(f);
 readln(f,b^.n);
 for i:=1 to 50 do b^.kov[i]:=nil;
 for i:=1 to b^.n do
  read(f,b^.p[i]);
 close(f);
end;

procedure ki;
var f:text;
    i:byte;
begin
 assign(f,'nunta.out');
 rewrite(f);
 writeln(f,m);
 for i:=1 to m do write(f,x[i],' ');
 close(f);
end;

procedure kiterjeszt(var l:lista);
var p:lista;
    i,j:byte;
begin
 if l^.kov[1]=nil then begin
                        for i:=1 to 50 do l^.kov[i]:=nil;
                        for i:=1 to l^.n-1 do begin

                         new(l^.kov[i]);
                         l^.kov[i]^.n:=l^.n-1;
                         for j:=1 to i-1 do l^.kov[i]^.p[j]:=l^.p[j];
                         for j:=i+2 to l^.n do l^.kov[i]^.p[j-1]:=l^.p[j];
                         if l^.p[i]>l^.p[i+1] then begin
                                                    l^.kov[i]^.p[i]:=l^.p[i]-l^.p[i+1];
                                                   end
                         else begin
                               l^.kov[i]^.p[i]:=l^.p[i+1]-l^.p[i];
                              end;
                         for j:=1 to 50 do l^.kov[i]^.kov[j]:=nil;
                        end;
                       end
                  else
 begin
  for i:=1 to 50 do
   if l^.kov[i]<>nil then kiterjeszt(l^.kov[i]);
 end;
end;

function vege(l:lista):boolean;
var i:byte;
begin
 if l^.n=1 then vege:=true
           else
 begin
  for i:=1 to 50 do
   if l^.kov[i]<>nil then break;
  if l^.kov[i]<>nil then vege:=vege(l^.kov[i])
                    else vege:=false;
 end;
end;

procedure osszeszamol(l:lista);
var i:byte;
    ok:boolean;
begin
 if l^.n=1 then begin
                 ok:=true;
                 for i:=1 to m do
                  if x[i]=l^.p[1] then begin
                                        ok:=false;
                                        break;
                                       end;
                 if ok then begin
                             inc(m);
                             x[m]:=l^.p[1];
                            end;
                end
           else begin
                 for i:=1 to l^.n do osszeszamol(l^.kov[i]);
                end;
end;

function oszt(b,j:byte):byte;
var t,k:byte;
begin
 k:=b;
 t:=x[k];
 while b<j do begin
  while (b<j) and (x[k]<=x[j]) do dec(j);
  x[k]:=x[j];
  k:=j;
  while (b<j) and (x[k]>=x[b]) do inc(b);
  x[k]:=x[b];
  k:=b;
 end;
 x[k]:=t;
 oszt:=k;
end;

procedure quick(b,j:byte);
var k:byte;
begin
 if b<j then begin
              k:=oszt(b,j);
              quick(b,k-1);
              quick(k+1,j);
             end;
end;

begin
 be;

 while not vege(b) do
  kiterjeszt(b);

 m:=0;
 osszeszamol(b);

 quick(1,m);

 ki;

end.