Rozklad hodnoty na 4 štvorce čísel

{ ROZSTV.PAS                                    Copyright (c) Sargo }
{                                                                   }
{ Rozklad hodnoty na 4 stvorce cisiel                               }
{ program sluzi na najdenie vsetkych stvorprvkovych mnozin ktorych  }
{ sucet stvorcov jednodlivych prvkov sa rovnaju danej hodnote       }
{                                                                   }
{ Author: Sargo                                                     }
{ Date  : 29.07.2006                           http://www.trsek.com }
 
program rozklad;
uses crt;
type g= array[0..3] of integer;
var m:array[1..100] of g;
    a,b,d,n,j:integer;
    c:g;
 
 
{porovnavanie poli ci prvky  }
{poli tvoria rovnake mnoziny }
 
function r(a,b:g):boolean;
var h,d,e:integer;
begin
 e:=0;
 for h:=0 to 3 do
  for d:=0 to 3 do
   if (a[h]=b[d]) and (a[h]>-1) then
   begin
     a[h]:=-1;
     b[d]:=-1;
     inc(e)
   end;
 
 if e=4 then
    r:=true
 else
    r:=false
end;
 
 
{hladanie roznych vyslednych mnozin}
{zapisanie tychto mnozin do pola m }
 
procedure p(i,s:integer;c:g);
var d:integer;
begin
 d:=0;
 
 if (i=4) then if (s=n) then
  begin
   for a:=1 to j do
     if r(m[a],c) then
        i:=3;
 
     if i=4 then begin
        inc(j);
        m[j]:=c
     end
  end
 else
  repeat
    c[i]:=d;
    p(i+1,s+d*d,c);
    inc(d);
  until (d*d>n);
 
end;
 
 
begin
 {Zadanie hodnoty}
 clrscr;
 writeln('Zadaj hodnotu: ');readln(n);
 
 p(0,0,c);
 
 {Vypis vysledkov}
 
 writeln('Vysledne mnoziny su: ');
 for a:=1 to j do
  begin
   for b:=0 to 3 do
       write(m[a][b]:2,' ');
   writeln;
  end;
 
 readln;
end.