solver.pas

3x3智慧拼盘计算机游戏源码,借花献佛了

unit solver;

{*
 * Based on The Apache Software License, Version 1.1
 *
 *
 * Copyright (c) 2001 X-Watch Software, Sven K黱zler.  All rights
 * reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 *
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in
 *    the documentation and/or other materials provided with the
 *    distribution.
 *
 * 3. The end-user documentation included with the redistribution,
 *    if any, must include the following acknowledgment:
 *       "This product includes software developed by
 *        X-Watch Software (http://www.xwatch.de/)."
 *    Alternately, this acknowledgment may appear in the software itself,
 *    if and wherever such third-party acknowledgments normally appear.
 *
 * 4. The names "Slider" and "X-Watch" must
 *    not be used to endorse or promote products derived from this
 *    software without prior written permission. For written
 *    permission, please contact [e-mail].
 *
 * 5. Products derived from this software may not be called "Slider",
 *    nor may "Slider" appear in their name, without prior written
 *    permission of X-Watch Software.
 *
 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED.  IN NO EVENT SHALL X-WATCH SOFTWARE OR
 * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 * ====================================================================
 *}

interface

uses Classes, moves, StdCtrls;

Type
  TSolveFound=(sfYes,sfNo,sfBreak);
TSolver = Class(TThread)
Private
   fStart: TMove;
   pos, old:TLIst;
   fsolveFound:TSolveFound;
   fUpdate: Boolean;
   solveSteps: TList;
   fEvalLabel,fOpenLabel: TLabel;
   Function sortin(m: TMove):Boolean;
   Function findMove(id: LongInt): TMove;
   Procedure SetStart(val: TMove);
Protected
   procedure Execute; override;
   Procedure Solve;
   Procedure Update;
Public
   Constructor Create;
   Destructor Destroy;override;
   Property Terminated;
   Property Start: TMove write SetStart;
   Property Found: TSolveFound read fsolveFound;
   Property Steps: TList Read solveSteps;
   Property EvalLabel: TLabel write fEvalLabel;
   Property OpenLabel: TLabel write fOpenLabel;
   Property DoInfo: Boolean read fUpdate write fUpdate;
end;
implementation

uses SysUtils,Forms;

Constructor TSolver.Create;
var board: TBoard;
    i: Integer;
Begin
     Inherited Create(True);
     solveSteps:=TList.Create;
     for I:=0 To 8 Do board[i]:=(i+1) Mod 9;
     fStart:=nil;
End;

Destructor TSolver.Destroy;
Begin
    fsolveFound:=sfNo;
    while solveSteps.Count>0 do
    Begin
         TMove(solveSteps.First).Free;
         solveSteps.Delete(0);
    End;
    Inherited Destroy;
End;

Procedure TSolver.Solve;
var move, nextMove: TMove;
    i,mvCount: Integer;
    solveImpossible: Boolean;
Begin
     fsolveFound:=sfNo;
     if Not Assigned(fStart) then exit;
     pos:=TList.Create;
     old:=TList.Create;
     pos.Add(fStart);

     solveImpossible:=False;

     while (pos.Count>0) and not solveImpossible and not (TMove(Pos.First).isSolve) and not Terminated Do
     Begin
          Application.ProcessMessages;
          move:=Pos.First;
          Pos.Delete(0);
          old.Add(move);
          mvCount:=move.NextCount;
          For i:=0 to mvCount-1 do
          Begin
               nextMove:=move.GetNext(i);
               sortin(nextMove);
               if nextMove.GetID=123456870 Then solveImpossible:=True;
          End;
          if fUpdate Then Synchronize(Update);
     End;

     If Terminated Then
     Begin
          fsolveFound:=sfBreak;
          Exit;
     End;

     If(pos.Count>0) And not solveImpossible Then
     Begin
       fsolveFound:=sfYes;
       move:=pos.First;
       pos.remove(move);
       SolveSteps.Add(move);
       while Assigned(move.Predecessor) Do
       Begin
            move:=move.Predecessor;
            if Assigned(move.Predecessor) Then
              SolveSteps.Insert(0,TMove.Create(move.Board));

       End;
     End;

     while(pos.Count>0) Do
     Begin
       TMove(Pos.First).Free;
       pos.Delete(0);
     End;

     while(old.Count>0) Do
     Begin
       TMove(old.First).Free;
       old.Delete(0);
     End;

     pos.Free;
     old.Free;
End;

Function TSolver.sortin(m: TMove): Boolean;
var tm: TMove;
    i,value: Integer;
    inserted: boolean;
Begin
     tm:=findMove(m.GetID);
     if Assigned(tm) Then
     Begin
       If (tm.Tiefe<=m.Tiefe) Then
       Begin
          Result:=False;
          Exit;
       End Else pos.Remove(tm);
     End;

     value:=m.Tiefe+m.Distance;
     inserted:=False;

     if(pos.Count>0) Then
     For i:=0 To pos.Count-1 Do
     Begin
          tm:=pos.Items[i];
          if value<tm.Tiefe+tm.Distance Then
          Begin
               pos.Insert(i,m);
               inserted:=True;
               break;
          End;
     End;

     if Not inserted Then pos.Add(m);
     Result:=True;

End;

Function TSolver.findMove(id: LongInt): TMove;
var i:INteger;
Begin
   Result:=NIL;
   If pos.Count>0 Then
     For i:=0 To pos.Count-1 Do
        if TMove(pos.Items[i]).GetID=id Then
        Begin
          Result:=pos.Items[i];
          break;
        End;

   If old.Count>0 Then
     For i:=0 To old.Count-1 Do
       if TMove(old.Items[i]).GetID=id Then
        Begin
          Result:=old.Items[i];
          break;
        End
End;
Procedure TSolver.SetStart(val: TMove);
Begin
     fStart.Free;
     fStart:=TMove.Create(val.Board);
End;

Procedure TSolver.Execute;
Begin
     Solve;
End;

Procedure TSolver.Update;
Begin
     fOpenLabel.Caption:=IntToStr(Pos.Count);
     fEvalLabel.Caption:=IntToStr(Old.Count);
End;

end.