aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

31
Task/15-puzzle-solver/Pascal/15-puzzle-solver-1.pas Normal file
View file

@ -0,0 +1,31 @@
unit FifteenSolverT;
\\ Solve 15 Puzzle. Nigel Galloway; February 1st., 2019.
interface
type TN=record n:UInt64; i,g,e,l:shortint; end;
type TG=record found:boolean; path:array[0..99] of TN; end;
function solve15(const board : UInt64; const bPos:shortint; const d:shortint; const ng:shortint):TG;
const endPos:UInt64=$123456789abcdef0;
implementation
const N:array[0..15] of shortint=(3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3);
const I:array[0..15] of shortint=(3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2);
const G:array[0..15] of shortint=(5,13,13,9,7,15,15,11,7,15,15,11,6,14,14,10);
const E:array[0..15] of shortint=(0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4);
const L:array[0..4 ] of shortint=(0,11,19,14,16);
function solve15(const board:UInt64; const bPos:shortint; const d:shortint; const ng:shortint):TG;
var path:TG; P:^TN; Q:^TN; _g:shortint; _n:UInt64;
begin P:=@path.path; P^.n:=board; P^.i:=0; P^.g:=0; P^.e:=ng; P^.l:=bPos;
while true do begin
if P<@path.path then begin path.found:=false; exit(path); end;
if P^.n=endPos then begin path.found:=true; exit(path); end;
if (P^.e=0) or (P^.i>d) then begin P-=1; continue; end else begin Q:=P+1; Q^.g:=E[P^.e]; end;
Q^.i:=P^.i; _g:=(L[Q^.g]-P^.l)*4; _n:=P^.n and (UInt64($F)<<_g);
case Q^.g of
1:begin Q^.l:=P^.l+4; Q^.e:=G[Q^.l]-2; P^.e-=1; Q^.n:=P^.n-_n+(_n<<16); if N[_n>>_g]>=(Q^.l div 4) then Q^.i+=1; end;
2:begin Q^.l:=P^.l-4; Q^.e:=G[Q^.l]-1; P^.e-=2; Q^.n:=P^.n-_n+(_n>>16); if N[_n>>_g]<=(Q^.l div 4) then Q^.i+=1; end;
3:begin Q^.l:=P^.l+1; Q^.e:=G[Q^.l]-8; P^.e-=4; Q^.n:=P^.n-_n+(_n<< 4); if I[_n>>_g]>=(Q^.l mod 4) then Q^.i+=1; end;
4:begin Q^.l:=P^.l-1; Q^.e:=G[Q^.l]-4; P^.e-=8; Q^.n:=P^.n-_n+(_n>> 4); if I[_n>>_g]<=(Q^.l mod 4) then Q^.i+=1; end;
end;
P+=1;
end;
end;
end.

31
Task/15-puzzle-solver/Pascal/15-puzzle-solver-2.pas Normal file
View file

@ -0,0 +1,31 @@
// Threaded use of 15 solver Unit. Nigel Galloway; February 1st., 2019.
program testFifteenSolver;
uses {$IFDEF UNIX}cthreads,{$ENDIF}sysutils,strutils,FifteenSolverT;
var Tz:array[0..5] of TThreadID; Tr:array[0..5] of TG; Tc:array[0..5] of shortint; Tw:array[0..5] of shortint;
const N:array[0..4 ] of string=('','d','u','r','l');
const G:array[0..15] of string=('41','841','841','81','421','8421','8421','821','421','8421','8421','821','42','842','842','82');
var ip:string; x,y:UInt64; P,Q:^TN; bPos,v,w,z,f:shortint; time1, time2: TDateTime; c:char;
function T(a:pointer):ptrint;
begin
Tr[uint32(a)]:=solve15(x,bPos,Tw[uint32(a)],Tc[uint32(a)]);
if Tr[uint32(a)].found then f:=uint32(a);
T:=0;
end;
begin
ReadLn(ip);
bPos:=Npos('0',ip,1)-1; w:=0; z:=0; f:=-1;
y:=(UInt64(Hex2Dec(ip[9..17]))<<32)>>32; x:=UInt64(Hex2Dec(ip[1..8]))<<32+y;
time1:=Now;
for w:=0 to $7f do begin
for c in G[bpos] do begin v:=z mod 6; Tc[v]:=integer(c)-48; Tw[v]:=w;
Tz[v]:=BeginThread(@T,pointer(v));
z+=1; if z>5 then waitforthreadterminate(Tz[z mod 6],$7fff);
end;
if f>=0 then break;
end;
for bpos:=0 to 5 do if Tw[bpos]>=Tw[f] then killthread(Tz[bpos]) else waitforthreadterminate(Tz[bpos],$7fff);
time2:=Now; WriteLn('Solution(s) found in ' + FormatDateTime('hh.mm.ss.zzz', time2-time1) + ' seconds');
for bpos:=0 to 5 do if Tr[bpos].found then begin
P:=@Tr[bpos].path; repeat Q:=P; Write(N[Q^.g]); P+=1; until Q^.n=endpos; WriteLn();
end;
end.