Programa: Kėlinys

Pradėjus mokytis tiesinės algebros ir geometrijos ("dievų kalbos"), viena iš mažyčių paliestų temų buvo kėliniai (toks kombinatorinis "kratinys").

Tai vat, žemiau pateikta programa ir skirta iškratyti atsitiktinio išsidėstymo kėlinį, t.y. eilę nepasikartojančių (n) skaitmenų. O programa parašyta vėlgi daug naudojant "copy+paste" technologiją.

2010-09-23, kėlinys:

program KELINYS_12;
uses crt;
var a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,i,m,n:byte;
k:integer;
begin
clrscr;
randomize;

writeln('2010-09-23 RS. KELINYS_12');
writeln('Programa generuoja atsitiktini KELINI nuo 1 iki 12 eiles');
writeln('Iveskite KELINIO eile:');
readln(n);

i:=0;
a1:=0;a2:=0;a3:=0;a4:=0;
a5:=0;a6:=0;a7:=0;a8:=0;
a9:=0;a10:=0;a11:=0;a12:=0;

if (n>0) and (n<13)
then
begin
write('(');
repeat
begin
k:=i;

m:=random(n)+1;
if (m=1) and (a1<>1) then
begin
write(m);
a1:=1;
i:=i+1;
end;
if (m=2) and (a2<>1) then
begin
write(m);
a2:=1;
i:=i+1;
end;
if (m=3) and (a3<>1) then
begin
write(m);
a3:=1;
i:=i+1;
end;
if (m=4) and (a4<>1) then
begin
write(m);
a4:=1;
i:=i+1;
end;
if (m=5) and (a5<>1) then
begin
write(m);
a5:=1;
i:=i+1;
end;
if (m=6) and (a6<>1) then
begin
write(m);
a6:=1;
i:=i+1;
end;
if (m=7) and (a7<>1) then
begin
write(m);
a7:=1;
i:=i+1;
end;
if (m=8) and (a8<>1) then
begin
write(m);
a8:=1;
i:=i+1;
end;
if (m=9) and (a9<>1) then
begin
write(m);
a9:=1;
i:=i+1;
end;
if (m=10) and (a10<>1) then
begin
write(m);
a10:=1;
i:=i+1;
end;
if (m=11) and (a11<>1) then
begin
write(m);
a11:=1;
i:=i+1;
end;
if (m=12) and (a12<>1) then
begin
write(m);
a12:=1;
i:=i+1;
end;
if (i<>n) and (i>k) then write(',');
end;
until i=n;
writeln(')');

end
else writeln('Tokios eiles KELINIO programa negeneruoja');

readkey;

end.