← DL-Pascal collectioncov05.pas
DOWNLOAD ORIGINAL FILE
{ DL-Pascal Coverage Section 5: Arrays and Records }
{ Exercises single/multi-dimensional arrays, records, }
{ WITH statement, array of records, packed arrays, }
{ and common algorithmic patterns. }
{ Expected: runs without error, displays results. }
{$D-C-R-}
PROGRAM Section5;
TYPE
{ Simple array types }
TIntArray5 = ARRAY[1..5] OF Integer;
TIntArray10 = ARRAY[1..10] OF Integer;
TByteArray8 = ARRAY[0..7] OF Byte;
TCharArray26 = ARRAY[1..26] OF Char;
TBoolArray4 = ARRAY[1..4] OF Boolean;
TRealArray5 = ARRAY[1..5] OF Real;
{ 2D array }
TMatrix3x3 = ARRAY[1..3, 1..3] OF Integer;
TGrid = ARRAY[1..4, 1..4] OF Byte;
{ Record types }
TPoint = RECORD
x, y : Integer;
END;
TRect = RECORD
left, top, right, bottom : Integer;
END;
TPerson = RECORD
name : STRING[20];
age : Byte;
score : Real;
END;
TComplex = RECORD
re, im : Real;
END;
{ Array of records }
TPersonArray = ARRAY[1..5] OF TPerson;
{ Nested record }
TCircle = RECORD
center : TPoint;
radius : Integer;
END;
VAR
i, j, k : Integer;
r : Real;
b : Boolean;
ia5 : TIntArray5;
ia10 : TIntArray10;
ba8 : TByteArray8;
ca26 : TCharArray26;
ra5 : TRealArray5;
mat : TMatrix3x3;
grid : TGrid;
pt, pt2 : TPoint;
rc : TRect;
person : TPerson;
people : TPersonArray;
circle : TCircle;
cplx : TComplex;
sum : LongInt;
log : Text;
PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
IF passed THEN
WriteLn(log,'OK ', msg)
ELSE
WriteLn(log,'FAIL ', msg);
END;
{ ---- Basic array operations ---- }
PROCEDURE TestBasicArrays;
BEGIN
{ Assign and read }
ia5[1] := 10; ia5[2] := 20; ia5[3] := 30;
ia5[4] := 40; ia5[5] := 50;
Check('Array assign [1]', ia5[1] = 10);
Check('Array assign [3]', ia5[3] = 30);
Check('Array assign [5]', ia5[5] = 50);
{ Sum via loop }
sum := 0;
FOR i := 1 TO 5 DO sum := sum + ia5[i];
Check('Array sum', sum = 150);
{ Fill via loop }
FOR i := 1 TO 10 DO ia10[i] := i * i;
Check('Array fill sq[1]', ia10[1] = 1);
Check('Array fill sq[5]', ia10[5] = 25);
Check('Array fill sq[10]',ia10[10] = 100);
{ Byte array 0-based }
FOR i := 0 TO 7 DO ba8[i] := i * 2;
Check('Byte arr [0]', ba8[0] = 0);
Check('Byte arr [7]', ba8[7] = 14);
{ Real array }
FOR i := 1 TO 5 DO ra5[i] := i * 1.5;
Check('Real arr [1]', ra5[1] = 1.5);
Check('Real arr [5]', ra5[5] = 7.5);
{ Char array }
FOR i := 1 TO 26 DO ca26[i] := Chr(Ord('A') + i - 1);
Check('Char arr [1]', ca26[1] = 'A');
Check('Char arr [26]', ca26[26] = 'Z');
END;
{ ---- Array algorithms ---- }
PROCEDURE TestArrayAlgorithms;
VAR tmp, minVal, maxVal, minIdx : Integer;
BEGIN
{ Bubble sort }
ia5[1] := 3; ia5[2] := 1; ia5[3] := 4;
ia5[4] := 1; ia5[5] := 5;
FOR i := 1 TO 4 DO
FOR j := 1 TO 5-i DO
IF ia5[j] > ia5[j+1] THEN BEGIN
tmp := ia5[j]; ia5[j] := ia5[j+1]; ia5[j+1] := tmp;
END;
Check('Sort [1]=1', ia5[1] = 1);
Check('Sort [2]=1', ia5[2] = 1);
Check('Sort [3]=3', ia5[3] = 3);
Check('Sort [4]=4', ia5[4] = 4);
Check('Sort [5]=5', ia5[5] = 5);
{ Find min/max }
FOR i := 1 TO 10 DO ia10[i] := i * 3 - 15; { -12,-9,-6,-3,0,3,6,9,12,15 }
minVal := ia10[1]; maxVal := ia10[1]; minIdx := 1;
FOR i := 2 TO 10 DO BEGIN
IF ia10[i] < minVal THEN BEGIN minVal := ia10[i]; minIdx := i; END;
IF ia10[i] > maxVal THEN maxVal := ia10[i];
END;
Check('Array min', minVal = -12);
Check('Array max', maxVal = 15);
Check('Array minIdx',minIdx = 1);
{ Linear search }
ia5[1]:=7; ia5[2]:=2; ia5[3]:=9; ia5[4]:=4; ia5[5]:=6;
k := 0;
FOR i := 1 TO 5 DO
IF ia5[i] = 9 THEN k := i;
Check('Linear search', k = 3);
{ Reverse array }
ia5[1]:=1; ia5[2]:=2; ia5[3]:=3; ia5[4]:=4; ia5[5]:=5;
i := 1; j := 5;
WHILE i < j DO BEGIN
tmp := ia5[i]; ia5[i] := ia5[j]; ia5[j] := tmp;
Inc(i); Dec(j);
END;
Check('Reverse [1]=5', ia5[1] = 5);
Check('Reverse [5]=1', ia5[5] = 1);
END;
{ ---- 2D arrays ---- }
PROCEDURE Test2DArrays;
VAR trace : Integer;
BEGIN
{ Fill matrix }
FOR i := 1 TO 3 DO
FOR j := 1 TO 3 DO
mat[i,j] := (i-1)*3 + j; { 1..9 }
Check('Mat [1,1]=1', mat[1,1] = 1);
Check('Mat [2,3]=6', mat[2,3] = 6);
Check('Mat [3,3]=9', mat[3,3] = 9);
{ Diagonal trace }
trace := 0;
FOR i := 1 TO 3 DO trace := trace + mat[i,i];
Check('Mat trace', trace = 15); { 1+5+9 }
{ Row sum }
sum := 0;
FOR j := 1 TO 3 DO sum := sum + mat[2,j];
Check('Mat row 2 sum',sum = 15); { 4+5+6 }
{ Identity matrix check }
FOR i := 1 TO 3 DO
FOR j := 1 TO 3 DO
IF i = j THEN mat[i,j] := 1
ELSE mat[i,j] := 0;
b := True;
FOR i := 1 TO 3 DO
FOR j := 1 TO 3 DO
IF i = j THEN BEGIN IF mat[i,j] <> 1 THEN b := False; END
ELSE BEGIN IF mat[i,j] <> 0 THEN b := False; END;
Check('Identity mat', b);
{ Grid byte array }
FOR i := 1 TO 4 DO
FOR j := 1 TO 4 DO
grid[i,j] := (i + j) MOD 2; { checkerboard }
Check('Grid [1,1]=0', grid[1,1] = 0);
Check('Grid [1,2]=1', grid[1,2] = 1);
Check('Grid [2,1]=1', grid[2,1] = 1);
Check('Grid [2,2]=0', grid[2,2] = 0);
END;
{ ---- Records ---- }
PROCEDURE TestRecords;
BEGIN
{ TPoint }
pt.x := 3; pt.y := 4;
Check('Rec field x', pt.x = 3);
Check('Rec field y', pt.y = 4);
{ Record copy }
pt2 := pt;
Check('Rec copy x', pt2.x = 3);
pt2.x := 99;
Check('Rec indep', pt.x = 3); { original unchanged }
{ TRect }
rc.left := 0; rc.top := 0;
rc.right := 100; rc.bottom := 50;
Check('Rect width', (rc.right - rc.left) = 100);
Check('Rect height', (rc.bottom - rc.top) = 50);
Check('Rect area', (rc.right-rc.left) * (rc.bottom-rc.top) = 5000);
{ TPerson }
person.name := 'Alice';
person.age := 30;
person.score := 95.5;
Check('Person name', person.name = 'Alice');
Check('Person age', person.age = 30);
Check('Person score', person.score = 95.5);
END;
{ ---- WITH statement ---- }
PROCEDURE TestWith;
BEGIN
{ WITH TPoint }
WITH pt DO BEGIN
x := 10;
y := 20;
END;
Check('WITH point x', pt.x = 10);
Check('WITH point y', pt.y = 20);
{ WITH TRect }
WITH rc DO BEGIN
left := 5;
top := 10;
right := 105;
bottom := 60;
END;
Check('WITH rect', (rc.right - rc.left) = 100);
{ WITH TPerson }
WITH person DO BEGIN
name := 'Bob';
age := 25;
score := 87.5;
END;
Check('WITH person name', person.name = 'Bob');
Check('WITH person age', person.age = 25);
{ Nested WITH }
WITH circle DO BEGIN
WITH center DO BEGIN
x := 50;
y := 50;
END;
radius := 25;
END;
Check('WITH nested x', circle.center.x = 50);
Check('WITH nested r', circle.radius = 25);
END;
{ ---- Array of records ---- }
PROCEDURE TestArrayOfRecords;
VAR bestIdx : Integer;
bestScore : Real;
BEGIN
{ Fill array of people }
WITH people[1] DO BEGIN name:='Alice'; age:=30; score:=95.5; END;
WITH people[2] DO BEGIN name:='Bob'; age:=25; score:=87.0; END;
WITH people[3] DO BEGIN name:='Carol'; age:=35; score:=92.0; END;
WITH people[4] DO BEGIN name:='Dave'; age:=28; score:=78.5; END;
WITH people[5] DO BEGIN name:='Eve'; age:=22; score:=99.0; END;
Check('ArrRec [1] name', people[1].name = 'Alice');
Check('ArrRec [5] score', people[5].score = 99.0);
{ Find best score }
bestIdx := 1; bestScore := people[1].score;
FOR i := 2 TO 5 DO
IF people[i].score > bestScore THEN BEGIN
bestScore := people[i].score;
bestIdx := i;
END;
Check('Best score', bestScore = 99.0);
Check('Best idx', bestIdx = 5);
Check('Best name', people[bestIdx].name = 'Eve');
{ Average age }
sum := 0;
FOR i := 1 TO 5 DO sum := sum + people[i].age;
Check('Avg age sum', sum = 140); { 30+25+35+28+22 }
END;
{ ---- Nested records ---- }
PROCEDURE TestNestedRecords;
VAR dist : Real;
BEGIN
{ TCircle contains TPoint }
circle.center.x := 0;
circle.center.y := 0;
circle.radius := 5;
Check('Nested rec x', circle.center.x = 0);
Check('Nested rec r', circle.radius = 5);
{ Distance between two points }
pt.x := 3; pt.y := 4;
pt2.x := 0; pt2.y := 0;
dist := Sqrt(Sqr(pt.x - pt2.x) + Sqr(pt.y - pt2.y));
Check('Point dist', (dist > 4.99) AND (dist < 5.01));
{ Complex number operations }
cplx.re := 3.0; cplx.im := 4.0;
r := Sqrt(cplx.re * cplx.re + cplx.im * cplx.im);
Check('Complex mag', (r > 4.99) AND (r < 5.01));
END;
{ ---- Array as parameter ---- }
PROCEDURE SumArray(VAR a : TIntArray10; n : Integer; VAR total : LongInt);
VAR idx : Integer;
BEGIN
total := 0;
FOR idx := 1 TO n DO total := total + a[idx];
END;
PROCEDURE FillAscending(VAR a : TIntArray10; n : Integer);
VAR idx : Integer;
BEGIN
FOR idx := 1 TO n DO a[idx] := idx;
END;
PROCEDURE TestArrayParams;
BEGIN
FillAscending(ia10, 10);
SumArray(ia10, 10, sum);
Check('Array param sum', sum = 55);
FillAscending(ia10, 5);
SumArray(ia10, 5, sum);
Check('Array param 5', sum = 15);
END;
{ ---- Main ---- }
BEGIN
Assign(log, '0:cov05.log');
Rewrite(log);
WriteLn(log,'=== Section 5: Arrays and Records ===');
WriteLn(log);
WriteLn(log,'-- Basic Arrays --');
TestBasicArrays;
WriteLn(log);
WriteLn(log,'-- Array Algorithms --');
TestArrayAlgorithms;
WriteLn(log);
WriteLn(log,'-- 2D Arrays --');
Test2DArrays;
WriteLn(log);
WriteLn(log,'-- Records --');
TestRecords;
WriteLn(log);
WriteLn(log,'-- WITH --');
TestWith;
WriteLn(log);
WriteLn(log,'-- Array of Records --');
TestArrayOfRecords;
WriteLn(log);
WriteLn(log,'-- Nested Records --');
TestNestedRecords;
WriteLn(log);
WriteLn(log,'-- Array Params --');
TestArrayParams;
WriteLn(log);
WriteLn(log,'=== Section 5 complete ===');
Close(log);
END.