Hier vindt u de oplossingen van de oefeningen.
Natuurlijk geldt hier dat u uw uiterste best heeft gedaan alvorens de oplossingen te raadplegen.
Verder geldt dat de oplossing die u hier vindt natuurlijk niet dezelfde hoeft te zijn als uw oplossing.
Oefening 8.1
Oefening 8.2
Oefening 9.1
Oefening 9.2
Oefening 10.1
Oefening 10.2
Oefening 11.1
Oefening 11.2
Oefening 11.3
Oefening 11.4
Oefening 11.5
Oefening 11.6
Oefening 12.1
Oefening 12.2
Oefening 12.3
Oefening 13.1
Oefening 14.1
type s60 = string[60];
var regel: s60;
procedure horlijn;
{maak een horizontale lijn van 70 x-en}
var x: integer;
begin
for x := 1 to 70 do
write(‘x’);
writeln;
end;
procedure kader(r: s60);
{maak een kader van x-en en zet de regel daarin gecentreerd neer}
var l: integer;
begin
horlijn;
l := length(r);
write(‘x’);
gotoxy(35 – (l div 2), wherey); {begin regel op pos 35 – helft lengte regel}
write(r);
gotoxy(70, wherey);
writeln(‘x’);
horlijn;
end;
begin
write(‘Geef een regeltje tekst: ‘);
readln(regel);
writeln;
writeln;
kader(regel);
end.
type s60 = string[60];
var regel: s60;
procedure horlijn(k: char);
{maak een horizontale lijn van 70 x-en}
var x: integer;
begin
for x := 1 to 70 do
write(k);
writeln;
end;
procedure kader(r: s60; k: char);
{maak een kader van x-en en zet de regel daarin gecentreerd neer}
var l: integer;
begin
horlijn(k);
l := length(regel);
write(k);
gotoxy(35 – (l div 2), wherey); {begin regel op pos 35 – helft lengte regel}
write(r);
gotoxy(70, wherey);
writeln(k);
horlijn(k);
end;
begin
write(‘Geef een regeltje tekst: ‘);
readln(regel);
writeln;
writeln;
kader(regel,’#’);
end.
function FibIter(n: Byte): Integer;
var t, t1, t2, s: integer;
begin
if (n = 1) or (n = 2) then
FibIter := 1
else
begin
t1 := 1;
t2 := 1;
for t := 3 to n do
begin
ts := t1 + t2;
t1 := t2;
t2 := ts;
end;
FibIter := ts;
end;
end;
begin
writeln(FibIter(12));
end.
type s80 = string[80];
function UCase(s: s80): s80;
var x: byte;
begin
for x := 1 to length(s) do
if s[x] in [‘a’..’z’] then
s[x] := chr(ord(s[x]) – 32);
UCase := s;
end;
begin
writeln(UCase(’turbo pascal’));
end.
type s80 = string[80];
var
tb: text;
regel,bestnaam: s80;
aantal: integer;
function Bestaat(bn: s80): boolean;
var b: file;
begin
assign(b,bn);
{$I-}
reset(b);
{$I+}
if IOResult = 0 then
begin
Bestaat := true;
close(b);
end
else
Bestaat := false;
end;
begin
write(‘Geef bestandsnaam: ‘);
readln(bestnaam);
if Bestaat(bestnaam) then
begin
assign(tb,bestnaam);
reset(tb);
while not eof(tb) do
begin
readln(tb,regel);
aantal := aantal + 1;
end;
close(tb);
writeln(bestnaam,’ heeft ‘,aantal,’ regels.’);
end
else
writeln(bestnaam,’ niet gevonden.’);
end.
type s80 = string[80];
var
tbo,tbn: text;
regel,bestnaam,extensie: s80;
aantal: integer;
function UCase(s: S80): s80;
var x: byte;
begin
for x := 1 to length(s) do
if s[x] in [‘a’..’z’] then
s[x] := chr(ord(s[x])-32);
UCase := s;
end;
function Bestaat(bn: s80): boolean;
var b: file;
begin
assign(b,bn);
{$I-}
reset(b);
{$I+}
if IOResult = 0 then
begin
Bestaat := true;
close(b);
end
else
Bestaat := false;
end;
begin
write(‘Geef naam van Pascal-bestand: ‘);
readln(bestnaam);
if UCase(copy(bestnaam,length(bestnaam)-3,4)) = ‘.PAS’ then
begin
if Bestaat(bestnaam) then
begin
aantal := 1;
assign(tbo,bestnaam);
reset(tbo);
assign(tbn,copy(bestnaam,1,length(bestnaam)-3)+’NUM’);
rewrite(tbn);
while not eof(tbo) do
begin
readln(tbo,regel);
writeln(tbn,aantal:5,’: ‘,regel); {met aantal:5 worden 5 posities voor aantal gereserveerd en wordt aantal meteen rechts uitgelijnd.}
aantal := aantal + 1;
end;
close(tbo);
close(tbn);
writeln(‘klaar.’);
end
else
writeln(bestnaam,’ niet gevonden.’);
end
else
writeln(bestnaam,’ is geen Pascal-bestand.’);
end.
function FacIter(n: byte): integer;
var
t: byte;
p: integer;
begin
p := 1;
for t := 1 to n do
p := p * t;
FacIter := p;
end;
Naar boven
Var
i: Integer;
Function FibRec(n: Byte): Integer;
Begin
If (n=1) or (n=2) Then
FibRec := 1
Else
FibRec := FibRec(n-1) + FibRec(n-2);
End;
Function FibIter(n: Byte): Integer;
var t,t1,t2,ts: Integer;
Begin
If (n=1) Or (n=2) Then
FibIter := 1
Else
Begin
t1 := 1;
t2 := 1;
For t := 3 to n Do
Begin
ts := t1 + t2;
t1 := t2;
t2 := ts;
End;
FibIter := ts;
End;
End;
Begin
Write(‘Geef n-e term (>0): ‘);
Readln(i);
Writeln(‘De ‘,i,’-e term is ‘,FibIter(i),’ [Iteratief].’);
Writeln(‘De ‘,i,’-e term is ‘,FibRec(i),’ [Recursief].’);
Writeln;
End.
var
As: Byte;
Aantal: Integer;
Procedure Hanoi(a: Byte;s1,s2,s3: Char);
Begin
Aantal := Aantal + 1;
If a=1 Then
Write(s1,’->’,s3,’ ‘)
Else
Begin
Hanoi(a-1,s1,s3,s2);
Write(s1,’->’,s3,’ ‘);
Hanoi(a-1,s2,s1,s3);
End
End;
Begin
Write(‘Geef aantal stenen: ‘);
Readln(As);
Aantal := 0;
Hanoi(As,’A’,’B’,’C’);
Writeln;
Writeln;
Writeln(‘Minimaal aantal zetten: ‘,Aantal);
Writeln;
End.
function Keerom(s: s80): s80;
begin
if length(s) = 1 then
Keerom := s
else
Keerom := copy(s,length(s),1) + Keerom(copy(s,1,length(s)-1))
end;
Naar boven
function Keer(a,b: integer): integer;
begin
if (a=0) or (b=0) then
Keer := 0
else
if a=1 then
Keer := b
else
Keer := b + Keer(a-1,b)
end;
Naar boven
Deze functie rekent a*b uit, waarbij a en b positieve gehele getallen moeten zijn.
Deze recursieve methode is een (idiote) implementatie van Ethiopisch vermenigvuldigen:
Het verhaal gaat dat er op een markt in Ethiopië er op enig moment onenigheid ontstond tussen een koper en verkoper van koeien over de totale prijs.
De koper had 19 koeien tegen 11 geldstukken per koe gekocht en beide konden niet verder dan 100 rekenen.
Om te voorkomen dat beide mannen met elkaar op de vuist zouden gaan werd vlug de dorps-wijze erbij gehaald.
De bracht een zak vol kleine steentjes mee. Op de plaats aangekomen maakte hij twee rijen kuiltjes boven elkaar in het zand.
In het eerste kuiltje van de bovenste rij deed hij 19 stenen. In het kuiltje daaronder 11.
In het kuiltje daarnaast (bovenste rij) deed hij de helft (evt. naar beneden afgerond) van het aantal steentjes van het kuiltje links, dus 9.
In het kuiltje daaronder deed hij het dubbele van het kuiltje daar links van, dus 22.
Hij ging daarmee door totdat in het meest rechtse kuiltje van de bovenste rij nog maar 1 steentje lag.
In dit voorbeeld waren dus de volgende twee rijen steentjes ontstaan:
19 9 4 2 1
11 22 44 88 176
Nu ging hij alle steentjes verzamelen uit de onderste rij kuiltjes waarvan het aantal steentje in de corresponderende kuiltjes daarboven oneven was.
Dus de steentjes uit het eerste, tweede en vijfde kuiltje: resp. 11, 22 en 176.
Tot slot telde hij de verzamelde steentjes en zij tegen de koper dat hij 209 (=11+22+176) geldstukken moest betalen.
const
Max = 10;
type
TMatrix = array[1..Max,1..Max] of real;
var
MatrixA, MatrixB, MatrixP: TMatrix;
rijen, kolommen: byte;
procedure VoerMatrixIn(r,k: byte;var m: TMatrix);
var rij,kolom: byte;
begin
for rij := 1 to r do
for kolom := 1 to k do
begin
write(‘Geef element[‘,rij,’,’,kolom,’]: ‘);
readln(m[rij,kolom]);
end;
end;
procedure ToonMatrix(d: byte;m: TMatrix);
var rij,kolom: byte;
begin
for rij := 1 to d do
begin
for kolom := 1 to d do
write(m[rij,kolom]:8:2);
writeln;
end;
end;
procedure VermMatrices(r,k: byte;m1,m2: TMatrix;var m3: TMatrix);
var
d,s,z,rij,kolom: byte;
p: real;
begin
if r > k then
begin
d := r;
s := k;
end
else
begin
d := k;
s := r;
end;
for rij := 1 to d do
for kolom := 1 to d do
begin
p := 0;
for z := 1 to s do
p := p + m1[rij,z] * m2[z,kolom];
m3[rij,kolom] := p;
end;
end;
begin
write(‘Geef aantal kolommen van 1e matrix: ‘);
readln(kolommen);
write(‘Geef aantal rijen van 1e matrix: ‘);
readln(rijen);
writeln(‘Eerste matrix inlezen:’);
writeln;
VoerMatrixIn(rijen,kolommen,MatrixA);
writeln;
writeln(‘Tweede matrix inlezen:’);
writeln;
VoerMatrixIn(kolommen,rijen,MatrixB);
writeln;
VermMatrices(rijen,kolommen,MatrixA,MatrixB,MatrixP);
writeln(‘Resultaat vermenigvuldiging:’);
writeln;
if kolommen > rijen then
rijen := kolommen;
ToonMatrix(rijen,MatrixP);
end.
type
s80 = string[80];
TDatum =
record
jaar, maand, dag: integer;
end;
var
Datum: TDatum;
sDatum: s80;
function CorrecteDatum(j,m,d: integer): Boolean;
{De volgende constructie heet een const-array. Kijk goed naar het handige gebruik hiervan!}
const
ad: array[1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31);
var
schrikkel, ok: Boolean;
begin
ok := (m>=1) and (m<=12);
if ok then
begin
{Een jaar is schrikkel als het deelbaar is door 4 maar niet door 100 tenzij door 400}
schrikkel := (j mod 4 = 0) and ((j mod 100 <> 0) or (j mod 400 = 0));
if schrikkel and (m=2) then
ok := (d <= 29)
else
ok := (d <= ad[m]);
end;
CorrecteDatum := ok;
end;
procedure StringNaarDatum(s: s80; var d: TDatum);
var
p, as, c: integer;
ok: boolean;
dt: TDatum;
begin
p := 1;
ok := true;
if s[p] in [‘0’..’9′] then
p := p + 1
else
ok := false;
while ok and (p <= length(s)) do
begin
if ok and ((s[p] in [‘0’..’9′]) or (s[p] in [‘-‘,’/’])) then
p := p + 1
else
ok := false;
if s[p] in [‘-‘,’/’] then
as := as + 1;
end;
with dt do
if ok then
begin
p := Pos(‘-‘,s);
if p = 0 then
p := Pos(‘/’,s);
val(copy(s,1,p-1),dag,c);
s := copy(s,p+1,length(s));
p := Pos(‘-‘,s);
if p = 0 then
p := Pos(‘/’,s);
val(copy(s,1,p-1),maand,c);
s := copy(s,p+1,length(s));
if length(s) = 1 then
s := ‘200’ + s;
if length(s) = 2 then
s := ’20’ + s;
val(s,jaar,c);
if not CorrecteDatum(jaar,maand,dag) then
begin
jaar := 0;
maand := 0;
dag := 0;
end;
end
else
begin
jaar := 0;
maand := 0;
dag := 0;
end;
d := dt;
end;
function Jaar(d: TDatum): Integer;
begin
Jaar := d.jaar;
end;
function Maand(d: TDatum): Integer;
begin
Maand := d.maand;
end;
function Dag(d: TDatum): Integer;
begin
Dag := d.dag;
end;
begin
write(‘Voer een datum in (dd-mm-[jj]jj): ‘);
readln(sDatum);
StringNaarDatum(sDatum,Datum);
writeln;
writeln(‘Uw datum: ‘,Dag(Datum),’-‘,Maand(Datum),’-‘,Jaar(Datum));
end.
const bestnaam = ‘BREUKEN.TXT’;
type
s80 = string[80];
TBreuk =
record
teller, noemer: integer;
end;
TBreuken = array[1..3] of TBreuk;
var
getal1, getal2: integer;
breuk: TBreuken;
naarschijf, stoppen: Boolean;
procedure DrukToets;
var c: Char;
begin
write(‘Druk op een toets…’);
Read(KBD,c);
writeln;
end;
function JaNee(vraag: S80): Boolean;
var c: Char;
begin
write(vraag,’ [J,n]’);
repeat
Read(KBD,c)
until c In [‘j’,’J’,’n’,’N’,#13];
gotoxy(wherex-5,wherey);
clreol;
if c=#13
then writeln(‘J’)
else writeln(c);
JaNee := (c In [‘j’,’J’,#13]);
end;
function Bestaat(bn: s80): boolean;
var f: File;
begin
assign(f,bn);
{$I-}
reset(f);
{$I+}
if IOResult = 0 then
begin
close(f);
Bestaat := true;
end
else
Bestaat := false;
end;
function Ggd(a,b: integer): integer;
var x,y,d,r: integer;
begin
if a > b then
begin
x := a;
y := b;
end
else
begin
x := b;
y := a;
end;
d := x div y;
r := x mod y;
if r = 0 then
Ggd := y
else
Ggd:= Ggd(y,r);
end;
function Kgv(a,b: integer): integer;
{Gebruiken we verder niet, maar hij is zo elegant}
begin
Kgv := (a * b) div Ggd(a,b);
end;
procedure LeesBreukIn(var b: TBreuk);
var t,n: integer;
begin
write(‘Geef teller: ‘);
readln(t);
repeat
write(‘Geef noemer: ‘);
readln(n);
until n <> 0;
if ((t<0) and (n<0)) or (n<0) then
begin
t := -t;
n := -n
end;
b.teller := t;
b.noemer := n;
end;
function IntToStr(i: integer): s80;
var
r,d: integer;
s: s80;
n: boolean;
begin
if i <0 then
begin
i := -i;
n := true;
end
else
n := false;
r := i mod 10;
d := i div 10;
s := chr(r+48);
while d > 10 do
begin
r := d mod 10;
d := d div 10;
s := chr(r+48) + s;
end;
if d > 0 then
s := chr(d+48) + s;
if n then
s := ‘-‘ + s;
IntToStr := s;
end;
function SBreuk(b: TBreuk;HelenEruit: boolean): s80;
var s: s80;
begin
if HelenEruit then
begin
if b.teller >= b.noemer then
begin
s := IntToStr(b.teller div b.noemer);
if b.teller mod b.noemer <> 0 then
s := s + ‘ ‘ + IntToStr(b.teller mod b.noemer) + ‘/’ + IntToStr(b.noemer);
end
else
s := IntToStr(b.teller) + ‘/’ + IntToStr(b.noemer);
end
else
s := IntToStr(b.teller) + ‘/’ + IntToStr(b.noemer);
SBreuk := s;
end;
procedure Vereenvoudig(var b: TBreuk);
var g: integer;
begin
g := Ggd(abs(b.teller),abs(b.noemer));
if b.teller < 0 then
b.teller := -1 * (abs(b.teller) div g)
else
b.teller := b.teller div g;
b.noemer := b.noemer div g;
end;
procedure Telop(b1,b2: TBreuk;var br :TBreuk);
begin
if b1.noemer <> b2.noemer then
begin
b1.teller := b1.teller * b2.noemer;
b2.teller := b2.teller * b1.noemer;
b1.noemer := b1.noemer * b2.noemer;
b2.noemer := b1.noemer;
end;
br.teller := b1.teller + b2.teller;
br.noemer := b1.noemer;
Vereenvoudig(br);
end;
procedure TrekAf(b1,b2: TBreuk;var br: TBreuk);
begin
if b1.noemer <> b2.noemer then
begin
b1.teller := b1.teller * b2.noemer;
b2.teller := b2.teller * b1.noemer;
b1.noemer := b1.noemer * b2.noemer;
b2.noemer := b1.noemer;
end;
br.teller := b1.teller – b2.teller;
br.noemer := b1.noemer;
Vereenvoudig(br);
end;
procedure Maal(b1,b2: TBreuk;var br: TBreuk);
begin
br.teller := b1.teller * b2.teller;
br.noemer := b1.noemer * b2.noemer;
Vereenvoudig(br);
end;
procedure Deel(b1,b2: TBreuk;var br: TBreuk);
begin
if b2.teller = 0 then
begin
writeln(‘Delen door nul kan niet!’);
halt(1);
end
else
begin
br.teller := b1.teller * b2.noemer;
br.noemer := b1.noemer * b2.teller;
Vereenvoudig(br);
end;
end;
procedure MaakDecimaal(br: TBreuk;ad: integer);
var
g,x: integer;
tf: text;
begin
if naarschijf then
begin
assign(tf,bestnaam);
append(tf)
end;
write(SBreuk(br,false),’ = ‘,br.teller div br.noemer,’, ‘);
if naarschijf then
write(tf,SBreuk(br,false),’ = ‘,br.teller div br.noemer,’, ‘);
g := br.teller mod br.noemer;
for x := 1 to ad do
begin
g := g * 10;
write(g div br.noemer);
if naarschijf then
write(tf,g div br.noemer);
g := g mod br.noemer;
if x mod 5 = 0 then
begin
write(‘ ‘);
if naarschijf then
write(tf,’ ‘);
end;
end;
if naarschijf then
begin
writeln(tf);
close(tf);
end;
end;
procedure MenuOptie(mo: byte);
var
aantaldecimalen: integer;
tf: Text;
procedure LBI;
begin
writeln(‘1e breuk inlezen:’);
LeesBreukIn(breuk[1]);
writeln(‘2e breuk inlezen:’);
LeesBreukIn(breuk[2]);
end;
begin
if naarschijf then
begin
assign(tf,bestnaam);
append(tf);
end;
case mo of
1: begin { + }
LBI;
TelOp(breuk[1],breuk[2],breuk[3]);
writeln(SBreuk(breuk[1],true),’ + ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
if naarschijf then
writeln(tf,SBreuk(breuk[1],true),’ + ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
end;
2: begin { – }
LBI;
TrekAf(breuk[1],breuk[2],breuk[3]);
writeln(SBreuk(breuk[1],true),’ – ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
if naarschijf then
writeln(tf,SBreuk(breuk[1],true),’ – ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
end;
3: begin { * }
LBI;
Maal(breuk[1],breuk[2],breuk[3]);
writeln(SBreuk(breuk[1],true),’ * ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
if naarschijf then
writeln(tf,SBreuk(breuk[1],true),’ * ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
end;
4: begin { / }
LBI;
Deel(breuk[1],breuk[2],breuk[3]);
writeln(SBreuk(breuk[1],true),’ / ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
if naarschijf then
writeln(tf,SBreuk(breuk[1],true),’ / ‘,
SBreuk(breuk[2],true),’ = ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
end;
5: begin { vereenvoudigen }
writeln(‘breuk inlezen:’);
LeesBreukIn(breuk[1]);
breuk[3] := breuk[1];
Vereenvoudig(breuk[3]);
writeln(SBreuk(breuk[1],false),’ is vereenvoudigd ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
if naarschijf then
writeln(tf,SBreuk(breuk[1],false),’ is vereenvoudigd ‘,
SBreuk(breuk[3],false),’ ( = ‘,
SBreuk(breuk[3],true),’ )’);
end;
6: begin { decimaal maken }
writeln(‘breuk inlezen’);
LeesBreukIn(breuk[1]);
write(‘Geef aantal decimalen: ‘);
readln(aantaldecimalen);
MaakDecimaal(breuk[1],aantaldecimalen);
end;
7: begin { Toggle naarschijf }
naarschijf := not naarschijf;
if naarschijf then
begin
assign(tf,bestnaam);
if not Bestaat(bestnaam) then
begin
rewrite(tf);
close(tf);
end;
end
end;
end;
if naarschijf then
close(tf);
writeln;
DrukToets;
end;
procedure ToonMenu;
var c: char;
begin
clrscr; {maakt het scherm schoon}
writeln(‘BREUKEN MENU’);
writeln;
writeln(‘1 – Optellen’);
writeln(‘2 – Aftrekken’);
writeln(‘3 – Vermenigvuldigen’);
writeln(‘4 – Delen’);
writeln(‘5 – Vereenvoudigen’);
writeln(‘6 – Decimaal maken’);
write(‘7 – Resultaten naar schijf: ‘);
if naarschijf then
writeln(‘AAN’)
else
writeln(‘UIT’);
writeln;
writeln(‘0 – Stoppen’);
writeln;
writeln;
write(‘Maak keuze (0-7): ‘);
repeat
read(kbd,c)
until c in [‘0’..’7′];
writeln(c);
writeln;
if c = ‘0’ then
begin
writeln;
if JaNee(‘Wilt u echt stoppen?’) then
stoppen := true
else
ToonMenu;
end
else MenuOptie(ord(c)-48);
end;
begin
stoppen := false;
naarschijf := false;
repeat
ToonMenu
until stoppen;
end.
const
MaxNamen = 3000;
type
S20 = String[20];
var
Namen: Array[1..MaxNamen] of S20;
procedure Schrijf2;
var
i: Integer;
begin
i := 1;
while Namen[i] <> ” do
begin
write(Namen[i]:40);
i := i + 1;
end;
end;
procedure Verwijder2(VNaam: S20);
var
i,v: Integer;
bepaald: Boolean;
begin
i := 1;
bepaald := false;
while not bepaald and (Namen[i] <> ”) do
begin
if Namen[i] = VNaam then
begin
bepaald := true
end;
i := i + 1;
end;
if bepaald then
begin
while Namen[i] <> ” do
begin
Namen[i-1] := Namen[i];
i := i + 1;
end;
Namen[i-1] := ”;
end
end;
procedure Leeg2;
var
i: Integer;
begin
for i := 1 to MaxNamen do
Namen[i] := ”;
end;
procedure VoegToe2(NieuweNaam: S20);
var
i,j,k: Integer;
bepaald: Boolean;
begin
i := 1;
bepaald := false;
while not bepaald and (Namen[i] <> ”) do
begin
if NieuweNaam <= Namen[i] then
bepaald := true
else
i := i + 1;
end;
if bepaald then
begin
j := i;
while Namen[j] <> ” do
j := j + 1;
for k := j+1 downto i+1 do
Namen[k] := Namen[k-1];
Namen[i] := NieuweNaam;
end
else
Namen[i] := NieuweNaam;
end;
function Lengte2: Integer;
var
i: integer;
begin
i := 1;
while Namen[i] <> ” do
i := i + 1;
Lengte2 := i-1;
end;
procedure Lijst2(aantal: Integer);
var
i,j: Integer;
s: S20;
begin
Leeg2;
if aantal > MaxNamen then
aantal := MaxNamen;
for i := 1 to aantal do
begin
s := ”;
for j := 1 to 20 do
s := s + Chr(97+Random(26));
VoegToe2(s);
end;
Schrijf2;
end;
procedure Test;
begin
clrscr;
Lijst2(MaxNamen);
writeln(‘Lengte=’,Lengte2);
Verwijder2(Namen[1]);
writeln(‘Lengte=’,Lengte2);
Leeg2;
writeln(‘Lengte=’,Lengte2);
end;
begin
Test;
end.
type
pStapel = ^tStapel;
tStapel = record
waarde: integer;
vorige: dStapel;
end;
var
kop, staart: pStapel;
procedure Push(w: integer);
var
huidige: pStapel;
begin
new(huidige);
huidige^.waarde := w;
if staart = nil then
staart := huidige;
if kop = nil then
huidige^.vorige := nil
else
huidige^.vorige := kop;
kop := huidige;
end;
function Lengte: integer;
var
ref: pStapel;
a: integer;
begin
a := 0;
ref := kop;
while ref <> nil do
begin
a := a + 1;
ref := ref^.vorige;
end;
Lengte := a;
end;
function Pop: integer;
var
huidige: pStapel;
begin
huidige := kop;
if huidige <> nil then
begin
Pop := huidige^.waarde;
huidige := huidige^.vorige;
dispose(kop);
kop := huidige;
end
else
Pop := -MaxInt;
end;
function Fac(n: byte): integer;
var
m: byte;
p: integer;
begin
m := n;
while n > 0 do
begin
Push(n);
n := n – 1;
end;
p := 1;
While Lengte > 0 do
p := p * Pop;
Fac := p;
end;
begin
kop := nil;
staart := nil;
writeln(‘Fac(5)=’,Fac(5));
end.