Daugybos "matmintiniškas" treniruočių poligonas

Šiaip ne taip pavykusi programa, skirta "mokytis" daugybos (2011-04-03).
Tai paprasčiausias random užduočių išmetimo programa, kuri prašo sudauginti du skaičius iki 30, ir sulygina su teisingu atsakymu.
Be to, kad programa pateikia laiką, kiek buvo spręstas uždavinys, jis dar tą laiką įsirašo į sukuriamą failą, ir saugo jį ten dviem parametrais: vidutinis tam tikros užduoties (vienos iš 30x30 užduočių) sprendimo laikas , ir kiekis, kiek kartų toji užduotis buvo pateikiama.
Prieš pradedant žaisti, reikia nueiti į žaidimo opcijas ir pasirinkti sukurti naują failą, po failo sukūrimo, jis jau tampa užpildytas defaultinėmis reikšmėmis, kur vidutinis užduoties alikimo laikas įrašytas kaip 2 sekundės, o užduoties pateikimo kiekis - 1. Dar galima failą sukurti taip, kad defaultiniai užduočių sprendimo laikai būtų mažesni lengvesniems uždaviniams, ir didesni - sunkesniems.
Programa pateikia užduotį ne visai random būdu, o randomina 5 atsitiktines užduotis ir sulygina, kuri iš j sunkiausia žaidėjui, ir tą ir pateikia. Dėl to antrojo būdo failo sukūrimas su "progresyviniais" defaultiniais nustatymais privers programą dažniau mėtyti sudėtingesnius uždavinius, t.y. dažniausiai prašys sudauginti du skaičius iš intervalų [20..30].
Lengvesnes užduotis išsprendus per trumpesnį laiką, rezultatas įsirašo į failą, ir vėliau toji užduotis bus išmetama gerokai rečiau.
Programą išjungus, rezultatai išlieka, kadangi jie rašomi į sukurtą failą, kuris yra toje pačioje direktorijoje kur ir programos failas.

Taigi: screenshot'ai ir programos kodas:





program mult;
uses crt, dos;

procedure defreiksmes(var r, p: integer);
begin r:=10; p:=100; end;

procedure help;
begin
writeln('RS, 2011-04-03, daugyba');
writeln(#249,' Is pradziu pasirinkite pavadinima, kuriuo pavadinsite faila (pvz. manof)');
writeln('Tada eikite i nustatymus (1). Ten pasirinkite 2');
writeln(#249,' Programa paklaus, kokiu budu uzpildyti faila: 1 arba 2.');
writeln('1 - panasi tikimybe visiems veiksmams, 2 - didesne tikimybe sunkesniems');
writeln(#249,' Failas bus perrasytas, arba jeigu tokiu pavadinimu failo nebuvo - sukurtas naujas');
writeln;
writeln(#249,' Jums skaiciuojant, jusu rezultatai pildosi i pasirinkta faila');
writeln(#249,' Kuo ilgiau prie uzduoties sugaistate laiko,');
writeln('tuo didesne tikimybe kita kart gauti sia uzduoti');
writeln(#249,' Is pradziu sis efektas silpnas, taciau pildantis uzduociu');
writeln('sprendimo istorijai, stipreja');
writeln(#249,' Uz klaidinga atsakyma prisideda 3 sek ir keliauja i statsitika');
writeln;
writeln(#249,' Pagal defaulta(nutylejima), tarp uzduociu daroma 0.1 sek pauze,');
writeln('zaidziate 10 uzdaviniu ciklais. Taciau siuos nustatymus ');
writeln('galite keisti kol programa ijungta');
writeln('Isjungus programa ir vel ijungus, atsistato defaultiniai nustatymai');
writeln(#249,' Sprendimu istorija niekur nedingsta, nes ji uzrasyta tekstiniuose failuose');
writeln('Ja galite pradanginti, jeigu ta faila perrasysite su opcija "sukurti nauja defaultini faila" ');
writeln;
writeln(#249,' Uzpilde faila antruoju defaultiniu budu,');
writeln('gausite didesne tikimybe sunkesniu uzduociu atsiradimams');
writeln(#249,' Po zaidimo, jusu paklaus, ar norite pamatyti zemelapi');
writeln(#249,' Zemelapyje pavaizduota daugybos lentele 30x30, ir kiekvienas langelis reiskia');
writeln('kiek vidutiniskai laiko sugaisote sprendziant ta uzdavini');
writeln('Taciau i rezultata issiskaiciuoja ir pirmasis - defaultinis rezultatas,');
writeln('atsirades kuriant faila');
writeln;
writeln(#249,' Pilka spalva zemelapyje dazniausiai reiks, kad to veiksmo');
writeln('nebuvo ne karto atlikta');
writeln(#249,' Programoje gali buti klaidu');
readln;
end;

procedure defaultas(vidg: integer; fa:string);
const ko = 30;
var t: text;
i,j,k, g: integer;
b: array [1..ko*ko] of integer;
begin
writeln('Pasirinkite default varianta: 1 arba 2. (1 - lygiai, 2 - progresyviai)');
readln(g);
assign(t, fa);
rewrite(t);
writeln(t, vidg);
for i:=1 to ko do
for j:=1 to ko do
begin
k:=j+(i-1)*ko;
b[k]:=vidg;
if g=2 then begin
if (i<11) or (j<11) then b[k]:=vidg-25;
if (i<11) and (j<11) then b[k]:=vidg-75;
if ((i>10) and (j>20)) or ((i>20) and (j>10)) then b[k]:=vidg+50;
if (i>20) and (j>20) then b[k]:=vidg+150;
end;
writeln(t, b[k]);
writeln(t, '1');
end;
close(t);
end;

const ko = 30;
var
i,j,k,l,ll: integer;
t:text;
fa:string;
vidg, r, p: integer;
kla: integer;
s,z : array [1..ko*ko] of string;
b,c : array [1..ko*ko] of integer;
val1, min, sek, mil : word;
val2, min2, sek2, mil2 : word;
dtime: longint;
ax, max, mx, ixj, kodas, ats: integer;
zaistidar: boolean;

begin
clrscr;
randomize;

vidg:=200;

defreiksmes(r, p);
kla:=10;

b[1]:=15; b[2]:=14; b[3]:=10; b[4]:=11; b[5]:=9; b[6]:=13; b[7]:=12;
for i:=1 to 7 do begin textcolor(b[i]); writeln('Labas'); end; textcolor(7);

writeln('Kuriame faile saugoti rezultatus?');
writeln('(iveskite esamo failo pavadinima arba suteikite pavadinima naujam)');
readln(fa);
fa:=fa+'.txt';

while kla = 10 do begin
writeln('Eikite i Informacija ivesdami "1", arba pradekite zaidima ivesdami kitka.');
readln(kla);

if kla = 1 then
repeat begin
writeln('Informacija');
writeln('Pasirinkite opcija (iveskite atitinkama skaiciu)');
writeln(' 0 - grizti');
writeln(' 1 - paskaityti apie programa');
writeln(' 2 - sukurti nauja defaultini faila');
writeln(' 3 - pasirinkti kartojimu skaiciu');
writeln(' 4 - pasirinkti uzduodamu veiksmu sunkumus');
writeln(' 5 - pasirinkti pauzes trukme (milisekundemis)');
writeln(' 6 - grazinti defaultinius nustatymus');
readln(kla);
if kla = 0 then kla:=10
else if kla = 1 then help
else if kla = 2 then defaultas(vidg, fa)
else if kla = 3 then begin writeln('iveskite kartojimu sk.'); readln(r); end
else if kla = 4 then
else if kla = 5 then begin writeln('iveskite pauzes trukme'); readln(p); end
else if kla = 6 then defreiksmes(r, p);
end; until kla=10;
end;

zaistidar:=true;
while zaistidar do begin

assign(t, fa);
reset(t);
readln(t, vidg);
for i:=1 to ko do
for j:=1 to ko do begin
k:=j+(i-1)*ko;
readln(t, s[k]);
readln(t, z[k]);
val(s[k], b[k], kodas);
val(z[k], c[k], kodas);
end;
close(t);

for l:=1 to r do
begin
writeln('uzduoties numeris: ',l);
delay(p);

max:=0;
for ll:=1 to 5 do begin
ax:=random(ko*ko)+1;
if b[ax]> max then begin max:=b[ax]; mx:=ax; end;
end;
i:= mx div ko + 1;
j:= mx mod ko;
if j=0 then j:=(mx-1) mod ko + 1 ;
ixj:= i*j;
writeln(i:2,' x ',j:2);

GetTime(val1, min, sek, mil);
readln(ats);
GetTime(val2, min2, sek2, mil2);
dtime:=(val2-val1)*360000+(min2-min)*6000+(sek2-sek)*100+(mil2-mil);
writeln('laiko galvota: ',dtime div 100,':',dtime mod 100:2);
if ixj=ats then writeln('tiesa')
else begin writeln('NEtiesa. Ats.: ',ixj); dtime:=dtime+300 end;

b[mx]:=round((c[mx]*b[mx]+dtime)/(c[mx]+1));
c[mx]:=c[mx]+1;
end;

assign(t, fa);
rewrite(t);
writeln(t, vidg);
for i:=1 to ko*ko do begin
writeln(t, b[i]);
writeln(t, c[i]);
end;
close(t);

writeln('Ar zaidziam toliau? (1 - taip)');
readln(kla);
if kla <> 1 then

begin

writeln('Ar parodyti zemelapi? (1 - taip)');
readln(kla);
if kla = 1 then
begin
write(' 0 - 150: '); textcolor(15); writeln(#219); textcolor(7);
write('150 - 200: '); textcolor(14); writeln(#219); textcolor(7);
write('200 - 250: '); textcolor(10); writeln(#219); textcolor(7);
write('250 - 300: '); textcolor(11); writeln(#219); textcolor(7);
write('300 - 400: '); textcolor(9); writeln(#219); textcolor(7);
write('400 - 500: '); textcolor(13); writeln(#219); textcolor(7);
write('500 - + : '); textcolor(12); writeln(#219); textcolor(7);
write(' ');
for i:=1 to 30 do
for j:=1 to 30 do
begin
k:=j+(i-1)*ko;
if b[k]<= 100 then ats:=15
else if b[k]<= 150 then ats:=14
else if b[k]<= 200 then ats:=10
else if b[k]<= 350 then ats:=11
else if b[k]<= 450 then ats:=9
else if b[k]<= 550 then ats:=13
else ats:=12;
if b[k]=200 then ats:=7;
textcolor(ats);
if j<> 30 then write(c[k])
else begin writeln(c[k]); if (i mod 10)=0 then writeln; end;
if (j mod 10) = 0 then write(' ');
end;

end;
textcolor(7);

writeln('Ar zaidziam toliau? (1 - taip)');
readln(kla);
if kla <> 1 then
zaistidar:=false;
end;

end;
writeln('Sekmes! (iseiti - enter)');
readln;
end.

Memo žaidimas :)

Šią programą parašiau po šachmatų programos nepribaigimo (2011 kovo pradžioje)
Žaidimas "memo" yra kur kas lengvesnis, jeigu neskaityti to, kad viskas padarytas labai primityviai: reikia įsiminti ne paveikslėlius, o paprastus skaičius negrafinėje aplinkoje :)

Siūlau šią programą išbandyti, t.y. pažaisti žaidimą! (tiems, kas turi Pascalį (parsisiųsti))

2011-04-13 programą šiek tiek patobulinau, nes buvo keli "bugai", ir dar prirašiau neseniai išmoktą laiko skaičiavimo funkciją, (sužinojau iš šios internetinės vietos - http://scripterz.linija.net/v3/index.php?id=katalogas&f=145 ).

Vualia:

program Memo;
uses crt, dos;
const max=10;
type lentostipas = array [1..max,1..max] of integer;
type logtipas = array [1..max,1..max] of boolean;
type repxy = array [1..5] of integer;
var i,j, k,l, n, x,y, rep, repi: integer;
zaistidarsk, lenta, ilg, plo, varkie, pasirvar, indvar: integer;
atmp, inda : integer;
zaistidar, endgame, same : boolean;
v: array [1..3] of integer;
a: lentostipas;
s: logtipas;
xrep, yrep: repxy;
aa,as,ad,af: word; //1
qq,qw,qe,qr, times: word; //2
begin
clrscr;
randomize;

zaistidar:=true; v[3]:=1;
while zaistidar do
begin
writeln('pasirinkite lentos dydi, ivesdami atitinkama skaitmeni');
writeln('1 - 4x3, 2 - 5x4, 3 - 6x5, 4 - 8x6, 5 - 10x6');
readln(lenta);
if lenta=1 then begin ilg:=4; plo:=3; varkie:=2; v[1]:=2; v[2]:=3; end;
if lenta=2 then begin ilg:=5; plo:=4; varkie:=2; v[1]:=2; v[2]:=4; end;
if lenta=3 then begin ilg:=6; plo:=5; varkie:=2; v[1]:=2; v[2]:=3; end;
if lenta=4 then begin ilg:=8; plo:=6; varkie:=2; v[1]:=2; v[2]:=3; end;
if lenta=5 then begin ilg:=10;plo:=6; varkie:=3; v[1]:=2; v[2]:=3; v[3]:=5 end;
writeln('pasirinkite po kiek vienodu paveiksleliu bus poligone');
writeln('pasirinkimo variantai: ');
for i:=1 to 5 do
if lenta=i then for j:=1 to varkie do write(' ',v[j]:2);
writeln;
readln(pasirvar);
for j:=1 to varkie do if v[j]=pasirvar then indvar:=j;

for i:=plo downto 1 do //priskiriami skaiciai [1..ixj]
for j:=1 to ilg do
a[j,i]:=(i-1)*ilg+j;

for i:=plo downto 1 do //vienodu skaiciu sudarymas
for j:=1 to ilg do
a[j,i]:=(a[j,i]+v[indvar]-1) div v[indvar];

for n:=1 to 3 do //triskart ismaiso lenta
for i:=1 to plo do
for j:=1 to ilg do
begin
atmp:=a[j,i];
l:=random(plo)+1;
k:=random(ilg)+1;
a[j,i]:=a[k,l];
a[k,l]:=atmp;
end;

for i:=max downto 1 do //logiskai uzvienetinam kintamuju lauka
for j:=1 to max do s[j,i]:=true;
for i:=plo downto 1 do //logiskai uznulinam zaidziama lenta
for j:=1 to ilg do s[j,i]:=false;

GetTime(aa,as,ad,af);
repeat //1
begin
endgame:=true;

rep:=0;
repeat //1.1
begin
clrscr;
rep:=rep+1;
for i:=plo downto 1 do //parodom lenta
begin
for j:=1 to ilg do
if s[j,i] then write(' ',a[j,i]:2) else write(' -');
writeln;
end;
writeln;

writeln('iveskite langelio koord x ir y');
readln(x,y);
while not( (x<=ilg) and (y<=plo) and (x>0) and (y>0) ) or s[x,y] do
begin
if not( (x<=ilg) and (y<=plo) and (x>0) and (y>0) ) then
begin
writeln('uzribio koordinates! iveskite x ir y is naujo');
readln(x,y);
end
else
begin
writeln('si kortele jau atverta, pasirinkite kita');
readln(x,y);
end;
end;
s[x,y]:=true;
xrep[rep]:=x;
yrep[rep]:=y;

same:=true;
for repi:=1 to rep do
begin
inda:=a[xrep[1],yrep[1]];
same:=same and (inda=a[xrep[repi],yrep[repi]]);
end;

if not same then
begin
clrscr;
for i:=plo downto 1 do //parodom lenta
begin
for j:=1 to ilg do
if s[j,i] then write(' ',a[j,i]:2) else write(' -');
writeln;
end;
writeln;
delay(1000);
for repi:=1 to rep do
begin
s[xrep[repi],yrep[repi]]:=false;
end;
end;

end;
until (rep=v[indvar]) or (same=false) ; //1.1

for i:=plo downto 1 do //tikrinam ar visi langeliai atverti
for j:=1 to ilg do
endgame:=endgame and s[j,i];

end;
until endgame=true; //1
GetTime(qq,qw,qe,qr);
times:=((qq-aa)*360000+(qw-as)*6000+(qe-ad)*100+(qr-af));
writeln('Sprendimo laikas: ', times div 6000,' min, ',(times mod 6000) div 100,' sek, ',times mod 100);
writeln('jeigu norite zaisti dar, iveskite 1, jeigu ne - kita skaiciu');
readln(zaistidarsk);
if zaistidarsk<>1 then zaistidar:=false;
end;

writeln('viso gero!');
readln;
end.

[apatinio kairiojo langelio koordinatės yra (0|0)]

Nesėkmingas bandymas suprogramint šachmatus

Žiemą buvau pasirašęs šachmatų programos juodraštį. Pavasario pradžioje dar kartą prisėdau prie programos (2011-03-04+), tiksliau pradžioje prie sąsiuvinio, ir kelias valandas programinau sąsiuvinyje. Vėliau prisiruošiau bandyti perkelinėti viską į kompiuterį ir žiūrėti, kas gausis. Perkelinėjau į kompiuterį programą tokiame lygyje, kad žaisti galima: darant ėjimus, tačiau be tokių mandrų ėjimų, kaip rokiruotė, kirtimas prasilenkiant, figūros vertimas kita pasiekus paskutinę gulstinę ir pnš. Taipogi nebuvo realizuotas matas, t.y. žaidimo esmė: "pralaimėjimo varžovui paskelbimas".

Ir, po kelių pataisymų, tokia "betikslė" programa veikė.

Tada per dar kokias dvi dienas pažaidžiau su Pascaliu, kol išmokiau daryti leistinus ėjimus su karaliumi, reaguoti į šachus, drausti kirsti prasilenkiant netinkamu laiku. Visos tokios išimtys ir j apdorojimas užima daugiau kaip 2/3 programos teksto :/

Iš pradžių pateiksiu programos screenshotą, t.y. negrafinėje aplinkoje atvaizduotą partijos pradžios fragmentą, o toliau pateiksiu kodą.
Ši programa užima virš 300 eilučių, tai ilgiausia kada nors rašyta mano programa ir daugiausiai laiko.



program chessbeta_2011_03_04_RS;
uses crt;
// type figa= (_,R,N,B,Q,K,p);
var a: array [1..8,1..8] of integer;
mv: array [1..100] of integer;
n1: array [1..8] of boolean;
rok: array [1..20] of boolean;
i,j, move,mov, fig,en, atmp, R1,RR, ec, ko1,ko2,ko3,ko4, kn,km: integer;
x,y,v,z,kx,ky,bx,by,jx,jy, xx, max,max2,min2, che: integer;
kieno, kie,ch,ch2: string;
// f: figa;
check, enorm, boo1,boo2,boo3,bool,boor, nn,m, dmw,dmb, eQ, c1,c2: boolean;

begin
clrscr;

a[1,1]:=1; a[1,8]:=11; a[8,1]:=1; a[8,8]:=11; //bokstai
a[2,1]:=2; a[2,8]:=12; a[7,1]:=2; a[7,8]:=12; //zirgai
a[3,1]:=3; a[3,8]:=13; a[6,1]:=3; a[6,8]:=13; //rikiai
a[4,1]:=4; a[4,8]:=14; a[5,1]:=5; a[5,8]:=15; //valdoves ir karaliai
for i:=1 to 8 do begin a[i,2]:=6; a[i,7]:=16; end; //pestininkai
for i:=1 to 8 do for j:=3 to 6 do a[i,j]:=0; //tusti langeliai

bx:=5; by:=1; jx:=5; jy:=8; //pradines karaliu koordinates
R1:=0; move:=0; mv[1]:=9999; mov:=0; dmb:=false; dmw:=false;
while R1=0 do
begin
clrscr;

move:=move+1;
mov:=move mod 2;

for j:=8 downto 1 do //nupiesiama grazi lenta
begin
for i:=1 to 8 do
begin
if a[i,j] div 10 = 1 then ch2:='1' else ch2:='+';
if a[i,j] mod 10 = 0 then ch:='.' else
if a[i,j] mod 10 = 1 then ch:='R' else
if a[i,j] mod 10 = 2 then ch:='N' else
if a[i,j] mod 10 = 3 then ch:='B' else
if a[i,j] mod 10 = 4 then ch:='Q' else
if a[i,j] mod 10 = 5 then ch:='K' else
if a[i,j] mod 10 = 6 then ch:='p';
if a[i,j] mod 10 = 0 then write(' ',ch,' ') else
write(' ', ch2+ch:2);
end;
writeln;
end;
writeln;
for i:=1 to move do writeln(i:2,' from: ', mv[i] div 100:2,' to: ', mv[i] mod 100:2,' ',(i+1) div 2); //isspausdinamas ejimu sarasas


if mov=1 then kieno:='Baltieji' else kieno:='Juodieji';


if mov=1 then //konstantos baltuju...
begin
ko1:=10; ko2:=17; ko3:=-1; ko4:=6;
end;

if mov=0 then //konstantos juoduju...
begin
ko1:=0; ko2:=7; ko3:=1; ko4:=12;
end;

for i:=1 to 20 do rok[i]:=false; //rokiruotes galimos

repeat
begin
enorm:=true; // =kol kas ejimas normalus

repeat //nuskaitom ejimo koordinates
begin
writeln(kieno, ' atlikite ejima');
READLN(x,y,v,z);
m:=(x>0) and (y>0) and (v>0) and (z>0) and (x<9) and (y<9) and (v<9) and (z<9);
m:=m and (((mov=1) and (a[x,y] in [1..6])) or ((mov=0) and (a[x,y] in [11..16])));
if not m then writeln('klaida');
end;
until m=true;


if mov=1 then begin kx:=bx; ky:=by; end; //baltuju karaliaus koordinaciu nurasymas
if mov=0 then begin kx:=jx; ky:=jy; end; //juoduju karaliaus koordinaciu nurasymas
writeln('karalius: ',kx,' ',ky); //trinti veliau

{ check:=false; (...?)
...tikriname ar shachas...
if check=true then writeln('check!');
}
fig:=a[x,y]; en:=a[v,z];
writeln('fig:=a[x,y]= ',a[x,y],' en:=a[v,z]= ',a[v,z]); //trinti veliau


if fig in [1,11,4,14] then //bokstas (valdove)
begin
if fig in [1,11] then writeln('fig 1/11') else writeln('fig 4,14');
if ((en=0) or ((en>ko1) and (en
begin
if x-v<>0 then
begin
xx:=abs(x-v);
max:=(x+v+xx) div 2;
while xx>1 do
begin
max:=max-1; xx:=xx-1;
if a[max,y]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
if y-z<>0 then
begin
xx:=abs(y-z);
max:=(y+z+xx) div 2;
while xx>1 do
begin
max:=max-1; xx:=xx-1;
if a[x,max]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
end
else begin enorm:=false; ec:=3; end;
end;
eQ:=enorm;
enorm:=true;

if fig in [3,13,4,14] then //rikis (valdove)
begin
if fig in [3,13] then writeln('fig 3/13');
if ((en=0) or ((en>ko1) and (en
begin
if x-v=y-z then
begin
xx:=abs(x-v);
max:=(x+v+xx) div 2;
max2:=(y+z+xx) div 2;
while xx>1 do
begin
max:=max-1; max2:=max2-1; xx:=xx-1;
if a[max,max2]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
if x-v=z-y then //cia su klaidom kol kas palieku.... gal istaisiau?
begin
xx:=abs(x-v);
max:=(x+v+xx) div 2;
max2:=(y+z+xx) div 2;
min2:=max2-xx;
while xx>1 do
begin
max:=max-1; min2:=min2+1; xx:=xx-1;
if a[max,min2]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
end
else begin enorm:=false; ec:=3; end;
end;

if fig in [4,14] then //del valdoves
begin
if eQ or enorm then enorm:=true;
end
else enorm:=enorm and eQ;




if fig in [2,12] then //zirgas
begin
writeln('fig 2/12');
if ((en=0) or ((en>ko1) and (en
else begin enorm:=false; ec:=3; end;
end;


boo2:=false;

if fig in [6,16] then //pestininkai
begin
writeln('fig 6/16');
boo1:=(en=0) and (x=v) and (y-z=ko3); //+1
boo2:=(en=0) and (x=v) and ((y-z=2*ko3) and (y+z=ko4) and (a[x,(y+z) div 2]=0)); //+2
boo3:=((en>ko1) and (en
bool:=false;
if x>1 then bool:=(en=0) and (y-z=ko3) and (abs(x-v)=1) and (a[x-1,y]=6+ko1);
if mov=1 then bool:=bool and dmb;
if mov=0 then bool:=bool and dmw;
boor:=false;
if x<8 then boor:=(en=0) and (y-z=ko3) and (abs(x-v)=1) and (a[x+1,y]=6+ko1);
if mov=1 then boor:=boor and dmb;
if mov=0 then boor:=boor and dmw;

if (boo1=true) or (boo2=true) or (boo3=true) or (bool=true) or (boor=true) then
enorm:=true
else begin enorm:=false; ec:=3; end;
end;

if (mov=1) then if (boo2=true) then dmw:=true else dmw:=false;
if (mov=0) then if (boo2=true) then dmb:=true else dmb:=false;
//...klaida dmw kai true, tada ir i kaire ir i desine kirsti galima...

if fig in [5,15] then //karalius
begin
writeln('fig 5/15');
if ((en=0) or ((en>ko1) and (en<=1) and (abs(y-z)<=1) then enorm:=true
else begin enorm:=false; ec:=3; end;

end;


{ if fig=4 ... //valdove
...tikrinam ar leistinas ejimas...
(kazkaip sunkiai pridejau prie rikio ir boksto)
}
if (mov=1) and (a[x,y]=5) and enorm then begin kx:=v; ky:=z; end;
if (mov=0) and (a[x,y]=15) and enorm then begin kx:=v; ky:=z; end;
atmp:=a[v,z]; a[v,z]:=a[x,y]; a[x,y]:=0;
writeln('atmp:=a[v,z]; a[v,z]:=a[x,y]; ',atmp,' ',a[v,z]); //trinti veliau


{ //idesime sacho tikrinima
che:=0;
repeat
begin
che:=che+1;
if che=2 then
begin a[x,y]:=a[v,z]; a[v,z]:=atmp; end;
if che=3 then
begin a[x,y]:=a[v,z]; a[v,z]:=atmp; a[(x+v) div 2,y] end;
if a[v,z] in [5,15]}

check:=false;
//tikriname ar shachas?

//ar shachas nuo boksto/valdoves?
kn:=kx; km:=ky;
while kn<8 do //1
begin
kn:=kn+1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then kn:=8;
end;
writeln('is desines ',check);
kn:=kx; km:=ky;
while km<8 do //2
begin
km:=km+1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then km:=8;
end;
writeln('is virsaus ',check);
kn:=kx; km:=ky;
while kn>1 do //3
begin
kn:=kn-1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then kn:=1;
end;
writeln('is kaires ',check);
kn:=kx; km:=ky;
while km>1 do //4
begin
km:=km-1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then km:=1;
end;
writeln('is apacios ',check);

//ar shachas nuo zirgo?
kn:=kx; km:=ky;
for i:=1 to 8 do n1[i]:=false;
if (kn-2>0) and (kn-2<9) and (km-1>0) and (km-1<9) then n1[1]:= (a[kn-2,km-1]-ko1=2);
if (kn-2>0) and (kn-2<9) and (km+1>0) and (km+1<9) then n1[2]:= (a[kn-2,km+1]-ko1=2);
if (kn-1>0) and (kn-1<9) and (km-2>0) and (km-2<9) then n1[3]:= (a[kn-1,km-2]-ko1=2);
if (kn-1>0) and (kn-1<9) and (km+2>0) and (km+2<9) then n1[4]:= (a[kn-1,km+2]-ko1=2);
if (kn+1>0) and (kn+1<9) and (km-2>0) and (km-2<9) then n1[5]:= (a[kn+1,km-2]-ko1=2);
if (kn+1>0) and (kn+1<9) and (km+2>0) and (km+2<9) then n1[6]:= (a[kn+1,km+2]-ko1=2);
if (kn+2>0) and (kn+2<9) and (km-1>0) and (km-1<9) then n1[7]:= (a[kn+2,km-1]-ko1=2);
if (kn+2>0) and (kn+2<9) and (km+1>0) and (km+1<9) then n1[8]:= (a[kn+2,km+1]-ko1=2);
nn:=false;
for i:=1 to 8 do nn:=nn or n1[i];
if nn=true then check:=true;
writeln;
writeln(check);

//ar shachas nuo rikio/valdoves/pestininko?
kn:=kx; km:=ky;
while (kn<8) and (km<8) do //1
begin
kn:=kn+1; km:=km+1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=1 then if (a[kn,km]=16) and (kn-kx=1) then check:=true;
if (a[kn,km]<>0) then kn:=8;
end;
writeln('++ ',check);
kn:=kx; km:=ky;
while (kn>1) and (km>1) do //2
begin
kn:=kn-1; km:=km-1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=0 then if (a[kn,km]=6) and (kn-kx=-1) then check:=true;
if (a[kn,km]<>0) then kn:=1;
end;
writeln('-- ',check);
kn:=kx; km:=ky;
while (kn<8) and (km>1) do //3
begin
kn:=kn+1; km:=km-1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=0 then if (a[kn,km]=6) and (kn-kx=1) then check:=true;
if (a[kn,km]<>0) then kn:=8;
end;
writeln('+- ',check);
kn:=kx; km:=ky;
while (kn>1) and (km<8) do //4
begin
kn:=kn-1; km:=km+1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=1 then if (a[kn,km]=16) and (kn-kx=-1) then check:=true;
if (a[kn,km]<>0) then kn:=1;
end;
writeln('-+ ',check);

{ if che=2 then
begin
atmp:=a[v,z]; a[v,z]:=a[x,y];
if check then c1:=true else c1:=false;
if not cast then che:=che+1;
end; }

{ end;
until che=3 ;
//idesime sacho tikrinima
}

if check=true then
begin writeln('neleistinas ejimas. testi: 0, pasiduoti: 1');
readln(RR);
enorm:=false; ec:=2;
end;


a[x,y]:=a[v,z]; a[v,z]:=atmp;
if (mov=1) and (a[x,y]=5) then begin kx:=bx; ky:=by; end;
if (mov=0) and (a[x,y]=15) then begin kx:=jx; ky:=jy; end;

if enorm=false then
begin
if ec=1 then writeln('kelyje trukdo figura, ec 1');
if ec=2 then writeln('neleistinas ejimas: sachas, ec 2');
if ec=3 then writeln('uzimtas langelis, ec 3');
end;

//rokiruociu aprasas
rok[1]:= enorm and (a[x,y] =1) and (x=1);
rok[2]:= enorm and (a[x,y] =1) and (x=8);
rok[3]:= enorm and (a[x,y]=11) and (x=1);
rok[4]:= enorm and (a[x,y]=11) and (x=8);
for i:=5 to 8 do rok[i]:=rok[i] or rok[i-4]; //ar sugadinti bokstai
rok[9]:= enorm and (a[x,y]= 5) and (abs(x-v)<=1) and (abs(y-z)<=1);
rok[10]:= enorm and (a[x,y]=15) and (abs(x-v)<=1) and (abs(y-z)<=1);
for i:=5 to 8 do rok[i]:=rok[i] or rok[((i+1) div 2)+6]; //ar sugadinti karaliai


end;
until (enorm=true) or (RR=1);

mv[move]:=x*1000+y*100+v*10+z;
if fig=5 then begin bx:=v; by:=z; writeln('fig 5! ',bx,' ',by,' bx:=v; by:=z;'); end;
if fig=15 then begin jx:=v; jy:=z; writeln('fig15! ',jx,' ',jy,' jx:=v; jy:=z;'); end;

a[v,z]:=a[x,y]; a[x,y]:=0;
if bool or boor then a[v,z+ko3]:=0; //kirtimui prasilenkiant

if RR=1 then R1:=RR;
end;


if mov=1 then writeln('juodieji laimejo') else writeln('baltieji laimejo');
readln;

end.

Modulių mokymąsis

Po rugsėjo-spalio kryžiukų-nuliukų bei kėlinių "laisvalaikio" (t.y. pats sau) programų, kurį laiką nieko neprograminau. Tačiau iki semestro pabaigos pasimokėme funkcijas, procedūras, rodykles (dar nepripratau prie jų), sąrašus (dar neįsiliejo į kraują ir nenaudoju), modulius (primityvi tema).

Modulis tai praktiškai yra atskirai kompiliuojamas failas su įvairiomis procedūromis ir funkcijomis, na kaip biblioteka, į kurią gali kreiptis Pagrindinė programa.
Pateiksiu pavyzdį Pagrindinės programos, ji vadinsis "start", ir kreipsis į modulio (pavadinimas "modu2") funkcijas ir procedūras, o Pagrindinės progr. pradžioje turi būti sakinys "uses modu2" (naudoti modulį "modu2").

Šį modulį pasirašiau per porą dienų, ruošdamasis Diskrečiųjų struktūrų egzaminui.
Diskrečiųjų struktūrų (daug aritmetikos su pirminiais skaičiais ir pnš.) namų darbuose būdavo užduočių, kaip surasti DBD ar MBK iš kelių skaičių, ir suradus juos, norėjosi pasitikrinti, ar tai padariau teisingai. Tas pats su Ferma algoritmu, ar Oilerio funkcija... Tad kiekvienam atvejui pasirašiau funkcijų ar procedūrų, be to kai kada vienos funkcijos(procedūros) kreipiasi į kitas...

Norint pasitikrinti namų darbų rezultatus,
vienas iš būdų buvo paimti skaičiuotuvą ir per ~5 minutes susitikrinti visus atsakymus.
Antras variantas buvo parašyti šitą modulį, per porą vakarų. Man prie širdies buvo antras variantas.

Taigi, "start":

program start;
uses crt, modu2;
var x,z:integer; y,l:longint;

begin
clrscr;

syst;
sistema;
DBD(x);
writeln(x);
MBK;
writeln('iveskite dar sk');
readln(y);
Ferma(y);
writeln(pseudosaknis(y));
writeln('fi: ',fi(y));
writeln(dalikliuSk(y));
dalikliai(y);
writeln;
kanoniuke(y);
readln;
end.

Ir "start" programos įrankių modulis "modu2":

unit modu2;
interface

procedure sys;
function ord16(sk1:byte):byte;
function strlen(st1:string):byte;
procedure sys16(sk1:byte; st1:string; var sk2:longint);
procedure syst;
procedure sistema;
procedure Ferma(sk1:integer);
function DBD2(sk1,sk2:integer):integer;
function MBK2(sk1,sk2:integer):integer;
procedure DBD(var sk1:integer);
procedure MBK;
function pseudosaknis(sk1:longint):longint;
function dalikliuSk(sk1:longint):byte;
function fi(sk1:longint):longint;
procedure dalikliai(sk1:longint);
procedure kanonine(sk1:longint);
procedure kanoniuke(sk1:longint);
function fakt(sk1:integer):longint;
procedure Pfakt(sk1:integer; var sk2:longint);
function max(sk1,sk2,sk3:integer):integer;
procedure nelyg(tiek:byte);
procedure kreipt(k:byte);
implementation

procedure sys;
var a:integer; c:char;
begin
c:='f';
a:=ord(c);
writeln(a);
end;

function ord16(sk1:byte):byte;
var a,j:byte;
begin
if sk1<97 then
begin
for j:=48 to 57 do
begin
if sk1=j then a:=sk1-48;
end;
end
else
begin
j:=96;
repeat
begin
j:=j+1;
end;
until sk1=j;
a:=sk1-97+10;
end;
ord16:=a;
end;

function strlen(st1:string):byte;
var i:byte; b:boolean;
begin
i:=0;
b:=false;
repeat
if st1[i]=' ' then b:=true;
i:=i+1;
until (b=true) or (i=255);
strlen:=i-2;
end;

procedure sys16(sk1:byte; st1:string; var sk2:longint);
var a,b,c,i:byte; d,j:longint;
begin
j:=1;
d:=0;
a:=strlen(st1); // F
writeln('strlen: ',a); // pagalba
for i:=a downto 1 do
begin
b:=ord(st1[i]);
c:=ord16(b); // F
d:=d+c*j;
j:=j*sk1;
writeln(i,' i ',b,' b ',c,' c ',d,' d ',j,' j'); //pagalba
end;
sk2:=d;
end;

procedure syst;
var a,c:byte; f:longint; e:string;
begin
writeln('iveskite skaiciavimo sistemos skaiciu (nuo 4 iki 16)');
writeln('ir iveskite tos sk. sistemos skaiciu (1-ffff)(naudokite tik mazasias raides)');
readln(a);
readln(e);
writeln(a);
writeln(e);
writeln('i kokia skaiciavimo sistema konvertuoti ivesta skaiciu (nuo 4 iki 16)?');
readln(c);
sys16(a,e,f);
writeln('jusu ivestos sk.sistemos ir jos skaiciaus atitikmuo 10-aineje: ',f);
end;

procedure sistema;
var a,b,c,d,n,p:longint;
begin
writeln('iveskite skaiciavimo sistemos skaiciu (nuo 3 iki 10)');
writeln('ir iveskite tos sk. sistemos skaiciu (1-9999)');
readln(a,b);
writeln('i kokia skaiciavimo sistema konvertuoti ivesta skaiciu (nuo 3 iki 10)?');
readln(c);
d:=0;
n:=1;
repeat
begin
p:=b mod 10;
d:=d+p*n;
n:=n*a;
b:=b div 10;
end;
until b < a;
d:=d+b*n;

a:=0;
n:=1;
repeat
begin
p:=d mod c;
a:=a+p*n;
n:=n*10;
d:=d div c;
end;
until d < c;
a:=a+d*n;
writeln('atsakymas: ',a);
end;

procedure Ferma(sk1:integer);
var i,k,l,r,a:integer; m,j,c: real; b:boolean;
begin
i:=1;
r:=trunc(sqrt(sk1));
c:=sqrt((sk1-3)/2);
b:=false;
while i < trunc(c) do
begin
a:=(sqr(r+i));
i:=i+1;
j:=sqrt(a-sk1);
m:=j-round(j);
if abs(m) < 0.01 then
begin
k:=round(sqrt(a)-j);
l:=round(sqrt(a)+j);
i:=trunc(c)+1;
b:=true;
end;
end;
if b=true then writeln('nepirminis: ',sk1,'=',k,'*',l) else writeln('pirminis');
end;

function DBD2(sk1,sk2:integer):integer;
var i:integer;
begin
if sk1<>0 do
begin
i:=sk1 mod sk2;
sk1:=sk2;
sk2:=i;
end;
DBD2:=sk1;
end;

function MBK2(sk1,sk2:integer):integer;
var i:integer;
begin
i:=DBD2(sk1,sk2);
MBK2:=(sk1 div i)*sk2;
end;

procedure DBD(var sk1:integer);
var i,n:byte; a,b: integer;
begin
writeln('kiek skaiciu (nuo 2 iki 10) ivesite??');
readln(n);
n:=n-1;
writeln('dabar juos iveskite');
readln(b);
for i:=1 to n do
begin
readln(a);
b:=DBD2(b,a);
end;
sk1:=b;
end;

procedure MBK;
var i,n:byte; a,b: integer;
begin
writeln('kiek skaiciu (nuo 2 iki 10) ivesite??');
readln(n);
n:=n-1;
writeln('dabar juos iveskite');
readln(b);
for i:=1 to n do
begin
readln(a);
b:=MBK2(b,a);
end;
writeln('MBK: ',b);
end;

function pseudosaknis(sk1:longint):longint;
var j,i,sk:longint;
begin
j:=1;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;
pseudosaknis:=j;
//gauname j:= -[-sqrt(sk1)], pvz. jei 25 tai 5, o jei 26..36 tai 6. NETIESA.
end;

function dalikliuSk(sk1:longint):byte;
var d:byte; i,j,r,sk:longint;
begin
j:=1;
d:=0;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
d:=d+1;
end;
i:=i+1;
end;
if sk>j then d:=d+1;
dalikliuSk:=d;

end;

function fi(sk1:longint):longint;
var d,i,j,r,sk,f:longint;
begin
j:=1;
d:=sk1;
f:=sk1;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
f:=(f*(d-(d div i))) div d;
end;
while r=0 do
begin
sk:=sk div i;
r:=sk mod i;
end;
i:=i+1;
end;

d:=sk;
i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
end;
i:=i+1;
end;

if sk>j then f:=(f*(d-(d div sk))) div d;
fi:=f;

end;

procedure dalikliai(sk1:longint);
var i,j,r,sk:longint;
begin
j:=1;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
sk:=sk div i;
write(i,' ');
i:=i-1;
end;
i:=i+1;
end;
if sk>j then write(sk,' ');
end;


procedure kanonine(sk1:longint);
var d,n:byte; i,j,r,sk:longint;
begin
j:=1;
d:=0;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
write(' 1^0 ');
while i <= j do
begin
r:=sk mod i;
if r=0 then d:=d+1 else begin n:=d; d:=0 end;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
end;
if d=0 then write('*',i:4,'^',n,' ');
i:=i+1;
end;
if sk>j then write('*',sk:4,'^',1,' ');
end;

procedure kanoniuke(sk1:longint);
var d,n:byte; i,j,r,sk:longint;
begin
j:=1;
d:=0;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
write('1 ');
while i <= j do
begin
r:=sk mod i;
if r=0 then d:=d+1 else begin n:=d; d:=0 end;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
end;
if (d=0) and (n>0) then write('*',i,'^',n,' ');
i:=i+1;
end;
if sk>j then write('*',sk:4,'^',1,' ');
end;


function fakt(sk1:integer):longint;
var i:byte; c:longint;
begin
if sk1>12 then
begin
sk1:=12;
writeln('longint reiksme mazesne uz 13!, todel pateikiamas 12!');
end;
c:=1;
for i:=1 to sk1 do
begin
c:=c*i;
end;
fakt:=c;
end;

procedure Pfakt(sk1:integer; var sk2:longint);
var i:byte; c:longint;
begin
if sk1>12 then
begin
sk1:=12;
writeln('longint reiksme mazesne uz 13!, todel pateikiami');
writeln('tik faktorialai skaiciu nuo 1 iki 12.');
end;
c:=1;
for i:=1 to sk1 do
begin
c:=c*i;
writeln(i,'! = ',c);
end;
sk2:=c;
end;

function max(sk1,sk2,sk3:integer):integer;
begin
if sk2>sk1 then sk1:=sk2;
if sk3>sk1 then sk1:=sk3;
max:=sk1;
end;

procedure nelyg(tiek:byte);
var i:byte;
begin
for i:=1 to tiek do
writeln(i*2-1);
end;

procedure kreipt(k:byte);
begin
nelyg(k);
end;
initialization
writeln('modu2 startavo');
finalization
writeln('modu2 baige darba');
end.