先制 hello, world - FreePascal での解答

HeWo.dpr

{
2015/09/30 検証用プログラム修正

CodeIQ で出題された「先制 hello, world」の僕の解答と、ちょっとだけ解説です。
特設ページ http://nabetani.sakura.ne.jp/codeiq/prehewo/index.html

僕が提出したコードは下記（先頭に空白アリ）

 {'4#()3.}BEGIN WRITE(LOWERCASE('PREEMPTIVE '#34'HELLO'#44' WORLD'#34))END.

Pascal では大文字小文字が区別されないことを使って、全部大文字で記述しました。
関数名とかを小文字にしないと行けない言語の方が多そうだったので。
あと、かち当たると厄介な以下の記号はアスキーコードに。

" → #34
, → #44

空白や数字 (), # ' は先頭の防御コードに記述しました。
Pascal では . は絶対に省略できないので、逆に攻撃コードとして配置。
これは、BF や A.B みたいな書き方をする相手への攻撃のつもりだったけど、
BF には意味なくて全部負けた模様…

で、これを下記の様なプログラムを作って
古今東西から集めてきた Hello, Wolrd を表示するコードと対戦させて
防御コードを練りました。

target.txt の中身は、こんな感じ（先頭行が自分のコード）
------------------------------------
 {'4#()3.}BEGIN WRITE(LOWERCASE('PREEMPTIVE '#34'HELLO'#44' WORLD'#34))END.
extern"C"int puts(...);main(){puts("preemptive \"hello, world\"");}
preemptive "hello, world"
print 'preemptive "hello, world"'
：
：
------------------------------------
}

program Project1;

{$APPTYPE CONSOLE}

uses
  System.SysUtils
  , System.Classes
  , System.Math
  ;

const
  TARGET_FILE = 'D:\Temp\target.txt'; // １行目は自分のコード

type
  TBooleanArray = array of Boolean;

var
  Targets: TStringList;
  MyCode: String;
  MyCodeLen: Integer;
  Line: String;
  A, C: Char;
  i, j: Integer;
  ALen: Integer;
  AKilled: TBooleanArray;
  CKilled: TBooleanArray;
  ABK, CBK: Boolean;
  AK, CK: Integer;
  Score: Int64;
  Win, Lose, Draw: Integer;
  LoseChars: String;
  CLoseChars: String;
  Counter: array [#$20..#$7e] of Integer;

procedure SetZero(var iKilled: TBooleanArray; const iLen: Integer);
begin
  SetLength(iKilled, iLen);
  FillChar(PChar(@iKilled[0])^, iLen, #0);
end;

function Check(
  const iChar: Char;
  const iTarget: String;
  const iKilled: TBooleanArray;
  const iLoseChars: PString): Integer;
var
  i: Integer;
begin
  Result := 0;

  for i := 0 to iTarget.Length - 1 do
    if (iChar = iTarget.Chars[i]) and (not iKilled[i]) then
    begin
      iKilled[i] := True;
      Inc(Result);

      if (iLoseChars <> nil) then
        iLoseChars^ := iLoseChars^ + iChar;
    end;
end;

begin
  Score := 0;
  Win := 0;
  Lose := 0;
  Draw := 0;

  Targets := TStringList.Create;
  try
    Targets.LoadFromFile(TARGET_FILE);

    MyCode := Targets[0];
    MyCodeLen := MyCode.Length;

    FillChar(Counter, Length(Counter), #0);

    for C in MyCode do
      Inc(Counter[C]);

    for i := 50 downto 2 do
      for C := Low(Counter) to High(Counter) do
      begin
        if (Counter[C] = i) then
          Writeln(C, ': ', Counter[C]:2);
      end;
    Writeln;

    for i := 1 to Targets.Count - 1 do
    begin
      Line := Targets[i];

      if (Line.IsEmpty) then
        Continue;

      ALen := Line.Length;

      SetZero(AKilled, MyCodeLen);
      SetZero(CKilled, ALen);

      AK := 0;
      CK := 0;

      LoseChars := '';
      CLoseChars := '';

      for j := 0 to Min(ALen, MyCodeLen) - 1 do
      begin
        A := Line.Chars[j];
        C := MyCode.Chars[j];

        ABK := not AKilled[j];
        CBK := not CKilled[j];

        if (CBK) then
          Inc(AK, Check(A, MyCode, AKilled, @LoseChars));

        if (ABK) then
          Inc(CK, Check(C, Line, CKilled, @CLoseChars));
      end;

      if (AK = CK) then
      begin
        Inc(Draw);
        Inc(Score, 10001);
      end
      else
      begin
        if (AK > CK) then
        begin
          Inc(Lose);
          Writeln('==========================================================');
          Writeln(i:3, '  ', Line.Substring(0, 60));
          Writeln('LOSE: ', AK, ' / ', CK);
          Writeln('Me ', LoseChars);
          Writeln('En ', CLoseChars);
          Writeln;
        end
        else
        begin
          Inc(Win);
          Inc(Score, 30010);
        end;
      end;
    end;
  finally
    Targets.DisposeOf;
  end;

  Writeln('==========================================================');
  Writeln;
  Writeln('Win: ', Win);
  Writeln('Draw: ', Draw);
  Writeln('Lose: ', Lose);
  Writeln;
  Writeln('Score = ', Score);

  Readln;
end.