Number decomposition, Stirling numbers of the second kind

The way of decomposition of a number using the "Stirling numbers of the second kind" or "number partitions" can be represented graphical like a tranverse wave; for more explanations about transverse wave motion please visit:

http://en.wikipedia.org/wiki/Stirling_number

http://www.learningincontext.com/PiC-Web/chapt08.htm

UNIT Des;
INTERFACE Uses Graph,Crt;
Type Vd=array[0..500] of word;
Var sol,sl2:Vd; i,dist,nr,v_intr:Word;
gd,gm,vdd,xd,clk:integer;
p,c,cont,val_i,opt:word;
Procedure Desen(sl:Vd;p:word);
Procedure InitGR; Procedure Concluzii_GR;
Procedure Meniu; IMPLEMENTATION Procedure Meniu; Begin
{clrscr;}
Writeln(' ~ MENIU ~');
Writeln(' 1. Text');
Writeln(' 2. Grafic'); Writeln(' Alegeti o optiune : ');
Readln(opt);
if not (opt in [1..2]) then
Begin TextColor(LightRed);
Writeln('Eroare la intr opt ');
sound(350); Delay(3500);
nosound; TextColor(15);
Halt;
End;
clrscr;
End;

Procedure InitGR;
Begin
gd:=0;
dist:=0;
Write('Intr val pt DELAY -> recomandari : min (nr*p)^2 , pt nr mici :'); Readln(v_intr);
Initgraph(gd,gm,'c:\bp\bgi'); setviewport(0,10,getmaxx-10,500,true); End;
Procedure DesHis3D(v:word); Begin
Bar3d(xd,vdd-v*10,10+xd,vdd,10,true); dist:=dist+15;
End;
Procedure Desen(sl:Vd;p:word); Begin
dist:=150;
for i:=1 to p do
Begin
setfillstyle(9,sl[i]);

xd:=dist;
vdd:=300;
if odd(clk) then
Begin setcolor(0); setfillstyle(9,0);
DesHis3D(sl2[i]); setcolor(15); setfillstyle(9,sl[i]);
DesHis3D(sl[i])
End

else
Begin setcolor(0); setfillstyle(9,0);
DesHis3D(sl2[p-i+1 ]);
setcolor(15);
setfillstyle(9,sl[p-i+1]);
DesHis3D(sl[p-i+1 ])
End
End;
Delay(v_intr);
End;
Procedure Concluzii_GR;
Begin
SetColor(LightRed);
Outtextxy(10,GetmaxY-10,'Am terminat , apasati o tasta ... ');
Readln; End; END.


Uses Crt,Des,Graph;
Procedure Init; Begin
clrscr;
c:=1;
sol[0]:=0;
cont:=0;
End;
Procedure Cit_Date; Begin
Writeln('Intr nr care urm sa fie descompus & nr de nr din descompunere :');
Readln(nr,p);
Writeln('Introduceti val min a nr nat care vor forma descompunerea :');
Readln(val_i);
if opt=1 then
Writeln('lata toate toate descompunerile : ');
End;
Procedure Concluzii; Begin
if cont=0 then Writeln('NU EXISTA NICI O ASTFEL DE DESCOMPUNERE')
else Writeln('Nr de sol este :',cont);
Writeln('Am terminat '); Readln;
End;
Procedure Final; Var i:integer; Begin
cont:=cont+1; c:=c+1; if opt=1 then
BEGIN
if c mod 23*p=0 then
begin
writeln('Apasati o tasta ');
readln; clrscr; end;
For i:=1 to p do write(sol[i]:3);
Writeln;
END
else if opt=2 then
Desen(sol,p);
sl2:=sol; End;
Function Verif(i,k,sp:word):boolean;
Begin Verif:=False;
if sp+i<=nr then if k<=p then if i>=sol[k-1]then verif:=true; End;
Procedure back(k,sp:word); Var i:integer;
Begin

if (sp=nr)and(k=p+1) then final else
for i:=val_i to nr do
if verif(i,k,sp) then
begin sol[k]:=i; back(k+1,sp+i); end;
End;
BEGIN
Meniu;
Init;
Cit_Date;
if opt=2 then
InitGR;
clk:=1;
repeat
clearviewport; Back(1,0); clk:=clk+1;
until keypressed;
if opt=1 then
Concluzii
else Concluzii_GR;
END.