program PlayingGames;
{ Solution to the 1999 British Informatics Olympiad exam
* question 3: Playing Games
*
* Solution copyright (c) 1999 The British Informatics Olympiad (BIO).
*
* This program may be freely copied by persons or organisations
* involved in the British Informatics Olympiad or the International
* Olympiad in Informatics, on condition that no changes are made and
* this notice is not altered. Distribution for profit is forbidden
* unless permission is first obtained in writing from the BIO.
*
* This program is for educational purposes only and comes with no
* warranty, implied or otherwise, as to its fitness for any purpose.
*
* Author: Antony Rix
* Internet: http://www.christs.cam.ac.uk/bio/
* E-mail: a.rix@lineone.net
* S-mail: The British Informatics Olympiad
* Christ's College
* Cambridge CB2 3BU
* United Kingdom
}
var
{ Input data. }
n, m: integer;
scores: array[1..10] of integer;
totals: array[1..10] of integer;
{ Arrays used for the dynamic programming solution. }
num_rounds: array[0..1000] of integer;
last_score: array[0..1000] of integer;
{ Get the input for part 3a. }
function read_input: boolean;
var i: integer;
begin
{ If we detect invalid data we return false to return to the main menu }
read_input := false;
write( 'Value of n:' );
readln( n );
if (n < 1) or (n > 10) then begin
writeln( 'n must be from 1 to 10!' );
exit;
end;
writeln( 'Enter ', n, ' different positive scores separated by space:' );
for i := 1 to n do begin
read( scores[i] );
if (scores[i] < 1) or (scores[i] > 1000) then begin
writeln; writeln( 'Scores must be from 1 to 1000!' );
exit;
end;
end;
readln;
write( 'Value of m:' );
readln( m );
if (m < 1) or (m > 10) then begin
writeln( 'm must be from 1 to 10!' );
exit;
end;
writeln( 'Enter ', m, ' totals separated by space:' );
for i := 1 to m do read( totals[i] );
readln;
read_input := true;
end;
{ Simple, greedy solution to the problem. This is often incorrect. }
procedure solve_greedy;
var i, j, s, r: integer;
num: array[1..10] of integer;
begin
{ Sort the scores into decreasing order using a bubble sort }
for i := 2 to n do for j := 2 to n do
if scores[j] > scores[j-1] then begin
s := scores[j]; scores[j] := scores[j-1]; scores[j-1] := s;
end;
{ Test the sort using the following statement }
{ for i := 1 to n do writeln( scores[i] ); }
{ For each total, allocate the scores in a greedy manner }
for i := 1 to m do begin
for j := 1 to n do num[j] := 0;
s := totals[i];
j := 1;
r := 0;
while (s <> 0) and (j <= n) do begin
{ Test if score[j] is possible. If so, choose it, otherwise
move on to the next score. }
if s >= scores[j] then begin
s := s - scores[j];
num[j] := num[j] + 1;
r := r + 1;
end
else
j := j + 1;
end;
{ Show result for this total in increasing order of score if it
has been possible to get the right total, or print Impossible }
if s = 0 then begin
write( 'Total ', totals[i], ' in ', r, ' rounds:' );
for j := n downto 1 do if num[j] > 0 then
write( ' ', num[j], 'x', scores[j] );
writeln;
end
else
writeln( 'Total ', totals[i], ' is Impossible' );
end;
end;
{ Finds the possible scores and (for testing) displays them if required.
Uses a dynamic programming method. }
procedure find_dynamic( show: boolean );
var i, j: integer;
begin
{ Initialise the arrays that store the number of rounds required to
reach each value, and the last score. }
for i := 1 to 1000 do begin
num_rounds[i] := 9999;
last_score[i] := 9999;
end;
num_rounds[0] := 0;
last_score[0] := 0;
{ Find the scores required to reach each total }
i := 0;
while i <= 1000 do begin
{ For each possible score, see if the new totals are reached
in fewer rounds than before. }
for j := 1 to n do if i + scores[j] <= 1000 then
if num_rounds[i + scores[j]] > num_rounds[i] + 1 then begin
num_rounds[i + scores[j]] := num_rounds[i] + 1;
last_score[i + scores[j]] := scores[j];
end;
{ Show the steps leading to this point }
if (i > 0) and show then begin
write( i, ':' );
j := i;
while j > 0 do begin
write( last_score[j], ' ' );
j := j - last_score[j];
end;
writeln;
end;
{ Find the next valid total }
repeat
inc(i);
if i > 1000 then break; { We are off the end of the array }
until num_rounds[i] < 9999; { We have a valid total }
end;
end;
{ Illustrates the dynamic method. }
procedure test_dynamic;
var i: integer;
begin
{ Read in n and then n scores }
write( 'Value of n:' );
readln( n );
if (n < 1) or (n > 10) then begin
writeln( 'n must be from 1 to 10!' );
exit;
end;
writeln( 'Enter ', n, ' different positive scores separated by space:' );
for i := 1 to n do begin
read( scores[i] );
if (scores[i] < 1) or (scores[i] > 1000) then begin
writeln; writeln( 'Scores must be from 1 to 1000!' );
exit;
end;
end;
readln;
{ Use find_dynamic to find and show the results }
find_dynamic( true );
end;
{ Full dynamic programming solution to 3a using find_dynamic. }
procedure solve_dynamic;
var i, j, p, c: integer;
begin
{ Use find_dynamic to find the possible totals }
find_dynamic( false );
{ For each required total, test if it is reachable }
for i := 1 to m do begin
if (totals[i] < 1) or (totals[i] > 1000) then
writeln( 'Total ', totals[i], ' is Impossible - out of range' )
else if num_rounds[totals[i]] = 9999 then
writeln( 'Total ', totals[i], ' is Impossible' )
else begin
write('Total ',totals[i],' in ',num_rounds[totals[i]],' rounds:');
{ Find the number of times each score is required. }
for p := 1 to n do begin
c := 0;
j := totals[i];
while j > 0 do begin
if last_score[j] = scores[p] then inc(c);
j := j - last_score[j];
end;
if c > 0 then write( ' ', c, 'x', scores[p] );
end;
writeln;
end;
end;
end;
{ Solution to part 3c.
Remus is playing a game where it is possible to score
1, 4, 5, 17, 28, 43 or 100 each round. At the end of the game the final
score is 100. Furthermore, the scores for each round never got worse,
e.g. if 17 was scored in one round then the score for every future
round was at least 17. How many different ways might this have happened?
To solve this we use a slightly different method. As there is
a score of 1 any score between 1 and 100 is possible; the problem
is to count the number of permutations that reach each total.
We do this using the recursive procedure perms_3c().
}
const scores3c: array[1..7] of integer = ( 1, 4, 5, 17, 28, 43, 100 );
function perms_3c( total, num: integer ): integer;
{ Returns the number of permutations of the first num scores that
sum to total, in strictly increasing order. Calls itself. }
var perms, current: integer;
begin
perms := 0;
current := total;
if total = 0 then
{ There is only one way to reach a total of zero. }
perms_3c := 1
else if num = 1 then
{ There is only one way to reach any total using only 1s. }
perms_3c := 1
else begin
{ Otherwise we count the permutations that finish with zero or
more instances of the last number. }
while current >= 0 do begin
perms := perms + perms_3c( current, num-1 );
current := current - scores3c[num];
end;
perms_3c := perms;
end;
end;
procedure part_3c;
begin
writeln( 'Number of different ways: ', perms_3c( 100, 7 ) );
end;
{ The implementation of this application. }
var opt: integer;
begin
repeat
writeln( 'BIO''99 question 3. Enter one of the following options.' );
writeln( '1 Simple (and often incorrect) greedy solution to part 3a' );
writeln( '2 Test the dynamic programming method' );
writeln( '3 Full, correct dynamic programming solution to part 3a' );
writeln( '4 Solution to part 3c' );
writeln;
writeln( '0 Exit' );
write( '>' );
readln( opt );
case opt of
1: if read_input then solve_greedy;
2: test_dynamic;
3: if read_input then solve_dynamic;
4: part_3c;
end;
writeln;
until opt = 0;
writeln( 'Program finished.' );
end.