```{ -- 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) ');
Write ('WHAT TIME DID YOU GET UP (H, M, S) ');
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;
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;
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.

```