{
  CEOI 2003 - Münster, Germany

  Task: Pearls
  Desc: Secret Library, to be used during evaluation (secret tests)
  Author: Tobias Thierer <ceoi@tobias-thierer.de>
}

unit pearls_lib;

interface
  function getNext:Integer;
  procedure setNext(d:Integer);
  procedure finish;

implementation

  { ==================================================================== }
  { == private functions that are not published through the interface == }
  { ==================================================================== }

  const inname     = 'pearls.in';
        outname    = 'pearls.out';
        MAX_PEARLS = 1000;
        MAX_DWARFS = 1000;
        MAX_LIST_LENGTH = 20;
        assertions = true;

        LIBERROR = 1254;  { internal error or contestant error }
        LIBPROT  = 1324;  { protocol of the calls that were executed }
        LIBEND   = 1425;  { final messages }
        LIBINTERNALERROR = 4352;
        LIBGREENHAVEWON = 7136;

  type dwarfsRange = 1..MAX_DWARFS;
       pearlColor = (black, white);

  var numPearls      : Integer; { length of the necklace, 1 <= numPearls <= 1000 }
      numDwarfs      : Integer;
      currDwarf,
      firstDwarf     : Integer;
      necklace       : array[1..MAX_PEARLS] of pearlColor;
      listLength     : array[pearlColor, dwarfsRange] of Integer; { lengths of white and black lists }
      list           : array[pearlColor, dwarfsRange, 1..MAX_LIST_LENGTH] of Integer;
      isGreenDwarf   : array[dwarfsRange] of Boolean;
      { canWin[i,j]  : will the people of dwarf i get the diamond if he gets the necklace in step #j? }
      canWin         : array[dwarfsRange, 1..MAX_PEARLS] of Boolean;
      bestMove       : array[dwarfsRange, 1..MAX_PEARLS] of Integer; { best dwarf to hand the necklace to }
      pearlNum       : Integer;
      libChecksum    : Integer;
      outf           : Text;
      LIBinitialized : Boolean;

  { ----------------------------------------------------------------------- }

  function intToString(i:Integer):String;
  var s : String;
  begin str(i,s); intToString := s; end;

  procedure libReport(code:Integer; msg:String);
  begin
    if (code=LIBINTERNALERROR) then msg := 'INTERNAL ERROR: ' + msg; ;
    writeln(outf, code,' ',msg);
    if (code = LIBERROR) or (code=LIBINTERNALERROR) or (code = LIBEND)
      then begin close(outf); halt(0); end;
  end;

  procedure assert(b:Boolean; msg:String);
  begin
    if assertions and (not b)
       then libReport(LIBINTERNALERROR, 'Assertion failed: ' + msg);
  end;

  procedure checkWins;
  var actDwarf, nextDwarf : Integer;
      necklaceIdx, i      : Integer;
      actPearlColor       : pearlColor;
      sameTribe : Boolean;
  begin
    for actDwarf:=1 to numDwarfs do begin
      canWin[actDwarf, numPearls] := true;
      { doesn't really matter, never read except in an assertion: }
      bestMove[actDwarf, numPearls] := -1;
    end;
    for necklaceIdx := numPearls-1 downto 1 do begin
      actPearlColor := necklace[necklaceIdx];
      for actDwarf := 1 to numDwarfs do begin
        canWin[actDwarf, necklaceIdx] := false;
        bestMove[actDwarf, necklaceIdx] := list[actPearlColor, actDwarf, 1];

        for i := 1 to listLength[actPearlColor, actDwarf] do begin
          nextDwarf := list[actPearlColor, actDwarf, i];
          sameTribe := (isGreenDwarf[actDwarf] = isGreenDwarf[nextDwarf]);

          if (   (sameTribe and (canWin[nextDwarf, necklaceIdx+1]))
              or ((not sameTribe) and (not canWin[nextDwarf, necklaceIdx+1])))
          then begin
            canWin[actDwarf, necklaceIdx] := true;
            bestMove[actDwarf, necklaceIdx] := nextDwarf;
            break;
          end;
        end;
      end;
    end;
  end;

  procedure readData;
  var actPearl, actDwarf, i: Integer;
      ch    : Char;
      color : pearlColor;
      inf   : text;
  begin
    {$i-}
    assign(inf, inname);
    reset(inf);
    {$i+}
    if ioresult <> 0 then LIBreport(LIBINTERNALERROR,'could not open input file');
    readln(inf, numPearls, numDwarfs, firstDwarf);
    libChecksum := numPearls + numDwarfs - firstDwarf; // FIXME: Overflow?
    for actPearl:=1 to numPearls-1 do begin
      read(inf, ch);
      assert((ch = 'B') or (ch='W'), 'pearl neither [B]lack nor [W]hite.');
      if (ch='B') then necklace[actPearl] := black else necklace[actPearl] := white;
    end;
    readln(inf, ch); { 'D', diamond }
    assert(ch='D', 'diamond expected at end of necklace');
    for actDwarf:=1 to numDwarfs do begin
      read(inf, i);
      isGreenDwarf[actDwarf] := (i=0);
      for color:=black to white do begin
        read(inf, listLength[color,actDwarf]);
        assert(listLength[color, actDwarf] <= numDwarfs, 'White or black list of dwarf '+intToString(actDwarf)+' is too long.');
        for i:=1 to listLength[color,actDwarf] do read(inf, list[color,actDwarf,i]);
      end;
      readln(inf);
    end;
    close(inf);
  end;

  procedure init;
  begin
    if LIBinitialized then exit;
    LIBinitialized := true;
    pearlNum := 1;
    readData;
    currDwarf := firstDwarf;
    assign(outf, outname);
    rewrite(outf);
    checkWins;
    LIBreport(LIBPROT, 'init()');
  end;

  { ==================================================================== }
  { ===== public functions that are published through the interface ==== }
  { ==================================================================== }

  function getNext:Integer;
  begin
    // init;
    if pearlNum >= numPearls then LIBreport(LIBERROR,
        'too many calls to getNext()/setNext()');
    if isGreenDwarf[currDwarf] then LIBreport(LIBERROR,
       'called getNext() but ' + intToString(currDwarf)+' is a green dwarf');
    if not isGreenDwarf[currDwarf] then begin
      currDwarf := bestMove[currDwarf, pearlNum];
      assert((currDwarf >= 1) and (currDwarf <= numDwarfs),
             ' illegal dwarf number generated.');
    end;
    LIBreport(LIBPROT,'getNext() -> ' + intToString(currDwarf));
    inc(pearlNum);
    getNext:=currDwarf;
  end;


  procedure setNext(d:Integer);
  var found:Boolean;
      i,len:Integer;
      currColor:pearlColor;
  begin
    // init;
    LIBreport(LIBPROT,'setNext(' + intToString(d) +')');
    if pearlNum >= numPearls then LIBreport(LIBERROR,'too many calls to getNext()/setNext()');
    if not isGreenDwarf[currDwarf] then LIBreport(LIBERROR, 'called setNext() but ' + intToString(currDwarf)+' is a red dwarf');
    currColor := necklace[pearlNum];
    found := false;
    len := listLength[currColor, currDwarf];
    for i:=1 to len do if list[currColor, currDwarf, i] = d then found := true;
    if not found
     then LIBreport(LIBERROR,
          'no dwarf with number ' + intToString(d) + ' in list of dwarf '+intToString(currDwarf));
    currDwarf := d;
    inc(pearlNum);
  end;

  procedure finish;
  begin
    // init;
    LIBreport(LIBPROT, 'finish()');
    if (pearlNum <> numPearls) then LIBreport(LIBERROR, 'called finish() but end of game is not reached');
    if isGreenDwarf[currDwarf]
     then LIBreport(LIBEND, 'green dwarfs have won ' + intToString(LIBchecksum+LIBGREENHAVEWON))
     else LIBreport(LIBEND, 'red dwarfs have won ' + intToString(LIBchecksum));
  end;

begin
  LIBinitialized := false;
  init;
end.

