{ 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.