Umístnení souboru www.TrSek.com/cover/sargo/rozstv.pas{ 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;