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.