{ -- 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.