{ -- FLORIDA HIGH SCHOOLS COMPUTING COMPETITION '84 }
{ -- PASCAL PROGRAM SOLUTIONS }
{1.1}
program One1T84;
{ -- This program produces a table of Fahrenheit for Celcius. }
var
C: Integer;
begin
Writeln ('CELCIUS FAHRENHEIT');
C := 50;
while C <= 200 do begin
Writeln (C :3, Trunc (1.8 * C + 32 + 0.5) :11);
C := C + 25;
end;
end.
{1.2}
program One2T84;
{ -- This program will determine time a person slept in seconds. }
var
H1, M1, S1, H2, M2, S2, T: LongInt;
begin
Write ('WHAT TIME DID YOU GO TO BED (H, M, S) ');
Readln (H1, M1, S1);
Write ('WHAT TIME DID YOU GET UP (H, M, S) ');
Readln (H2, M2, S2);
T := (11 - H1) * 3600 + (59 - M1) * 60 + (60 - S1);
Write ('YOU SLEPT FOR ');
Writeln (T + H2 * 3600 + M2 * 60 + S2, ' SECONDS');
end.
{1.3}
program One3T84;
{ -- This program will display distance/height of a golf ball. }
var
T, H, V: Real;
begin
Writeln (' T H V'); T := 0.0;
while (V > 0) or (T < 1) do begin
H := 120 * T; V := 120 * T - 16 * T*T;
Writeln (T :2:1, ' ', H: 3:0, ' ', V: 3:0);
T := T + 0.5;
end;
end.
{1.4}
program One4T84;
{ -- This program produces table of mice population and food. }
var
Y, P, F: Integer;
begin
Writeln ('NUMBER OF YEARS POPULATION FOOD SUPPLY FOR');
Y := 0; P := 10; F := 100;
Writeln (Y, ' ':16, P :4, F :14);
while P < F do begin
Inc(Y); P := P * 2; F := F + 40;
Writeln (Y, ' ':16, P :4, F :14);
end;
end.
{1.5}
program One5T84;
{ -- This program will determine time that a savings doubles. }
var
N, P, Y: Integer;
X: Real;
begin
Write ('Enter amount, % '); Readln (N, P);
X := N; Y := 0;
while X < 2 * N do begin
X := X * (1 + P / 100); Inc(Y);
end;
Writeln (Y, ' YEARS');
end.
{1.6}
program One6T84;
{ -- This program will determine name at beginning and end. }
var
Min, Max, NM: String[10];
I: Byte;
begin
Min := 'ZZZZZZZZZZ'; Max := 'AAAAAAAAAA';
for I := 1 to 5 do begin
Write ('Enter name: '); Readln (NM);
if NM < Min then Min := NM;
if NM > Max then Max := NM;
end;
Writeln ('NAME CLOSEST TO BEGINNING: ', Min);
Writeln ('NAME CLOSEST TO END: ', Max);
end.
{1.7}
program One7T84;
{ -- This program will determine longest run of heads of tosses. }
var
N, H, Max, I: Integer;
begin
Randomize;
Write ('N: '); Readln (N);
H := 0; Max := 0;
for I := 1 to N do
if Random(2) = 1 then Inc(H)
else
if H > Max then begin
Max := H; H := 0; end
else
H := 0;
If H > Max then Max := H;
Writeln (Max, ' CONSECUTIVE HEADS');
end.
{1.8}
program One8T84;
{ -- This program will display numbers with 7s zapped. }
var
I, T, O: Byte;
begin
for I := 1 to 100 do begin
T := I div 10; O := I - T * 10;
if ((T = 7) or (O = 7)) and (I mod 7 = 0) then
Write ('ZAPZAP' :16)
else if (T = 7) or (O = 7) then
Write ('ZAP': 16)
else
Write (I :16);
end;
Writeln;
end.
{1.9}
program One9T84;
{ -- This program will print the # of double letters. }
var
C, LastC: Char;
A: String[60];
D, I: Byte;
begin
Write ('Enter text: '); Readln (A); D := 0;
for I := 1 to Length(A) do begin
C := A[I];
if C = LastC then Inc(D);
LastC := C;
end;
Writeln (D);
end.
{1.10}
program One10T84;
{ -- This program will display sevens multiplication facts. }
var
I, Ans, W: Byte;
begin
for I := 0 to 9 do begin
W := 0;
repeat
Write (I, ' X 7 = '); Readln (Ans);
if Ans <> I * 7 then
if W = 0 then W := 1 else begin
Writeln (I * 7);
W := 2;
end;
until (I * 7 = Ans) or (W = 2);
end;
end.
{2.1}
program Two1T84;
{ -- This program will print number of vowels in text. }
var
A: String[60];
C: Char;
I, V: Byte;
begin
Write ('Enter text: '); Readln (A);
for I := 1 to Length (A) do begin
C := A[I];
if C in ['A', 'E', 'I', 'O', 'U'] then
Inc(V);
end;
Writeln (V, ' VOWELS');
end.
{2.2}
program Two2T84;
{ -- This program sorts rational numbers in increasing order. }
var
N, M, I, J, S: Integer;
Nst, Mst, Xst: String[7];
X: Real;
V: Array [1..9] of Real;
A: Array [1..9] of String[7];
begin
Write ('Enter N, M: '); Readln (N, M); S := 0;
while (N > 0) and (M > 0) do begin
Inc(S);
Str (N, Nst); Str (M, Mst);
A[S] := Nst + '/' + Mst; V[S] := N / M;
Write ('Enter N, M: '); Readln (N, M);
end;
for I := 1 to S-1 do
for J := I+1 to S do
if V[I] > V[J] then begin
X := V[I]; V[I] := V[J]; V[J] := X;
Xst := A[I]; A[I] := A[J]; A[J] := Xst;
end;
for I := 1 to S do Writeln (A[I]);
end.
{2.3}
program Two3T84;
{ -- This program displays #s that sum of cubes of digits= #. }
var
I, J, K, Num: Integer;
begin
for I := 1 to 9 do
for J := 0 to 9 do
for K := 0 to 9 do begin
Num := I*100 + J*10 + K;
if Num = I*I*I + J*J*J + K*K*K then Writeln (Num);
end;
end.
{2.4}
program Two4T84;
{ -- This program will print a triangle of #s by an algorithm. }
var
N, J, I, X: Integer;
begin
Write ('Enter # of rows: '); Readln (N);
for I := 1 to N do begin
Write (' ': N-I+1);
for J := I to 2*I - 1 do
Write (J mod 10);
for J := 2*I - 2 downto I do
Write (J mod 10);
Writeln;
end;
end.
{2.5}
program Two5T84;
{ -- This program will display a page of multiplication drills. }
uses Crt;
var
I, H, V, X, Y: Byte;
begin
Randomize; ClrScr;
Writeln (' MULTIPLICATION DRILL');
for I := 1 to 6 do begin
H := (I - 1) div 3; V := I - H * 3; H := H * 20 + 1;
X := Random(90) + 10; Y := Random(9) + 1;
GotoXY (H, V*5); Write (I, '. ', X);
GotoXY (H, V*5+1); Write (' X ', Y);
GotoXY (H, V*5+2); Write (' ----');
end;
end.
{2.6}
program Two6T84;
{ -- This program will simulate throwing darts. }
var
N, X, Y, I, J, S: Byte;
A: Array [1..5, 1..5] of Byte;
begin
Randomize; Write ('Enter N: '); Readln (N); S := 0;
for I := 1 to 5 do
for J := 1 to 5 do
A[I, J] := 0;
for I := 1 to N do begin
X := Random(5) + 1; Y := Random(5) + 1; A[X, Y] := 1;
end;
for I := 1 to 5 do begin
for J := 1 to 5 do
if A[I, J] = 1 then begin
Write ('* '); Inc(S); end
else
Write ('. ');
Writeln;
end;
Writeln ('NUMBER OF THROWS = ', N);
Writeln ('NUMBER OF SQUARES HIT = ', S);
end.
{2.7}
program Two7T84;
{ -- This program will determine if text is palindrome. }
var
A, S: String[80];
L, I: Byte;
C: Char;
begin
Write ('Enter text: '); Readln (A);
S := '';
for I := 1 to Length(A) do begin
C := A[I];
if (C >= 'A') and (C <= 'Z') then S := S + C;
end;
L := Length(S);
for I := 1 to L div 2 do
if Copy(S, I, 1) <> Copy(S, L - I + 1, 1) then begin
Writeln ('NOT PALINDROME'); Exit;
end;
Writeln ('PALINDROME');
end.
{2.8}
program Two8T84;
{ -- This program will display the frequency of letters. }
var
A: String[60];
B: Array[1..26] of Byte;
L, I, X, T: Byte;
C: Char;
begin
Write ('Enter sentence: '); Readln (A);
L := Length(A); T := 0;
for I := 1 to 26 do B[I] := 0;
for I := 1 to L do begin
C := A[I];
if C in ['A' .. 'Z'] then begin
X := Ord(C) - Ord('A') + 1; Inc(B[X]); Inc(T);
end;
end;
Writeln ('LETTER FREQUENCY PERCENT');
for I := 1 to 26 do
if B[I] > 0 then begin
Write (Chr(I + 64), ' ':8, B[I], ' ':11);
Writeln (Round (B[I] / T * 100));
end;
Writeln ('TOTAL ', T);
end.
{2.9}
program Two9T84;
{ -- This program will print the longest word in sentence. }
var
A, W, Max: String[80];
I, L: Byte;
C: Char;
begin
Write ('Enter sentence: '); Readln (A); A := A + ' ';
L := Length (A); Max := ''; W := '';
for I := 1 to L do begin
C := A[I];
if C <> ' ' then
W := W + C
else begin
if Length(W) > Length(Max) then Max := W;
W := '';
end;
end;
Writeln (Max);
end.
{2.10}
program Two10T84;
{ -- This program will play rock, scissors, and paper. }
var
A: Char;
X, T, L, W: Byte;
begin
Randomize;
Write ('Enter R, S, P, or Q: '); Readln (A);
W := 0; L := 0; T := 0;
while A <> 'Q' do begin
X := Random (3);
if (X = 0) and (A = 'R') then begin
Inc(T); Writeln ('TIE'); end
else if (X = 1) and (A = 'S') then begin
Inc(T); Writeln ('TIE'); end
else if (X = 2) and (A = 'P') then begin
Inc(T); Writeln ('TIE'); end
else if (X = 0) and (A = 'P') then begin
Inc(W); Writeln ('YOU WIN'); end
else if (X = 1) and (A = 'R') then begin
Inc(W); Writeln ('YOU WIN'); end
else if (X = 2) and (A = 'S') then begin
Inc(W); Writeln ('YOU WIN'); end
else begin
Inc(L); Writeln ('I WIN');
end;
Write ('Enter R, S, P, or Q: '); Readln (A);
end;
Writeln (T, ' TIES');
Writeln (W, ' WINS (YOURS)');
Writeln (L, ' LOSSES (MINE)');
end.
{3.1}
program Thr1T84;
{ -- This program will display a random trail of asterisks. }
{ -- However, the program description is poorly worded and
ambiguous. The judging criteria is also poorly described. }
uses Crt;
var
A: Array [1..24, 1..80] of Byte;
I, J, V, H, X, Y: Byte;
Ch: Char;
SameRun: Boolean;
begin
Randomize;
repeat
ClrScr;
for I := 1 to 24 do
for J := 1 to 80 do A[I,J] := 0;
V := 12; H := 40; A[V, H] := 1;
GotoXY (H, V); Write ('S'); SameRun := True;
while SameRun do begin
repeat
X := Random(4)
until (X - 2 <> Y) and (Y - 2 <> X);
if X = 0 then Dec(H);
if X = 2 then Inc(H);
if X = 1 then Dec(V);
if X = 3 then Inc(V);
if (A[V,H] = 1) or (V = 0) or (V = 23) or (H = 0) or (H = 80)
then begin
GotoXY (1, 22);
Write ('THE MAXIMUM DISTANCE FROM START = ');
Writeln (Abs(40 - H) + Abs(12 - V));
Ch := ReadKey; SameRun := False;
end
else begin
A[V, H] := 1; GotoXY (H, V); Write ('*'); Y := X;
end;
end; { -- while }
until Ch = 'Q';
end.
{3.2}
program Thr2T84;
{ -- This program will decode a message with frequent letters. }
const
B: String[12] = 'ETAOINSHRDLU';
var
Ast, Bst: Array [0..32] of Char;
A: Array [1..32] of Byte;
Mes: String[32];
I, J, K,
L, S, G: Byte;
begin
Write ('Message: '); Readln (Mes); L := Length(Mes);
for I := 1 to L do begin
Ast[I] := Mes[I]; A[I] := 0;
end;
Ast[0] := ' '; G := 0; S := 0;
for I := 1 to L do begin
K := 0;
while (Ast[K] <> Ast[I]) and (K <= I-1) do Inc(K);
if K = I then begin { -- Found 1st occurence of letter }
for J := I to L do
if Ast[I] = Ast[J] then Inc(A[I]);
if A[I] > G then G := A[I];
end;
end;
{ -- Replace letters in message }
for I := G downto 1 do begin
J := 1;
while (A[J] <> I) and (J <= L) do Inc(J);
if J <= L then begin
Inc(S);
for K := J to L do
if Ast[K] = Ast[J] then Bst[K] := B[S];
end;
end;
for I := 1 to L do Write (Bst[I]);
Writeln;
end.
{3.3}
program Thr3T84;
{ -- This program will produce the digital product root. }
var
I: Byte;
Nst, N, X: LongInt;
begin
Write ('ORIGINAL VALUE (1 TO 7 DIGITS): '); Readln (Nst);
Writeln (Nst);
while Nst > 9 do begin
N := 1;
for I := 1 to trunc(ln(Nst) / ln(10)) + 1 do begin
X := Nst - (Nst div 10) * 10;
if X > 0 then N := N * X;
Nst := Nst div 10;
end;
Writeln (N); Nst := N;
end;
end.
{3.4}
program Thr4T84;
{ -- This program will display twin primes. }
var
N, I, J, T: Integer;
Prime: Boolean;
begin
Write ('Enter N: '); Readln (N);
Writeln ('TWIN PRIMES NOT GREATER THAN ', N);
for I := 3 to N - 2 do begin
J := 2; Prime := True;
while (J <= Trunc(Sqrt(I))) and Prime do begin
If I mod J = 0 then Prime := False;
Inc(J);
end;
if Prime then begin
T := I + 2;
J := 2;
while (J <= Trunc(Sqrt(T))) and Prime do begin
if T mod J = 0 then Prime := False;
Inc(J);
end;
if Prime then Writeln (I, ' ', T);
end;
end;
end.
{3.5}
program Thr5T84;
{ -- This program will print subsets of m people. }
var
A: Array [1..26] of Byte;
Ast: Array [1..26] of Char;
I, M, L, N, S: Byte;
begin
Write ('INPUT NUMBER, CAPACITY: '); Readln (L, M);
for I := 1 to M do A[I] := M - I + 1;
for I := 1 to L do Ast[I] := Chr(64 + I);
N := 1; Dec(A[1]); S := 0;
while N <= M do begin
Inc(A[N]);
if N > 1 then
for I := N-1 downto 1 do A[I] := A[I+1] + 1;
if A[N] <= L - N + 1 then begin
for I := M downto 1 do Write (Ast[A[I]]);
Write(' ': 16 - M);
Inc(S); N := 0;
end;
Inc(N);
end;
Writeln;
Writeln ('THERE ARE ', S, ' SUBSETS');
end.
{3.6}
program Thr6T84;
{ -- This program will display histogram of letter frequency. }
uses Crt;
const
B: Array [1..5] of String[50] =
('THE QUICK BROWN FOX JUMPED OVER THE LAZY DOG.',
'THIS IS AN EXAMPLE OF HOW',
'TO TEST YOUR HISTOGRAM PROGRAM. YOU',
'CAN USE THIS EXAMPLE.',
'*END*');
var
A: Array [1..26] of Byte;
I, J, X, G: Byte;
begin
ClrScr;
for I := 1 to 26 do A[I] := 0;
J := 1; G := 0;
while B[J] <> '*END*' do begin
for I := 1 to Length(B[J]) do begin
X := Ord(B[J, I]) - Ord('A') + 1;
if (X >= 1) and (X <= 26) then
Inc(A[X]);
if A[X] > G then G := A[X];
end;
Inc(J);
end;
for I := G downto 1 do begin
for J := 1 to 26 do
if A[J] >= I then begin
GotoXY (J, G - I + 1); Write ('*');
end;
Writeln;
end;
for I := Ord('A') to Ord('Z') do Write (Chr(I));
Writeln;
end.
{3.7}
program Thr7T84;
{ -- This program will display a repeating decimal. }
var
Re: Array [1..100] of Integer;
N, D, X, I, J, R: Integer;
A, Xst: String[100];
begin
A := ''; I := 0;
Write ('Enter N, D: '); Readln (N, D);
Write (N, '/', D, ' = '); X := N div D;
if X > 0 then Write (X);
Write ('.');
repeat
Inc(I); R := N - D * X;
if R = 0 then begin
Writeln (A); Exit;
end;
Re[I] := R; N := R * 10; X := N div D;
{ -- Display decimal if remainder repeats itself }
for J := 1 to I - 1 do
if Re[J] = R then begin
Write (Copy(A, 1, J-1), '(');
Writeln (Copy(A, J, I-J), ')'); Exit;
end;
Str (X, Xst);
A := A + Xst;
until R = 0;
end.
{3.8}
program Thr8T84;
{ -- This program will print # of round numbers less than N. }
var
I, J, K, L, M, N, S, T, X, Pow: Integer;
begin
Write ('INPUT NUMBER: '); Readln (N); T := 0;
for I := 2 to N do begin
M := I; S := 0; K := Trunc(Ln(M) / Ln(2) + 0.01);
for J := K downto 0 do begin
Pow := 1;
for L := 1 to J do Pow := Pow * 2;
X := M div Pow;
S := S + X; M := M - X * Pow;
end;
if S + S = K + 1 then Inc(T);
end;
Write ('THERE ARE ', T);
Writeln (' ROUND NUMBERS LESS THAN OR EQUAL TO ', N);
end.
{3.9}
program Thr9T84;
{ -- This program will provide automated price increases. }
const
A: Array [1..3] of String[50] =
('THE CURRENT COST OF BUCKLES IS',
'3 FOR $2.50, OR $10.00 A DOZEN.',
'*END*');
var
I, J, K, L, X, Per, Code: Integer;
Xst: Char;
P, T: Real;
begin
Write ('Enter %: '); Readln (P); P := P / 100;
K := 1;
while A[K] <> '*END*' do begin
L := Length (A[K]); I := 0;
repeat
Per := 0;
while (I < L) and (Xst <> '$') do begin
Inc(I); Xst := A[K , I]; Write (Xst);
end;
if Xst <> '$' then Writeln
else begin
J := I; X := 50;
while (J < L) and ((Xst = '.') or ((X > 47) and (X < 58)))
and (Per < 2) do begin
Inc(J); Xst := A[K , J]; X := Ord(Xst);
if Xst = '.' then Inc(Per);
end;
Val (Copy(A[K], I+1, J-I-1), T, Code);
T := T + T * P; T := Round(T * 100) / 100;
Write (T: 4:2);
I := J - 1;
end;
until I >= L;
Inc(K);
end;
end.
{3.10}
program Thr10T84;
{ -- This program will simulate tennis sets between 2 players. }
var
N, P, A, B, AG, BG, W, L: Integer;
begin
Randomize; A := 0; B := 0; AG := 0; BG := 0; W := 0; L := 0;
Write ('NUMBER OF SETS = '); Readln (N);
Write ('% CHANCE A WINS A POINT= '); Readln (P);
repeat
if Random(100) < P then Inc(A) else Inc(B);
if (A > 3) and (A > B + 1) then begin
Write ('A'); Inc(AG); A := 0; B := 0;
end;
if (B > 3) and (B > A + 1) then begin
Write ('B'); Inc(BG); A := 0; B := 0;
end;
if (AG > 5) and (AG > BG + 1) then begin
Writeln (' (A)'); Inc(W); AG := 0; BG := 0;
end;
if (BG > 5) and (BG > AG + 1) then begin
Writeln (' (B)'); Inc(L); AG := 0; BG := 0;
end;
until W + L = N;
if W > L then
Writeln ('PLAYER ''A'' WON ', W, ' SETS OUT OF ', N)
else
Writeln ('PLAYER ''B'' WON ', L, ' SETS OUT OF ', N);
end.