//TODO: solvable vor jedem viertel
unit logic;

{$mode objfpc}{$H+}
//{$define debug}
interface

uses
  Classes, SysUtils,windows;
type
  trilean=(triUnset, tri0, tri1); //wie boolean für ein Feld
const
  TRI_NOT:array[trilean] of trilean=(triUnset,tri1,tri0); //not-Operator
type
  { TBidoku }
  //Speichert das Ergebnis einer Lösungssuche
  TSolveResult=record
    solved: boolean;       //Wurde es gelöst
    solutioncount: longint;//Zahl der Lösungen
    solutions:TFPList;     //Alle Lösungen, nil, wenn nur eine gesucht wurde
  end;
  PSolveResult=^tsolveResult;

  //Ist das Bidoku unvollständig, gelöst oder fehlerhaft?
  TSolveStatus=(ssPartly,ssSolved,ssWrong);
  //Die Art wie ein Feld belegt wurde
  TSolutionMethod=(smUnknown,smUser, //unbekannt; vom Benutzer;
                   smFixed,          //gar nicht, sondern vorgegeben;
                   smBacktracking1,  //durch Raten, es gibt nur eine Möglichkeit
                   smBacktracking2,  //durch Raten, es gibt zwei Möglichkeiten
                   smLogicTrivial,   //durch vervollständigen einer Reihe/Quadrat
                   smLogicCombined); //Durch den Schnitt einer Reihe mit Quadrat

const
  //Lösungen durch Raten
  BACKTRACKING_SOLUTION=[smBacktracking1,smBacktracking2];
  //Logische Lösung
  LOGICAL_SOLUTION=[smLogicTrivial,smLogicCombined];
  //Eindeutige Lösung
  UNIQUE_SOLUTION=[smBacktracking1,smLogicTrivial,smLogicCombined];
  //Eindeutiges Feld (eindeutig gelöst, oder vorgegeben)
  UNIQUE_FIELD=UNIQUE_SOLUTION + [smFixed];
type
  TDifficulty=(dEasy,dNormal,dHard); //Schwierigkeitsgrad
  
  //Liste von Feldern, die eine Gruppe bilden
  TPositionGroup=array of record
    u,v: longint;    //Feldkoordinate
    negate: boolean; //Wert der umgekehrte Basiswert
  end;
  TPositionsArray=array of TPositionGroup;

  TBidoku=class
  private
    changed: boolean;  //wird bei Änderungen auf true gesetzt
    n,maxcount:longint;//Größe des Bidokus und Anzahl der Felder einer Zahl
    
    //Bidokufeld
    data:array of array of trilean;
    //Anzahl der gefüllten Felder pro Reihe und Zahl
    rows,cols:array of array[trilean] of longint;
    //Anzahl der gefüllten Felder pro Quadrat und Zahl
    quadrates: array of array of array[trilean] of longint;
    //Lösungsmethode für ein Feld
    solutionMethod: array of array of TSolutionMethod;

    //Liefert eine Zahl, die die Schwierigkeit angibt zurück
    function rateDifficulty: longint;
    //Zählt Symmetriefehler
    function symmetricErrors(const pos:TPositionsArray):longint;
    
    //Löst das Rätsel und gibt die Anzahl der gefundenen Lösungen zurück
    //allSolutions: sollen alle Lösungen gefunden werden
    //deep: Rekursionstiefe
    //solutions: Speichert die Lösungen (kann nil sein)
    //Ist allSolutions=false, wird die Lösung im Bidoku selbst gespeichert
    function _solve(allSolutions: boolean;deep:longint;solutions:TFPList):longint;

    //Setzt das Feld x,y auf den Wert c und speichert dafür die Lösungsmethode
    //rows,cols und fields werden auch entsprechend angepasst
    procedure put(x,y:longint; c: trilean; method: TSolutionMethod);
    //Setzt nur leere Felder
    procedure tryput(x,y:longint; c: trilean; method: TSolutionMethod);inline;
  public
    //Wie oben, nur gilt hier immer method=smUser
    procedure put(x,y:longint; c: trilean);inline;
    procedure tryput(x,y:longint; c: trilean);inline;
    //Gibt den Wert eines Feldes zurück
    function get(x,y:longint): trilean;inline;
    //Gibt die Lösungsmethode für ein Feld zurück
    function getSolutionMethod(x,y:longint):TSolutionMethod;inline;
  
    //Erzeugt leers ein Bidoku. asize ist die Zahl der Quadrate pro Reihe
    //und die Zahl der Felder in einer Reihe eines Quadrates
    constructor create(asize:longint=4);
    destructor destroy();override; //Löscht das Bidoku
    function clone(): TBidoku;     //Kopiert das Bidoku
    //Berechnet ein Bidoku mit bestimmter Schwierigkeit und Muster
    procedure generate(difficulty: TDifficulty;
                       positions: TPositionsArray);
    //Minimiert das Bidoku
    procedure minimize;

    //Lösung mittels einfacher logischer Regeln
    procedure logicalSolve();
    //Löst das Bidoku vollständig
    function solve(allSolutions,list: boolean):TSolveResult;
    //Überprüft, ob es eine Lösung gibt, indem das Rätsel geklont und gelöst wird
    function isSolvable():boolean;
    //Gibt den Lösungsstatus (noch nicht, gelöst, fehlerhaft) zurück
    function solved(): TSolveStatus;

    function toString():string;         //Wandelt das Bidoku in einen String um
    procedure saveToFile(fn: string);   //Speichert es
    procedure loadFromFile(fn: string); //Lädt es
    
    //Erzeugt eine horizontale/vertikale Spiegelung um die Bidokumitte
    function makeMirrorSymmetryH(invert: boolean):TPositionsArray;
    function makeMirrorSymmetryV(invert: boolean):TPositionsArray;
    //Erzeugt eine horizontale/vertikale Spiegelung um die Mitte der einen und
    //der anderen Hälft des Bidokus
    function makeMirrorSymmetrySubH(invert: boolean):TPositionsArray;
    function makeMirrorSymmetrySubV(invert: boolean):TPositionsArray;
    //Verbindet zwei Symmetrien
    function mergeSymmetry(a,b:TPositionsArray):TPositionsArray;
    
    property size: longint read n;
  end;

  { TBidoku }
const MAX_SOLUTIONS=10000; //Maximale Anzahl von Lösungen
implementation

{ TBidoku }

function TBidoku.rateDifficulty: longint;
var i,j:longint;
begin
  result:=0;
  for i:=0 to high(data) do
    for j:=0 to high(data[i]) do
      case solutionMethod[i,j] of
        smUnknown,smUser: raise exception.create('Fehler');
        smBacktracking1: result+=50;
        smLogicCombined: result+=5;
        smLogicTrivial: result+=1;
      end;
end;

function TBidoku.symmetricErrors(const pos:TPositionsArray):longint;
var i,j,k:longint;
begin
  if not assigned(pos) then result:=0;//length(data)*length(data);
  result:=0;
{  for i:=0 to high(data) do
    for j:=0 to high(data[i]) do
      for k:=0 to high(sym[i,j]) do
        with sym[i,j,k] do
          if (data[u,v]<>data[i,j]) xor Negate then
            result+=1;}
  for i:=0 to high(pos) do
    for j:=0 to high(pos[i]) do
      for k:=0 to high(pos[i]) do
        if (data[pos[i,j].u,pos[i,j].v]<>data[pos[i,k].u,pos[i,k].v]) xor
           (pos[i,j].negate xor pos[i,k].negate) then
            result+=1;

end;

//Löst das Rätsel und gibt die Anzahl der gefundenen Lösungen zurück
//allSolutions: sollen alle Lösungen gefunden werden
//deep: Rekursionstiefe
//solutions: Speichert die Lösungen (kann nil sein)
//Ist allSolutions=false, wird die Lösung im Bidoku selbst gespeichert
function TBidoku._solve(allSolutions: boolean;deep:longint;solutions: TFPList):longint;
var i,k,l,maxR,maxC: longint;
    temp:TBidoku;
    newSolutions,oldCount: longint;
    tri: trilean;
begin
  result:=0;
  //OutputDebugString(pchar(toString()));

  //Logisches Lösen
  logicalSolve;
  //Test auf korrekte Lösung
  case solved() of
    ssWrong: exit(0);
    ssSolved: begin
      if assigned(solutions) then
        solutions.Add(self);
      exit(1);
    end;
  end;
  //Abbruch bei zuvielen Lösungen
  if (solutions<>nil)and (solutions.Count>=MAX_SOLUTIONS)and allSolutions then
    exit;
  //Rest per BF Lösung
  //Auswahl eines Feldes mit maximaler Füllungsdichte
  maxR:=-1;
  for i:=0 to high(rows) do
    if (rows[i][tri0]+rows[i][tri1]<2*maxcount)and ((maxR=-1) or
       (rows[i][tri0]+rows[i][tri1]+deep and 1>rows[maxR][tri0]+rows[maxR][tri1])) then
      maxR:=i;
  assert(maxR>-1,'Keine Zeile vorhanden');

  maxC:=-1;
  for i:=0 to high(data) do
    if (data[i,maxR]=triUnset) and ((maxC=-1) or
          (cols[i][tri0]+cols[i][tri1]+(deep and 2)shr 1>cols[maxC][tri0]+cols[maxC][tri1])) then
      maxC:=i;

  assert(maxC>-1,'Keine Spalte vorhanden');

  if allSolutions and assigned(solutions) then
    oldCount:=solutions.Count;
  for tri:=tri0 to tri1 do begin
    temp:=clone();
    //smBacktracking1 wird im zweiten Durchlauf verwendet, wenn der andere Wert
    //unmöglich ist
    if (tri=tri1) and (result=0) then
      temp.put(maxC,maxR,tri,smBacktracking1)
     else
      temp.put(maxC,maxR,tri,smBacktracking2);
    //Rekursiver Aufruf
    newSolutions:=temp._solve(allSolutions,deep+1,solutions);
    //Lösungen verarbeiten
    if newSolutions>0 then begin
      result+=newSolutions;  //Zahl speichern
      if not allSolutions then begin
        //Bei einer Einzellösung alle Werte in self speichern
        for k:=0 to high(data) do
          for l:=0 to high(data[k]) do begin
            if (solutionMethod[k,l]=smUnknown) then
              put(k,l,temp.data[k,l],temp.solutionMethod[k,l])
             else
              put(k,l,temp.data[k,l],solutionMethod[k,l]);
           end;
        //und zufrieden beenden
        temp.free;
        exit;
      end else if (solutions=nil) or (solutions.count=0)
                  or (solutions.Last<>pointer(temp))  then
        temp.free; //Nur freigeben, wenn nicht in der Liste
    end else begin
      //Bei einer unmöglichen zweiten Lösung (bei der ersten läuft die Schleife
      //nicht) alle Lösungswege auf smBacktracking1 setzen
      if allSolutions and assigned(solutions) then
        for i:=oldCount to solutions.count-1 do
          TBidoku(solutions[i]).solutionMethod[maxC,maxR]:=smBacktracking1;

      temp.free;
    end;
  end;
end;

procedure TBidoku.put(x, y: longint; c: trilean; method: TSolutionMethod);
begin
  if solutionMethod<>nil then solutionMethod[x,y]:=method ;
  if data[x,y]=c then exit;

  cols[x,data[x,y]]-=1;
  rows[y,data[x,y]]-=1;
  quadrates[x div n,y div n,data[x,y]]-=1;

  data[x,y]:=c;
  cols[x,c]+=1;
  rows[y,c]+=1;
  quadrates[x div n,y div n,c]+=1;
  changed:=true;
end;

procedure TBidoku.tryput(x, y: longint; c: trilean; method: TSolutionMethod);
begin
  if data[x,y]=triUnset then put(x,y,c,method);
end;

procedure TBidoku.tryput(x, y: longint; c: trilean); inline;
begin
  if data[x,y]=triUnset then put(x,y,c);
end;

procedure TBidoku.put(x, y: longint; c: trilean); //inline;
begin
  put(x,y,c,smUser);
end;

function TBidoku.get(x, y: longint): trilean;inline;
begin
  exit(data[x,y]);
end;

function TBidoku.getSolutionMethod(x, y: longint): TSolutionMethod; inline;
begin
  result:=solutionMethod[x,y];
end;

//Alle Spalte, Zeilen, Quadrate enthalten genau maxcount Zahlen von jeder Sorte
function TBidoku.solved():TSolveStatus;
var count: array[trilean] of longint;
    i,j,fi,fj:longint; //fi,fj: Feld
begin
  result:=ssSolved;
  for i:=0 to high(data) do begin
    //column
    FillChar(count,sizeof(count),0);
    for j:=0 to high(data) do
      inc(count[data[i,j]]);
    if (count[tri1]>maxcount) or (count[tri0]>maxcount) then exit(ssWrong);
    if (count[tri1]<maxcount) or (count[tri0]<maxcount) then result:=ssPartly;
    //row
    FillChar(count,sizeof(count),0);
    for j:=0 to high(data) do
      inc(count[data[j,i]]);
    if (count[tri1]>maxcount) or (count[tri0]>maxcount) then exit(ssWrong);
    if (count[tri1]<maxcount) or (count[tri0]<maxcount) then result:=ssPartly;
  end;
  //field
  for i:=0 to n-1 do
    for j:=0 to n-1 do begin
      FillChar(count,sizeof(count),0);
      for fi:=n*i to n*i +n-1 do
        for fj:=n*j to n*j +n-1 do
          inc(count[data[fi,fj]]);
      if (count[tri1]>maxcount) or (count[tri0]>maxcount) then exit(ssWrong);
      if (count[tri1]<maxcount) or (count[tri0]<maxcount) then result:=ssPartly;
    end;
end;

constructor TBidoku.create(asize: longint=4);
var i,j:longint;
begin
  n:=asize;
  SetLength(data,n*n,n*n);
  SetLength(rows,n*n);
  SetLength(cols,n*n);
  SetLength(quadrates,n,n);
  SetLength(solutionMethod,n*n,n*n);;
  maxcount:=n*n div 2;
  changed:=false;
  for i:=0 to high(rows) do begin
    rows[i][triUnset]:=2*maxcount;
    rows[i][tri0]:=0; rows[i][tri1]:=0;
    cols[i][triUnset]:=2*maxcount;
    cols[i][tri0]:=0;
    cols[i][tri1]:=0;
  end;
  for i:=0 to high(quadrates) do
    for j:=0 to high(quadrates[i]) do begin
      quadrates[i,j][triUnset]:=2*maxcount;
      quadrates[i,j][tri0]:=0; quadrates[i,j][tri1]:=0;
    end;
end;

destructor TBidoku.destroy();
begin
  inherited destroy();
end;

function TBidoku.clone(): TBidoku;
begin
  Result:=TBidoku.create();
  Result.n:=n;
  result.maxcount:=maxcount;
  result.changed:=false;
  Result.rows:=rows;
  Result.cols:=cols;
  Result.quadrates:=quadrates;
  Result.data:=data;
  Result.solutionMethod:=solutionMethod;
  SetLength(Result.rows,length(Result.rows));;
  SetLength(Result.cols,length(Result.cols));;
  SetLength(Result.quadrates,length(Result.quadrates),length(Result.quadrates));;
  SetLength(Result.data,length(Result.data),length(Result.data));;
  SetLength(Result.solutionMethod,length(Result.data),length(Result.data));;
end;

//Berechnet ein Bidoku mit bestimmter Schwierigkeit und Muster
procedure TBidoku.generate(difficulty: TDifficulty;positions: TPositionsArray);
var i,j:longint; //Schleifenvariablen
    c,p:longint; //Anzahl verwendeter Gruppen und aktuelle Gruppe
    fieldCount,maxFieldCount: longint; //gefüllte Felder und maximal erwünschte
    fixedTri: boolean;
    diffNr: longint;
    twin,bidoku: TBidoku; //Kopie und neues Bidoku
    solutions: TFPList;   //Liste aller Lösungen
    tri: trilean;         //Grundwert für eine Gruppe

  //Überprüft, ob die Gruppe benutzbar ist
  function freeFields(p:longint;out base: trilean):boolean;
  var i,c:longint;  //Schleifenvariable und Zahl der belegten Felder
  begin
    c:=0;
    base:=triUnset;
    for i:=0 to high(positions[p]) do
      with positions[p,i] do
        if twin.solutionMethod[u,v] in UNIQUE_SOLUTION then begin
          //Feld ist belegt
          if c=0 then begin //Erstes belegtes Feld?
            base:=twin.data[u,v];  //=> Basiswert ermitteln
            if negate then base:=TRI_NOT[base];
          end else if (base=twin.data[u,v]) xor negate then//gleicher Basiswert?
            exit(false); //Wenn nicht => Abbruch
          c+=1;
        end;
    exit(c<length(positions[p]));
  end;
    
begin
  //Initialisieren
  Randomize;
  for i:=0 to high(data) do
    for j:=0 to high(data[i]) do
      put(i,j,triUnset,smFixed);
  if not assigned(positions) then begin
    SetLength(positions,n*n*n*n,1);
    for i:=0 to high(data) do
      for j:=0 to high(data[i]) do
        with positions[n*n*i+j,0] do begin
          u:=i;
          v:=j;
        end;
  end;
  c:=0;
  fieldCount:=0;
  maxFieldCount:=n*n*n*n;
  twin:=clone;
  p:=high(positions);
  //Generieren
  repeat
    //Auswahl einer freien Gruppe
    repeat
      positions[p]:=positions[high(positions)-c];
      p:=random(length(positions)-c);
      fieldCount+=length(positions[p]);
      c+=1;
    until (freeFields(p,tri)) or (c>high(positions));
    fixedTri:=tri<>triUnset;
    if not fixedTri then tri:=trilean(random(2)+1);
    for i:=0 to high(positions[p]) do
      with positions[p,i] do
        if not (twin.solutionMethod[u,v] in UNIQUE_SOLUTION) then begin
          if negate then put(u,v,TRI_NOT[tri], smFixed)
          else put(u,v,tri,smFixed);
        end;
    twin.free;twin:=clone();
    if fieldCount>=n*n*n*n div 4 then
      if twin._solve(false,0,nil) = 0 then begin
        if (fixedTri) or (length(positions[p])=1) then begin
          for i:=0 to high(positions[p]) do
            with positions[p,i] do
              put(u,v,triUnset,smUnknown);
        end else begin
        {  for i:=0 to high(positions[p]) do
            with positions[p,i] do
              if negate then put(u,v,tri, smFixed)
              else put(u,v,TRI_NOT[tri],smFixed);
          twin.free;twin:=clone();           }
          if twin._solve(false,0,nil) = 0 then
            for i:=0 to high(positions[p]) do
              with positions[p,i] do
                put(u,v,triUnset,smUnknown);
        end;
      end;
  until (c>=high(positions)) or (fieldCount>=maxFieldCount);
  
  //saveToFile('T:\temp');
  solutions:=TFPList.Create;
  twin:=clone;
  twin._solve(true,0,solutions);
  assert(solutions.count>0,'Ungültige Lösung generiert');
  j:=0;
  case difficulty of
    dEasy: begin //Minimum
      c:=TBidoku(solutions[0]).rateDifficulty;
      for i:=1 to solutions.count-1 do
        if TBidoku(solutions[i]).rateDifficulty<c then
          c:=TBidoku(solutions[i]).rateDifficulty;
    end;
    dHard: begin //Maximum
      c:=TBidoku(solutions[0]).rateDifficulty;
      for i:=1 to solutions.count-1 do
        if TBidoku(solutions[i]).rateDifficulty>c then
          c:=TBidoku(solutions[i]).rateDifficulty;
    end;
    dNormal: begin
      //Mittelwert suchen
      c:=TBidoku(solutions[0]).rateDifficulty;
      for i:=1 to solutions.count-1 do
        c+=TBidoku(solutions[i]).rateDifficulty;
      c:=c div solutions.count;
    end;
  end;
  diffNr:=abs(TBidoku(solutions[0]).rateDifficulty-c)+
          TBidoku(solutions[0]).symmetricErrors(positions);
  for i:=0 to solutions.count-1 do
    if abs(TBidoku(solutions[i]).rateDifficulty-c)+
          TBidoku(solutions[i]).symmetricErrors(positions)<diffNr then begin
      diffNr:=abs(TBidoku(solutions[i]).rateDifficulty-c)+
              TBidoku(solutions[i]).symmetricErrors(positions);
      j:=i;
    end;
  bidoku:=TBidoku(solutions[j]);
  for i:=0 to high(data) do
    for j:=0 to high(data[i]) do
      if (bidoku.solutionMethod[i,j] = smBacktracking2) or
         ((bidoku.solutionMethod[i,j] = smBacktracking1) and (solutions.count>=MAX_SOLUTIONS)) then
        put(i,j,bidoku.data[i,j],smFixed);

  for i:=0 to solutions.count-1 do
    if TBidoku(solutions[i])<>twin then
      TBidoku(solutions[i]).free;
  solutions.free;
  twin.free;
  
  if difficulty=dHard then minimize;
end;

//Minimiert das Bidoku
procedure TBidoku.minimize;
var i,j:longint;               //Schleifenvariablen
    positions:array of tpoint; //Alle möglichen Feldpositionen
begin
  //Alle möglichen Positionen in ein Array eintragen
  SetLength(positions,n*n*n*n);
  for i:=0 to high(data) do
    for j:=0 to high(data[i]) do begin
      with positions[n*n*i+j] do begin
        x:=i;
        y:=j;
      end;
      //Feste Felder markieren (nur zur Sicherheit, eigentlich unnötig)
      if data[i,j]<>triUnset then
        solutionMethod[i,j]:=smFixed;
    end;
  //Alle Felder in zufälliger Reihenfolge besuchen und dann
  //auf ihre Notwendigkeit überprüfen
  j:=0;
  while j<=high(positions) do begin
    i:=random(length(positions)-j);
    with positions[i] do
      if data[x,y] <> triUnset then begin
        put(x,y,TRI_NOT[data[x,y]],smFixed);
        if isSolvable() then put(x,y,TRI_NOT[data[x,y]],smFixed) //zurücksetzen
        else put(x,y,triUnset,smUnknown);                        //löschen
      end;
    positions[i]:=positions[high(positions)-j];
    j+=1;
  end;
end;



function TBidoku.solve(allSolutions,list: boolean):TSolveResult;
var i,j:longint;
    time: cardinal;



begin
  time:=GetTickCount;
  //OutputDebugString(pchar(toString()));

  //Markiere bekannte Lösungen
  if list then result.solutions:=TFPList.create
  else result.solutions:=nil;
  for i:=0 to high(data) do
     for j:=0 to high(data[i]) do
       if data[i,j]=triUnset then solutionMethod[i,j]:=smUnknown
       else solutionMethod[i,j]:=smFixed;
  result.solutioncount:=_solve(allSolutions,0,result.solutions);
  result.solved:=result.solutioncount>0;
  if (result.solutions<>nil)and(result.solutions.count>0) and
     (Tbidoku(result.solutions[0])=Self) then
    result.solutions[0]:=clone;
  OutputDebugString(pchar(IntToStr(GetTickCount-time))); //TODO
end;

//Überprüft, ob es eine Lösung gibt, indem das Rätsel geklont und gelöst wird
function TBidoku.issolvable(): boolean;
var temp: TBidoku;
begin
  temp:=clone();
  result:=temp._solve(false,0,nil)>0;
  temp.free;
end;

function TBidoku.toString(): string;
var i,j: longint;
begin
  result:='';
  for i:=0 to high(data) do begin
    if i mod n = 0 then begin
      for j:=0 to high(data[i]) do
        if j mod n = 0 then result+='|-'
        else result+='-';
      result+='|'#13#10;
    end;
    for j:=0 to high(data[i]) do begin
      if j mod n = 0 then
        result+='|';
      case data[j,i] of
        triUnset: result+=' ';
        tri0: result+='0';
        tri1: result+='1';
      end;
    end;
    result:=result+'|'#13#10;
  end;
  for j:=0 to high(data[i]) do
    if j mod n = 0 then result+='|-'
    else result+='-';
  result+='|'#13#10;
end;

procedure TBidoku.saveToFile(fn: string);
var f: TFileStream;
    str: string;
begin
  f:=TFileStream.Create(fn,fmCreate);
  str:=toString();
  f.WriteBuffer(str[1],length(str));
  f.free;
end;

procedure TBidoku.loadFromFile(fn: string);
var f: TFileStream;
    str:string;
    p,i,j:longint;
begin
  f:=TFileStream.Create(fn,fmOpenRead);
  SetLength(str,f.Size-1);
  f.ReadBuffer(str[1],length(str));
  f.free;
  //Fehlertolerantes Lesen
  i:=0;
  j:=0;
  for p:=1 to length(str) do
    if str[p] in ['0','1','O','X',' '] then begin
      if str[p] in ['0','O'] then put(j,i,tri0,smFixed)
      else if str[p] in ['1','X'] then put(j,i,tri1,smFixed)
      else put(j,i,triUnset,smFixed);
      j+=1;
      if j>high(data) then begin
        j:=0;
        i+=1;
      end;
    end;
end;

function TBidoku.makeMirrorSymmetryH(invert: boolean): TPositionsArray;
var i,j:longint;
begin
  SetLength(result,length(data)*length(data)div 2,2);
  for i:=0 to high(data) div 2 do
    for j:=0 to high(data) do begin
      with result[i*length(data)+j,0] do begin
        u:=i;
        v:=j;
        negate:=false;
      end;
      with result[i*length(data)+j,1] do begin
        u:=high(data)-i;
        v:=j;
        negate:=invert;
      end;
    end;
end;

function TBidoku.makeMirrorSymmetrySubH(invert: boolean): TPositionsArray;
var i,j:longint;
begin
  SetLength(result,length(data)*length(data)div 2,2);
  for i:=0 to high(data) div 4 do
    for j:=0 to high(data) do begin
      with result[i*length(data)+j,0] do begin
        u:=i;
        v:=j;
        negate:=false;
      end;
      with result[i*length(data)+j,1] do begin
        u:=high(data) div 2-i;
        v:=j;
        negate:=invert;
      end;

      with result[(i+length(data) div 4)*length(data)+j,0] do begin
        u:=i+length(data) div 2;
        v:=j;
        negate:=false;
      end;
      with result[(i+length(data) div 4)*length(data)+j,1] do begin
        u:=high(data)-i;
        v:=j;
        negate:=invert;
      end;
    end;
end;

function TBidoku.makeMirrorSymmetrySubV(invert: boolean): TPositionsArray;
var i,j:longint;
begin
  SetLength(result,length(data)*length(data)div 2,2);
  for i:=0 to high(data) div 4 do
    for j:=0 to high(data) do begin
      with result[i*length(data)+j,0] do begin
        u:=j;
        v:=i;
        negate:=false;
      end;
      with result[i*length(data)+j,1] do begin
        u:=j;
        v:=high(data) div 2-i;
        negate:=invert;
      end;
      
      with result[(i+length(data) div 4)*length(data)+j,0] do begin
        u:=j;
        v:=i+length(data) div 2;
        negate:=false;
      end;
      with result[(i+length(data) div 4)*length(data)+j,1] do begin
        u:=j;
        v:=high(data)-i;
        negate:=invert;
      end;
    end;
end;


function TBidoku.makeMirrorSymmetryV(invert: boolean): TPositionsArray;
var i,j:longint;
begin
  SetLength(result,length(data)*length(data)div 2,2);
  for i:=0 to high(data) div 2 do
    for j:=0 to high(data) do begin
      with result[i*length(data)+j,0] do begin
        u:=j;
        v:=i;
        negate:=false;
      end;
      with result[i*length(data)+j,1] do begin
        u:=j;
        v:=high(data)-i;
        negate:=invert;
      end;
    end;
end;

function TBidoku.mergeSymmetry(a, b: TPositionsArray): TPositionsArray;
  function groupIntersection(const g,h:TPositionGroup;out negate: boolean):boolean;
  var i,j:longint;
  begin
    result:=false;
    for i:=0 to high(g) do
      for j:=0 to high(h) do
        if (h[j].u=g[i].u) and (g[i].v=h[j].v) then begin
          if result then
            assert(g[i].negate=negate,'Symmetrien unpassend')
           else
            negate:=g[i].negate;
          result:=true;
        end;
  end;

  procedure addPositionGroup(var g,h:TPositionGroup;negate: boolean);
  var i,j:longint;
      found:boolean;
  begin
    for j:=0 to high(h) do begin
      found:=false;
      for i:=0 to high(g) do
        if (h[j].u=g[i].u) and (g[i].v=h[j].v) then begin
          found:=true;
          break;
        end;
        if not found then begin
          SetLength(g,length(g)+1);
          g[high(g)]:=h[j];
          if negate then with g[high(g)] do
            negate:=not negate;
        end;
    end;
  end;

var i,j,p:longint;
    negate,groupchanged:boolean;
begin
  if a=nil then exit(b);
  if b=nil then exit(a);
  setlength(result,length(a));
  for i:=0 to high(a) do begin
    setlength(result[i],length(a[i]));
    move(a[i,0],result[i,0],length(a[i])*sizeof(a[i,0]));
    for j:=0 to high(b) do
       if groupIntersection(a[i],b[j],negate) then
         addPositionGroup(result[i],b[j],negate);
  end;
  p:=high(result);
  repeat
    groupchanged:=false;
    for i:=p downto 0 do
      for j:=p downto i+1 do
        if groupIntersection(result[i],result[j],negate) then begin
          addPositionGroup(result[i],result[j],negate);
          result[j]:=result[p];
          p-=1;
          groupchanged:=true;
        end;
  until not groupchanged;
  setlength(result,p+1)
end;


procedure TBidoku.logicalSolve();
var waschanged: boolean;
var i,j,k,l:longint;
    num,num2: trilean;
    count:longint;
begin
  repeat
    waschanged:=false;
    //Vervollständigen von Reihen
    repeat
      num2:=tri1;
      for num:=tri0 to tri1 do begin
        changed:=false;
        for i:=0 to high(cols) do
          if (cols[i][num]=maxcount) and (cols[i][num2]<maxcount) then
            for j:=0 to high(rows) do
              tryPut(i,j,num2,smLogicTrivial);
        for i:=0 to high(rows) do
          if (rows[i][num]=maxcount) and (rows[i][num2]<maxcount) then
            for j:=0 to high(cols) do
              tryPut(j,i,num2,smLogicTrivial);
        for i:=0 to high(quadrates) do
          for j:=0 to high(quadrates[i]) do
            if (quadrates[i][j][num]=maxcount) and (quadrates[i][j][num2]<maxcount) then
              for k:=i*n to i*n+n-1 do
                for l:=j*n to j*n+n-1 do
                  tryPut(k,l,num2,smLogicTrivial);
        num2:=num;
      end;
      waschanged:=waschanged or changed;
    until not changed;
    
    changed:=waschanged;
    
    num2:=tri1;
    for num:=tri0 to tri1 do begin
      //Prüfe, wo nur wenige von einer Sorte eingefügt werden können und deshalb
      //von der anderen Sorte soviele eingefügt werden müssen das ein Bereich voll ist
      //Spalte => bekanntes Quadrat
      for i:=0 to high(cols) do
        if (cols[i][num]>maxcount-n)
            and (cols[i][num]+cols[i][num2]<2*maxcount) then begin
          for j:=0 to high(quadrates[0]) do
            if (quadrates[i div n,j][num2]+n-(maxcount-cols[i][num])>=maxcount) and
               (quadrates[i div n,j][num]+quadrates[i div n,j][num2]<2*maxcount) then begin
              count:=0;
              for k:=j*n to j*n+n-1 do
                if data[i,k]=triUnset then inc(count);
              if (quadrates[i div n,j][num2]+count-(maxcount-cols[i][num])>=maxcount) and
                 (quadrates[i div n,j][num]+quadrates[i div n,j][num2]+count<2*maxcount) then
                for l:=j*n to j*n+n-1 do begin
                  for k:=(i div n)*n to i-1 do
                    tryPut(k,l,num,smLogicCombined);
                  for k:=i+1 to (i div n)*n+n-1 do
                    tryPut(k,l,num,smLogicCombined);
                end;
            end;
        end;


      //Zeile => bekanntes Quadrat
      for i:=0 to high(rows) do
        if (rows[i][num]>maxcount-n)
            and (rows[i][num]+rows[i][num2]<2*maxcount) then begin
          for j:=0 to high(quadrates) do
            if (quadrates[j,i div n][num2]+n-(maxcount-rows[i][num])>=maxcount) and
               (quadrates[j,i div n][num]+quadrates[j,i div n][num2]<2*maxcount) then begin
              count:=0;
              for k:=j*n to j*n+n-1 do
                if data[k,i]=triUnset then inc(count);
              if (quadrates[j,i div n][num2]+count-(maxcount-rows[i][num])>=maxcount)and
                 (quadrates[j,i div n][num]+quadrates[j,i div n][num2]+count<2*maxcount) then
                for l:=j*n to j*n+n-1 do begin
                  for k:=(i div n)*n to i-1 do
                    tryPut(l,k,num,smLogicCombined);
                  for k:=i+1 to (i div n)*n+n-1 do
                    tryPut(l,k,num,smLogicCombined);
                end;
            end;
        end;


      //Fast volle Quadrate
      for i:=0 to high(quadrates) do
        for j:=0 to high(quadrates[0]) do  // i, j bestimmen Quadrat
          if (quadrates[i][j][num]>maxcount-n)
             and (quadrates[i][j][num]+quadrates[i][j][num2]<2*maxcount) then begin

            //Quadrat => bekannte Spalte?
            for k:=i*n to i*n+n-1 do //k bestimmt Spalte
              if (cols[k][num2]+n-(maxcount-quadrates[i][j][num])>=maxcount) and
                 (cols[k][num]+cols[k][num2]<2*maxcount) then begin
                //Anzahl unbekannter Felder in der Schnittmenge Quadrat/Spalte bestimmen
                count:=0;
                for l:=j*n to j*n+n-1 do
                  if data[k,l]=triUnset then inc(count);
                //Spalte füllen, falls nun bekannt
                if (cols[k][num2]+count-(maxcount-quadrates[i][j][num])>=maxcount)and
                 (cols[k][num]+cols[k][num2]+count<2*maxcount) then begin
                  for l:=0 to j*n-1 do
                    tryPut(k,l,num,smLogicCombined);
                  for l:=j*n+n to high(rows) do
                    tryPut(k,l,num,smLogicCombined);
                end;
              end;


            //Quadrat => bekannte Zeile
            for k:=j*n to j*n+n-1 do //k bestimmt Zeile
              if (rows[k][num2]+n-(maxcount-quadrates[i][j][num])>=maxcount) and
                 (rows[k][num]+rows[k][num2]<2*maxcount) then begin
                //Anzahl unbekannter Felder in der Schnittmenge Quadrat/Spalte bestimmen
                count:=0;
                for l:=i*n to i*n+n-1 do
                  if data[l,k]=triUnset then inc(count);
                //Zeile füllen, falls nun bekannt
                if (rows[k][num2]+count-(maxcount-quadrates[i][j][num])>=maxcount) and
                   (rows[k][num]+rows[k][num2]+count<2*maxcount) then begin
                  for l:=0 to i*n-1 do
                    tryPut(l,k,num,smLogicCombined);
                  for l:=i*n+n to high(rows) do
                    tryPut(l,k,num,smLogicCombined);
                end;
              end;
          end;


      num2:=num;
    end;
  until not changed;
end;
end.

