{ -- FLORIDA HIGH SCHOOLS COMPUTING COMPETITION '83 }
{ -- PASCAL PROGRAM SOLUTIONS }
{1.1}
program One1T83;
{ -- This program will round a number to nearest whole number. }
var
Num: Real;
begin
Write ('Enter number: '); Readln (Num);
Writeln (Round(Num));
end.
{1.2}
program One2T83;
{ -- This program will display 5 numbers in descending order. }
var
I, J, X: Integer;
A: Array [1..5] of Integer;
begin
for I := 1 to 5 do begin
Write ('Enter number: '); Readln (A[I]);
end;
for I := 1 to 4 do
for J := I+1 to 5 do
if A[I] < A[J] then begin
X := A[I]; A[I] := A[J]; A[J] := X;
end;
for I := 1 to 5 do
Writeln (A[I]);
end.
{1.3}
program One3T83;
{ -- This program will print the factors of a given number. }
var
Num, I: Integer;
begin
Write ('Enter number: '); Readln (Num);
for I := 1 to Num do
if Num mod I = 0 then
Writeln (I);
end.
{1.4}
program One4T83;
{ -- This program will produce a birthday card w/name centered. }
var
I, J, L, Sp: Integer;
Name: String[10];
begin
Write ('Enter name: '); Readln (Name);
for I := 1 to 5 do begin
Writeln;
if I in [1, 5] then
for J := 1 to 12 do
Write ('*')
else if (I = 2) then
Write ('* HAPPY *')
else if (I = 3) then
Write ('* BIRTHDAY *')
else begin
Write ('*');
L := Length(Name);
Sp := (11-L) div 2;
Write (' ': Sp, Name, ' ': 10-L-Sp, '*');
end;
end;
end.
{1.6}
program One6T83;
{ -- This program will print a B for A, C for B, ... Z for A. }
var
Ch: Char;
begin
Write ('Enter Character: '); Readln (Ch);
if Ch < 'Z' then
Writeln (Char(Ord(Ch) + 1))
else { -- Z was entered }
Writeln ('A');
end.
{1.5}
program One5T83;
{ -- This program will print a ? in random locations. }
uses Crt;
var
I, X, Y: Byte;
begin
ClrScr; Randomize;
for I := 1 to 6 do begin
X := Random(80) + 1; Y := Random(24) + 1;
GotoXY (X, Y); Write ('?');
Delay (4000);
end;
end.
{1.7}
program One7T83;
{ -- This program will print 4 distinct rectangles in corners. }
uses Crt;
procedure Rectangle ({At} Row, Col: Integer);
{ -- This procedure will produce a 10 by 4 rectangle at X, Y }
var
I, J: Byte;
begin
for I := Row to Row+3 do
if (I = Row) or (I = Row+3) then begin
GotoXY (Col, I);
for J := 1 to 10 do
Write ('*');
end
else begin
GotoXY (Col, I); Write ('*');
GotoXY (Col+9, I); Write ('*');
end;
end;
begin
ClrScr;
Rectangle (1, 1);
Rectangle (1, 65);
Rectangle (19, 1);
Rectangle (19, 65);
end.
{1.8}
program One8T83;
{ -- This program will count the number of e's in a sentence. }
var
Sent: String[80];
I, E: Byte;
Ch: Char;
begin
Write ('Enter sentence: '); Readln (Sent);
E := 0;
for I := 1 to Length(Sent) do begin
Ch := UpCase( Sent[I] );
if Ch = 'E' then Inc(E);
end;
Writeln (E, ' E''s');
end.
{1.9}
program One9T83;
{ -- This program will calculate the average score for a person.}
const
Name: Array [1..3] of String[4] = ('JOHN', 'BILL', 'MARY');
Scores: Array [1..3,1..3] of Byte =
((20, 70, 32), (71, 40, 30), (80, 42, 73));
var
I, J, Total, Ind: Byte;
St: String[4];
begin
Write ('Enter name: '); Readln (St);
for I := 1 to 3 do
if St = Name[I] then Ind := I;
Total := 0;
for J := 1 to 3 do
Total := Total + Scores[Ind, J];
Writeln ('Average = ', Total / 3 :3:2);
end.
{1.10}
program One10T83;
{ -- This program will reverse the digits of a 4 digit number. }
var
I: Byte;
St: String[4];
begin
Write ('Enter number: '); Readln (St);
for I := 4 downto 1 do
Write (Copy(St, I, 1));
Writeln;
end.
{2.1}
program Two1T83;
{ -- This program will calculate the area of a regular hexagon. }
var
Perim, S: Real;
begin
Write ('Enter perimeter: '); Readln (Perim);
S := Perim / 6;
Writeln ( (Sqrt(3)*S/2 * S/2) * 6 :7:4);
end.
{2.2}
program Two2T83;
{ -- This program will convert a base 8 num to a base 2 num. }
var
I, Digit: Byte;
FirstDig: Byte;
Ch: Char;
Num: String[4];
St: String[12];
begin
Write ('Enter number: '); Readln (Num);
St := '';
for I := 1 to Length(Num) do begin
Ch := Num[I];
Digit := Ord(Ch) - Ord('0');
case Digit of
0: St := St + '000';
1: St := St + '001';
2: St := St + '010';
3: St := St + '011';
4: St := St + '100';
5: St := St + '101';
6: St := St + '110';
7: St := St + '111';
end;
end;
FirstDig := 1;
while Copy(St, FirstDig, 1) = '0' do
Inc(FirstDig);
Writeln (Copy(St, FirstDig, Length(St)-FirstDig+1));
end.
{2.3}
program Two3T83;
{ -- This program will add several items with tax (5%). }
var
Item, Tax, Total: Real;
begin
Total := 0;
Write ('Enter item: '); Readln (Item);
while Item <> -999 do begin
Total := Total + Item;
Write ('Enter item: '); Readln (Item);
end;
Writeln ('SUBTOTAL = $', Total: 5:2);
Tax := Total * 0.05;
Writeln ('TAX = $', Tax: 5:2);
Total := Total + Tax;
Writeln ('TOTAL = $', Total: 5:2);
end.
{2.4}
program Two4T83;
{ -- This program will divide the screen into 4 rectangles. }
uses Crt;
var
Ch: Char;
I, J: Integer;
begin
Write ('Enter character: '); Readln (Ch);
ClrScr;
for I := 1 to 24 do
if I <> 12 then
Writeln (' ': 39, Ch)
else
for J := 1 to 80 do
Write (Ch);
end.
{2.5}
program Two5T83;
{ -- This program will print the greatest and least in a set. }
var
Max, Min, Num: Real;
begin
Max := -900; Min := 900;
Write ('Enter number: '); Readln (Num);
while Num <> -999 do begin
if Num < Min then Min := Num
else if Num > Max then Max := Num;
Write ('Enter number: '); Readln (Num);
end;
Writeln ('GREATEST = ', Max :5:2);
Writeln ('LEAST = ', Min :5:2);
end.
{2.6}
program Two6T83;
{ -- This program will print the sum, mean, median. }
var
I, J: Byte;
Sum, X: Real;
A: Array [1..10] of Real;
begin
Sum := 0;
for I := 1 to 10 do begin
Write ('Enter number: '); Readln (A[I]);
Sum := Sum + A[I];
end;
{ -- Sort 10 numbers }
for I := 1 to 9 do
for J := I+1 to 10 do
if A[I] > A[J] then begin
X := A[I]; A[I] := A[J]; A[J] := X;
end;
Writeln ('SUM = ', Sum: 5:2);
Writeln ('MEAN = ', Sum / 10 :5:2);
Writeln ('MEDIAN = ', (A[5] + A[6])/2 :5:2);
end.
{2.7}
program Two7T83;
{ -- This program will reverse the words in a sentence. }
{ -- Assume 1 space between each word. }
var
Sent: String[80];
Word: Array [1..10] of String[10];
I, Num: Byte;
Ch: Char;
begin
Write ('Enter sentence: '); Readln (Sent);
Num := 1; Word[Num] := '';
for I := 1 to Length(Sent) do begin
Ch := Sent[I];
if Ch <> ' ' then
Word[Num] := Word[Num] + Ch
else begin
Inc(Num);
Word[Num] := '';
end;
end;
for I := Num downto 1 do
Write (Word[I], ' ');
Writeln;
end.
{2.8}
program Two8T83;
{ -- This program will convert cubic feet to cubic meters. }
{ -- (1 in. = 2.54 cm) }
var
CF, CM, CM3: Real;
begin
Write ('Enter cubic feet: '); Readln (CF);
CM3 := CF * (12 * 2.54) * (12 * 2.54) * (12 * 2.54);
CM := CM3/ 100 / 100 / 100;
Writeln (CM :7:4, ' CUBIC METERS');
end.
{2.9}
program Two9T83;
{ -- This program will find sum of Ys for Xs for Y=2(X+5). }
var
A, B, X, Sum: Integer;
begin
Write ('Enter a and b: '); Readln (A, B); Sum := 0;
for X := A to B do
Sum := Sum + 2 * (X+5);
Writeln ('SUM = ', Sum);
end.
{2.10}
program Two10T83;
{ -- This program will print 1 char. for 10 sec, 2 for 10 sec.. }
uses Crt;
var
I, J: Byte;
Ch: Char;
begin
Write ('Enter character: '); Readln (Ch); ClrScr;
for I := 1 to 10 do begin
for J := 1 to I do
Write (Ch);
Delay (5000);
ClrScr; Delay (500);
end;
end.
{3.1}
program Thr1T83;
{ -- This program converts a number for one base to another. }
var
Base1, Base2, Num1V, Num2, Power: Integer;
I, J, K, X, Digit: Integer;
Num1: String[7];
Ch: Char;
begin
Write ('ENTER NUMBER: '); Readln (Num1);
Write ('ENTER BASE: '); Readln (Base1);
Write ('CONVERT TO BASE: '); Readln (Base2);
Write ('ANSWER IS ');
{ -- Convert Num1 to base 10 number Num1V }
Num1V := 0;
for I := 1 to Length(Num1) do begin
Ch := Num1[I];
Digit := Ord(Ch) - Ord('0');
Power := 1;
for J := 1 to Length(Num1) - I do
Power := Power * Base1;
Num1V := Num1V + Digit * Power;
end;
{ -- Convert Num1V to Base2 number }
J := Trunc(Ln(Num1V) / Ln(Base2));
for I := J downto 0 do begin
Power := 1;
for K := 1 to I do Power := Power * Base2;
X := Num1V div Power;
Write (X);
Num1V := Num1V - X * Power;
end;
Writeln;
end.
{3.2}
program Thr2T83;
{ -- This program determines what triangle is made w/3 points. }
var
X1, Y1, X2, Y2, X3, Y3: Integer;
D1, D2, D3: Real;
begin
Write ('Enter X1, Y1: '); Readln (X1, Y1);
Write ('Enter X2, Y2: '); Readln (X2, Y2);
Write ('Enter X3, Y3: '); Readln (X3, Y3);
{ -- Calculate distances }
D1 := Sqrt ((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2));
D2 := Sqrt ((X2-X3)*(X2-X3) + (Y2-Y3)*(Y2-Y3));
D3 := Sqrt ((X3-X1)*(X3-X1) + (Y3-Y1)*(Y3-Y1));
{ -- No triangle can be formed if sum of 2 sides equals third. }
if (D1+D2 = D3) or (D1+D3 = D2) or (D2+D3 = D1) then
Writeln ('NOT A TRIANGLE')
else if (D1 = D2) and (D2 = D3) then
Writeln ('EQUILATERAL')
else if (D1 = D2) or (D2 = D3) or (D1 = D3) then
Writeln ('ISOSCELES')
else
Writeln ('SCALENE');
end.
{3.3}
program Thr3T83;
{ -- This program randomly selects an X, Y in 10 x 10 grid. User
-- guesses numbers; if guess is wrong, a direction is given. }
var
X, Y, A, B: Byte;
begin
Randomize;
X := Random(10) + 1; Y := Random(10) + 1;
repeat
Write ('Enter X, Y: '); Readln (A, B);
if (A = X) and (B < Y) then Writeln ('UP')
else if (A = X) and (B > Y) then Writeln ('DOWN')
else if (A > X) and (B = Y) then Writeln ('LEFT')
else if (A < X) and (B = Y) then Writeln ('RIGHT')
else if (A < X) and (B < Y) then Writeln ('UP AND RIGHT')
else if (A < X) and (B > Y) then Writeln ('DOWN AND RIGHT')
else if (A > X) and (B < Y) then Writeln ('UP AND LEFT')
else if (A > X) and (B > Y) then Writeln ('DOWN AND LEFT');
until (A=X) and (B=Y);
end.
{3.4}
program Thr4T83;
{ -- This program will divide 1st number by 2nd out to N places. }
var
Num1, Num2, Places, I, X: Integer;
begin
Write ('ENTER FIRST NUMBER: '); Readln (Num1);
Write ('ENTER SECOND NUMBER: '); Readln (Num2);
Write ('ENTER NUMBER OF DECIMAL PLACES: '); Readln (Places);
Write ('QUOTIENT IS ');
X := Num1 div Num2; Write (X, '.');
Num1 := Num1 - Num2*X;
for I := 1 to Places do begin
Num1 := Num1 * 10;
X := Num1 div Num2;
Write (X);
Num1 := Num1 - Num2*X;
end;
end.
{3.5}
program Thr5T83;
{ -- This program will display numbers 1-8 and a blank in a
-- 3 x 3 array. When a digit is pressed, it moves into the
-- blank (if possible). }
uses Crt;
var
I, J, X, R1, R2, IndX, IndY: Byte;
Digit, BlankX, BlankY: Byte;
A: Array [1..3, 1..3] of Byte;
Valid: Boolean;
DigSt: String[1];
Code: Integer;
begin
{ -- Randomly place numbers in Array A. }
Randomize;
for I := 1 to 3 do
for J := 1 to 3 do
A[I,J] := (I-1)*3 + J-1;
for I := 1 to 3 do
for J := 1 to 3 do begin { -- swap array values }
R1 := Random(3) + 1; R2 := Random(3) + 1;
X := A[I,J]; A[I,J] := A[R1,R2]; A[R1,R2] := X;
end;
repeat
{ -- Display array }
ClrScr;
for I := 1 to 3 do begin
for J := 1 to 3 do
if A[I,J] > 0 then Write (A[I,J], ' ')
else begin
Write (' ');
BlankX := I; BlankY := J;
end;
Writeln;
end;
{ -- Accept valid digit or 9 }
Valid := False;
repeat
DigSt := ''; while DigSt = '' do DigSt := ReadKey;
Val(DigSt,Digit,Code);
for I := 1 to 3 do
for J := 1 to 3 do
if Digit = A[I,J] then begin
IndX := I; IndY := J;
end;
if Abs(BlankX - IndX) + Abs(BlankY - IndY) = 1 then
{ -- adjacent }
Valid := True;
until Valid or (Digit = 9);
if Valid then begin { -- move digit in space }
X := A[IndX,IndY]; A[IndX,IndY] := A[BlankX,BlankY];
A[BlankX,BlankY] := X;
end;
until Digit = 9; { -- 9 pressed }
end.
{3.6}
program Thr6T83;
{ -- This program will store a list of words and provide options.}
var
Option, I, J, Num: Byte;
Word: Array [1..10] of String[10];
DeleteW: String[10];
begin
Num := 0;
repeat
Writeln;
Writeln ('1. ADD A WORD TO THE LIST');
Writeln ('2. DELETE A WORD FROM THE LIST');
Writeln ('3. DISPLAY THE ENTIRE LIST');
Readln (Option);
case Option of
1: begin
Inc(Num);
Write ('Enter word: '); Readln (Word[Num]);
end;
2: begin
Write ('Enter word: '); Readln (DeleteW);
I := 1;
while (I <= Num) and (Word[I] <> DeleteW) do
Inc(I);
for J := I to Num-1 do Word[J] := Word[J+1];
Dec(Num);
end;
3: for I := 1 to Num do
Writeln (Word[I]);
end;
until Option > 3;
end.
{3.7}
program Thr7T83;
{ -- This program will solve cryptorithms with two 2-letter
addends
-- and a 3-letter sum, using only the letters A,B,C,D, and E. }
var
St1, St2, St3: String[3];
Letters, Numbers: String[7];
FirstLet, UniqueLet: Array [1..7] of Integer;
N1St, N2St, SumSt: String[3];
Ch: Char;
Solution, AtLeast1: Boolean;
I, J, N1, N2, Sum, NumLet: Integer;
begin
Write ('Enter FIRST ADDEND: '); Readln (St1);
Write ('Enter SECOND ADDEND: '); Readln (St2);
Write ('Enter SUM: '); Readln (St3);
Letters := St1 + St2 + St3; NumLet := 0; AtLeast1 := False;
{ Put in FirstLet[] the index of the first occurence of letter }
for I := 1 to 7 do begin
Ch := Letters[I];
FirstLet[I] := Pos(Ch, Letters);
if FirstLet[I] = I then begin { -- This is a new letter. }
Inc(NumLet);
UniqueLet[NumLet] := I;
end;
end;
for N1 := 10 to 98 do { -- N1 must be 2 digits, >9 }
for N2 := 100-N1 to 98 do begin { -- N2 must be 2 digits, >9 }
Sum := N1 + N2; { -- Sum must be 3 digits,>99}
Str (N1, N1St); Str (N2, N2St); Str (Sum, SumSt);
Numbers := N1St + N2St + SumSt;
I := 1; Solution := True;
{ -- Check if similar letters correspond to similar numbers}
repeat
Ch := Numbers[I];
if Ch <> Copy (Numbers, FirstLet[I], 1) then
Solution := False;
Inc(I);
until (I > 7) or not Solution;
{ -- Check if unique letters correspond to unique digits }
for I := 1 to NumLet-1 do
for J := I+1 to NumLet do
if Numbers[UniqueLet[I]] = Numbers[UniqueLet[J]] then
Solution := False;
if Solution then begin { -- Display solution }
for I := 1 to NumLet do begin
Write (Letters[UniqueLet[I]], ' = ');
Writeln (Numbers[UniqueLet[I]]);
end; Exit;
Writeln; AtLeast1 := True;
end;
end; { - for N2 }
if not AtLeast1 then
Writeln ('NO SOLUTION POSSIBLE');
end.
{3.8}
program Thr8T83;
{ -- This program will simulate random frog jumps on nine pads. }
uses Crt;
var
I, F, Num: Byte;
begin
Randomize; ClrScr;
for I := 1 to 10 do begin
GotoXY (1, 1); ClrEol;
GotoXY (1, 2); Writeln ('- - - - - - - - -');
F := 5;
GotoXY (F*2-1, 1); Write ('F'); Num := 0;
repeat
if Random(2) = 1 then { -- go right }
Inc(F)
else { -- go left }
Dec(F);
GotoXY (1, 1); ClrEol;
GotoXY (F*2-1, 1); Write ('F'); Delay (50);
Inc(Num);
until (F = 1) or (F = 9);
GotoXY (I*3, 5); Write (Num);
end;
end.
{3.9}
program Thr9T83;
{ -- This program will allow a user to position a cursor under a
-- sentence using the L and R keys. Space bar deletes letter. }
uses Crt;
var
I, Col: Byte;
Sent: String[80];
Ch: Char;
begin
ClrScr;
Write ('Enter Sentence: '); Readln (Sent); { -- Starts at 17 }
Col := 17;
repeat
GotoXY (Col, 2);
repeat
Ch := ReadKey; Ch := UpCase(Ch);
until (Ch in ['R', 'L', ' ']) or (Ch = Chr(27));
if Ch = 'R' then { -- move cursor to right }
Inc(Col)
else if Ch = 'L' then { -- move cursor to left }
Dec(Col)
else if Ch = ' ' then { -- delete character above cursor }
Delete (Sent, Col-16, 1);
GotoXY (17, 1); Writeln (Sent, ' ');
until (Ch = Chr(27)) or (Length(Sent) = 1);
end.
{3.10}
program Thr10T83;
{ -- This program will simulate the movement of a pool ball on a
-- rectangular pool table. It moves in a 45 degree angle. }
uses Crt, Graph3;
var
W, L, WI, LI, I, X, Y, XDir, YDir: Integer;
Finished: Boolean;
begin
Write ('Enter Width, Length: '); Readln (W, L);
ClrScr; GraphMode;
WI := 10; LI := 10;
{ -- Draw Pool Table }
for I := 0 to W do
Draw (0,I*WI, L*LI,I*WI, 1);
for I := 0 to L do
Draw (I*LI,0, I*LI,W*WI, 1);
X := 0; Y := W*WI; XDir := 1; YDir := -1;
repeat
Plot (X, Y, 0);
X := X + XDir; Y := Y + YDir;
Plot (X, Y, 2); Delay (10);
if (X = 0) or (X = L*LI) then
XDir := -1 * XDir;
if (Y = 0) or (Y = W*WI) then
YDir := -1 * YDir;
Finished := True; GotoXY (1,20);
if (X = 0) and (Y = 0) then
Writeln ('LEFT-TOP')
else if (X = 0) and (Y = W*WI) then
Writeln ('LEFT-BOTTOM')
else if (X = L*LI) and (Y = 0) then
Writeln ('RIGHT-TOP')
else if (X = L*LI) and (Y = W*WI) then
Writeln ('RIGHT-BOTTOM')
else
Finished := False;
until Finished;
end.