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.