SetDirectory[NotebookDirectory[]];
$HistoryLength=1;

poss=Outer[List,Range[7],Range[7]];
poss[[{1,7}]]=poss[[{1,7},3;;5]];
poss[[{2,6}]]=poss[[{2,6},2;;6]];
poss//=Catenate;
poss=SortBy[poss,{Last,First}];
len=Length[poss]
Graphics[{Disk[#,0.1]&/@poss,Dashed,Arrow@poss}]


borders={{#+{-1/2,-1/2},#+{-1/2,1/2}},{#+{1/2,-1/2},#+{1/2,1/2}},{#+{-1/2,1/2},#+{1/2,1/2}},{#+{-1/2,-1/2},#+{1/2,-1/2}}}&/@poss;
borders//=Catenate;
borders//=Gather/*Select[Length/*EqualTo[1]]/*Map[First];

ClearAll[VisualizeState]
VisualizeState[state_Integer,poss_List]:=Module[{id,r=0.15},
id=IntegerDigits[state,2,Length[poss]];
Graphics[{
{Black,Line[borders]},
{EdgeForm[],FaceForm[GrayLevel[0.35]],Disk[#,r]&/@Pick[poss,id,1]},
{EdgeForm[{GrayLevel[0.2],AbsoluteThickness[2]}],FaceForm[],Disk[#,r]&/@Pick[poss,id,0]}
}]
]
VisualizeState[state_Integer]:=VisualizeState[state,poss]

subs=Subsets[poss,{3}];
subs=Select[subs,Differences/*Apply[Equal]]; (* steps should be equal *)
subs=Select[subs,Differences/*(MemberQ[#,0,{2}]&)]; (* either horizontal or vertical difference should be 0 *)
subs=Select[subs,Differences/*Map[Norm]/*EqualTo[{1,1}]];(* Step should be size 1 *)
subs//=Join[#,Reverse/@#]&;
subs//=Sort;
subs//Length
Graphics[Riffle[RandomColor[Length[subs]],{Point[#],Arrow[#]}&/@subs]]

subposs=Map[FirstPosition[poss,#][[1]]&,subs,{2}];
masks=FromDigits[ReplacePart[ConstantArray[0,len],(List/@#)->1],2]&/@subposs;
beforemoves=FromDigits[ReplacePart[ConstantArray[0,len],{#1->1,#2->1,#3->0}],2]&@@@subposs;
aftermoves=FromDigits[ReplacePart[ConstantArray[0,len],{#1->0,#2->0,#3->1}],2]&@@@subposs;
movedata=<|"masks"->masks,"beforemoves"->beforemoves,"aftermoves"->aftermoves,"addchanges"->aftermoves-beforemoves|>

(* starting position *)
state=ConstantArray[1,Length[poss]];
state[[FirstPosition[poss,{4,5}]]]=0;
state//=FromDigits[#,2]&
VisualizeState[state]

ClearAll[ValidMoves]
ValidMoves[state_,movedata_Association]:=Module[{s},
s=BitAnd[state,movedata["masks"]]-movedata["beforemoves"];
state+Pick[movedata["addchanges"],s,0]
]
VisualizeState[#,poss]&/@ValidMoves[state,movedata]






(* the first 10 steps can be easily computed *)
states={state};
begintime=lasttime=AbsoluteTime[];
data=Table[
PrintTemporary[i];
lasttime=AbsoluteTime[];
conn=Catenate[Thread[#->ValidMoves[#,movedata]]&/@states];
states=DeleteDuplicates[conn[[All,2]]];
PrintTemporary[AbsoluteTime[]-lasttime];
{i,Length[states],conn,AbsoluteTime[]-lasttime,AbsoluteTime[]-begintime}
,
{i,6}
];
data[[All,{1,2,4,5}]]//Grid



(* save 1.mx *)
nextstates=ValidMoves[state,movedata]
List["1.mx",<|"i"->1,"states"->nextstates,"len"->Length[nextstates]|>]


(* go from x.mx to x+1.mx if x+1.mx exists it verified its contents *)
Needs["Developer`"]
ClearAll[ValidMovesBatch]
ValidMovesBatch[states_List,movedata_Association]:=Module[{out},
out=ValidMoves[#,movedata]&/@states;
out//=Apply[Union];
ToPackedArray[out]
]
ClearAll[VerifyOrNew]
VerifyOrNew[fnin_String,fnout_String]:=Module[{importdata,oldi,states,\[Delta]=1000000},
If[FileExistsQ[fnin],
importdata=Import[fnin];
oldi=importdata["i"];
states=importdata["states"];
Print[DateString[]," - ","Imported!"];
Print[DateString[]," - ","Length = ", Length[states]];
Clear[importdata];
If[Length[states]>2\[Delta],
CloseKernels[];
LaunchKernels[8];
states=ParallelTable[
ValidMovesBatch[states[[(i-1)\[Delta]+1;;Min[i \[Delta],Length[states]]]],movedata]
,
{i,Ceiling[Length[states]/\[Delta]]},
Method->"FinestGrained",ProgressReporting->True
];
Print[DateString[]," - ","Parallel done!"];
CloseKernels[];
Print[DateString[]," - ","kernels closed!"];
states//=Catenate;
Print[DateString[]," - ","stuff catenated!"];
,
states=ValidMovesBatch[states,movedata]
];
states=ToPackedArray[states];
Print[DateString[]," - ","packed!"];
(*Export["pre"<>fnout,<|"i"->oldi+1,"states"->states,"len"->Length[states]|>];
Print[DateString[]," - ","rawexp!"];*)
Print[DateString[]," - ","length = ",Length[states]];
states//=DeleteDuplicates;
Print[DateString[]," - ","length = ",Length[states]];
Print[DateString[]," - ","dupes deleted!"];
If[!FileExistsQ[fnout],
Export[fnout,<|"i"->oldi+1,"states"->states,"len"->Length[states]|>]
,
Print@"check!";
Sort[Import[fnout]["states"]]===Sort[states]
]
,
Print["input file absent!"]
]
]


fnsets=Table[{ToString[i]<>".mx",ToString[i+1]<>".mx"},{i,1,34}]
(* actually run it (takes several hours and need plenty of RAM)*)
Do[
Print[set];
VerifyOrNew@@set
,
{set,fnsets}
]


(* use this to read the files and plot the results and so on *)
fns=FileNames["*.mx"];
fns//=SortBy[StringReplace[".mx"->""]/*ToExpression];
lens=Import[#]["len"]&/@fns;
lens//=Prepend[1];
lens   (* this outputs {1,4,17,92,495,2475,11771,52226,212527,789228,2640323,7870055,20730606,47916748,96715832,170154214,260956703,349541944,410294786,423631649,385887175,310724581,221398196,139580751,77748102,38162987,16445627,6178002,2007607,559163,131269,25378,4012,481,36,4} *)
ListLogPlot[Callout[#,#,LabelVisibility->All]&/@lens,ImageSize->700,Frame->True]
ListPlot[Callout[#,#,LabelVisibility->All]&/@lens,ImageSize->700,Frame->True]
ListPlot[N[Ratios@lens],Frame->True,GridLines->Automatic,ImageSize->700]