Xah Talk Show 2024-10-26 Ep591, Wolfram Language, Advent of Code 2023, Day 14 Part 2, take 2

xinput =
"O....#....
O.OO#....#
.....##...
OO.#O....O
.O.....O#.
O.#..O.#.#
..O..#O..O
.......O..
#....###..
#OO..#....";

(* turn into matrix *)
xmatrix = Map[ Characters , StringSplit[ xinput ]];

xrowcount = Length[ xmatrix ];

xcolumncount = Length[ xmatrix[[1]] ];

moveNorth = Function[{xx},
Transpose @ ReplaceRepeated[ Transpose @ xx,
{head___,Pattern[dots, Longest[ ".".. ] ],Pattern[balls, Longest[ "O".. ] ],tail___} -> {head,balls, dots, tail}
] ];

moveWest =
Function[{xx},
ReplaceRepeated[ xx,
{head___,Pattern[dots, Longest[ ".".. ] ],Pattern[balls, Longest[ "O".. ] ],tail___} -> {head,balls, dots, tail}
] ];

moveSouth =
Function[{xx}, Transpose @ ReplaceRepeated[ Transpose @ xx,
{head___, Pattern[balls, Longest[ "O".. ] ], Pattern[dots, Longest[ ".".. ] ], tail___} -> {head,dots,balls,tail}
] ];

moveEast =
Function[{xx}, ReplaceRepeated[ xx,
{head___, Pattern[balls, Longest[ "O".. ] ], Pattern[dots, Longest[ ".".. ] ], tail___} -> {head,dots,balls,tail}
] ];

(* do one cycle of moving balls *)

f1cycle = Function[{yy}, yy // moveNorth // moveWest // moveSouth // moveEast];

xallmoved = Nest[ f1cycle, xmatrix, 100 ]

Total @ MapIndexed[ Function[{xval, xindex},
 Count[ xval, "O" ] * (xrowcount - xindex[[1]] +1) ],
xallmoved ]

(* answer *)

(* HHHH--------------------------------------------------- *)

numberOfCycles = 30;

listOfMoves =
Flatten @
Table[ {
HoldForm @ moveNorth,
HoldForm @ moveWest,
HoldForm @ moveSouth,
HoldForm @ moveEast}, {numberOfCycles}];

boardhistory =
Table[
Fold[
Function[{arg, ff}, ReleaseHold @ ff[arg] ],
xmatrix ,
Take[ listOfMoves, x ]
] ,
 {x, 1, 4 * numberOfCycles}];

Map[ MatrixForm, boardhistory];

Manipulate[ boardhistory[[n]] // MatrixForm , {n, 1, numberOfCycles 4, 1} ]

(* HHHH--------------------------------------------------- *)

Manipulate[
boardhistory[[n]] // MatrixForm , {n, 1, numberOfCycles 4, 1} ]

(* HHHH--------------------------------------------------- *)

Manipulate[
boardhistory[[n]] // MatrixForm , {n, 1, numberOfCycles 4, 4} ]

(* Tally[ boardhistory ] *)

(* HHHH--------------------------------------------------- *)

xFindNestPeriod = ResourceFunction["FindNestPeriod"];
xPeriodity = xFindNestPeriod[f1cycle , xmatrix, 1000]

xFinalBoardConfig =
Nest[
 f1cycle ,
 xmatrix,
 Mod[ 10^9 , xPeriodity ]
]

Total @ MapIndexed[ Function[{xval, xindex},
 Count[ xval, "O" ] * (xrowcount - xindex[[1]] +1) ],
xFinalBoardConfig ]

(* code from
ResourceFunction["FindNestPeriod"];
by Richard Phillips.
accessed on 2024-10-26
 *)

FindNestPeriod[f_, init_, maxStepsToTry_ : 100000] :=
 Block[{triedsteps = 0},
  With[{pointoncycle =
     NestWhile[{triedsteps++; f[First[#]], f[f[Last[#]]]} &, {init,
       f[init]}, UnsameQ @@ # &, 1, maxStepsToTry]},
   If[triedsteps == maxStepsToTry,
    Failure["NoRepeatFound", Association["MaxSteps" -> triedsteps]],
    Block[{cyclelength = 1},
     NestWhile[(cyclelength++; f[#]) &,
      f[pointoncycle], # =!= pointoncycle &]; cyclelength]]]]