Xah Talk Show 2024-08-28 Ep580, Advent of Code 2023, Day 13, Wolfram Language

vidthumb K4kBvJQhpr8 — https://youtu.be/K4kBvJQhpr8

2024-08-28

toy input

#.##..##.
..#.##.#.
##......#
##......#
..#.##.#.
..##..##.
#.#.##.#.

#...##..#
#....#..#
..##..###
#####.##.
#####.##.
..##..###
#....#..#

aoc_d13_2024-08-28.txt

turn the text block into a matrix. because then we can use transpose, a standard function in linear algebra.
first, find the mirror line (horizontal) first. because, rows are more common to deal with in a matrix.
if 2 rows are the same and are adjacent, it is potentially a mirror line.

first find if there are 2 adjacent rows and same. if not, it does not have horizontal mirror line.
if it does have 2 adjacent same rows, compare their outter rows are the same.
if so, continue to compare outter rows till no rows.
when anytime the outter rows not same, the initial adjacent rows is not a horizontal mirror line.
if all outter row pairs match, then the initial adjacent rows is the horizontal mirror line.
if the above fails, find the next adjacent rows that are same.
repeat above.

in order to have a horizontal mirror line, at least 2 rows must be identical. but this is not the whole condition.
what happens if all rows are the same. then, any row is a horizontal mirror line

crazy situations:

what if all rows are the same, or all columns.
what if there are both horizontal and vertical mirror lines.
what if no mirror lines at all. in this case, the block is 0.
what if there are more than one horizontal mirror lines, or more than one vertical mirror lines.

suppose this is a matrix with horizontal mirror line

1
2
3
------------
3
2
1

1
2
------------
2
1
3
-----------
3

1
--------------
1
3
--------------
3
1
--------------
1

the pairs of rows that are the same, is constant.
1 6 = 7
2 5 = 7
3 4 = 7

input =
"#.##..##.
..#.##.#.
##......#
##......#
..#.##.#.
..##..##.
#.#.##.#.

#...##..#
#....#..#
..##..###
#####.##.
#####.##.
..##..###
#....#..#";

xtextBlocks = StringSplit[ input, "\n\n" ];

xmatrixList =
Map[
Function[{x}, Map[ Characters, StringSplit[ x , "\n" ] ] ] ,
 xtextBlocks ];

(* check, given a matrix, does it have horizontal mirror line *)
(* first find if there are 2 adjacent rows and same. if not, it does not have horizontal mirror line. *)

(* xmatrixList[[1]]
is
{
{"#", ".", "#", "#", ".", ".", "#", "#", "."},
{".", ".", "#", ".", "#", "#", ".", "#", "."},
{"#", "#", ".", ".", ".", ".", ".", ".", "#"},
{"#", "#", ".", ".", ".", ".", ".", ".", "#"},
{".", ".", "#", ".", "#", "#", ".", "#", "."},
{".", ".", "#", "#", ".", ".", "#", "#", "."},
{"#", ".", "#", ".", "#", "#", ".", "#", "."}
}
 *)

(* return a list of int.
Each is a row number.
Means, it and next row are the same.
If empty list, then no same adjacent rows. *)

xSameIndexList =
Map[ Function[{yy},
Flatten@ Position[
Map[
Function[{x}, Apply[ SameQ, x ] ] ,
 Partition[ yy , 2, 1 ]
 ],
 True,
{1}
]
], xmatrixList];
(* {{3...}, {4...}} *)

(* two possible results of xSameIndexList
this
{{},{},...}
or
{{3}, {7},...}
*)

(* If it is empty list. but the list may be nested empty list. *)

(* if this return true, means the matrix has a horizontal mirror line. elso, no. *)

Map[
Function[{mm},
Map[Function[{xindex},
  Module[{xfront = Take[xmatrixList[[2]], xindex],
    xrest = Drop[xmatrixList[[2]], xindex], xfrontLen, xrestLen},
   xfrontLen = Length[xfront];
   xrestLen = Length[xrest];
   If[xfrontLen <= xrestLen,
With[ { xnewfront = Reverse[xfront] ,
xnewrest = Take[xrest, xfrontLen]},
xnewfront === xnewrest
] ,
With[{xnewfront = Take[xfront, -xrestLen] ,
xnewrest = Reverse[xrest]},
xnewfront === xnewrest
] ]]],
mm]
] ,
 xSameIndexList]

{{False}, {True}}

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

(* problem, given 2 lists inside a list *)
{ {1,2,3}, {1,2,3,4}}
(* create a list like this *)
{ {1,2,3}, {1,2,3}}
(* namely, drop the longer list rest items. *)

Riffle[  {1,2,3}, {a,b,c,d} ]
(* {1, a, 2, b, 3} *)

Riffle[  {1,2,3}, {a,b,c,d}, 1 ]

Riffle[ {1,2,3,4}, {1,2,3} ]
(* {1, 1, 2, 2, 3, 3, 4} *)

Riffle[ {1,2,3,4,5,6}, {1,2,3} ]

MapThread[ ff, { {1,2,3}, {1,2,3,4}}]
MapThread[ ff, { {1,2,3}, {1,2,3,4}}]

PadRight[  ]

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

(* pattern matching approach *)

(* use pattern matching, to return neighbor rows that are same. *)
Cases[ xmatrixList[[1]] ,
Condition[ { ___, rowA_List, rowB_List, ___ },
 ( rowA === rowB ) ] -> f[rowA, rowB] ,
{0}
]

(* another text. on second matrix *)
Cases[ xmatrixList[[2]] ,
Condition[ { ___, rowA_List, rowB_List, ___ },
 ( rowA === rowB ) ] -> f[rowA, rowB] ,
{0}
]

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

(* use pattern matching, to find if a matrx has a horizontal mirror line. *)

MatchQ[
 xmatrixList[[2]],
 Condition[
 { xfront___, rowA_List, rowB_List, rest___ },
  And[ ( rowA === rowB ),
   SameQ[
    Reverse @ {Splice[ xfront ] , rowA},
    { rowB , rest}
   ]
  ]
 ]
]

(* given two list of rows.
we want know, if we reverse the one with smaller length,
it is a sub expression of the other larger.
 *)

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

(* use pattern matching, to return neighbor rows that are same.
for this example, we use integer to represent a matrix row.
*)
MatchQ[
{646, 593, 984, 639, 156, 156, 639, 984, 593, 646},
 Condition[
 { xfront___Integer, rowA_Integer, rowB_Integer, rest___Integer },
  And[ ( rowA === rowB ),
   SameQ[
    Reverse @ { Sequence@xfront , rowA},
    { rowB , Sequence@rest}
   ]
  ]
 ]
]
(* True *)

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

(* now, work on, when the front rows and rest rows have different length.
*)

MatchQ[
{
{646, 593, 984, 639, 156 }
{156, 639, 984, 593}
} ,
 { xnewfront___List, newrest___List }  ]

2024-08-28

(* example of partition *)

Partition[ {1,2,3,4,5,6,7} , 2, 1 ]
(* {{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 7}} *)

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

SameQ[  {1,2}, {2,3} ]
(* False *)

SameQ[  7 ]
(* True *)

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

(* syntax shortcut example *)

Map[ SameQ@@ # & , Partition[ {1,2,3,4,6,6,7} , 2, 1 ] ]

Map[
Function[{x}, Apply[ SameQ, x ] ] ,
 Partition[ {1,2,3,4,6,6,7} , 2, 1 ] ];

3 + 5

Plus[3,5]

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

(* {False, False, False, False, True, False} *)

(* if empty, means same adjacent rows *)
(* else, result is a list of integers, say for n, means n th and (n+1) th rows are the same *)
Position[ x3 , True]

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

(* syntax shortcuts, aka lisp reader macro.
and FullForm, aka sexp *)

SameQ[ xFirstMatrxSameNeighRowIndexes, List[List[]] ]

SameQ[ xFirstMatrxSameNeighRowIndexes, {{}} ]

xFirstMatrxSameNeighRowIndexes ===  {{}}

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

Split[ {3,3,4,5,6} ]
(* {{3, 3}, {4}, {5}, {6}} *)

Split[ {
{3,3},
{4,5},
{4,5},
{6,7}
}
]

(* {{{3, 3}}, {{4, 5}, {4, 5}}, {{6, 7}}} *)

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

Split[ {
{3,3},
{4,5},
{4,5},
{6,7},
{x,y},
{x,y},
{6,7},
{9,7},
{6,683}
} ,
UnsameQ
]

{{{3, 3}, {4, 5}},
{{4, 5}, {6, 7}, {x, y}},
{{x, y}, {6, 7}, {9, 7}, {6, 683}}}

(* {{{3, 3}, {4, 5}}, {{4, 5}, {6, 7}}} *)

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

Take[ Range[ 9 ], 6 ]
(* {1, 2, 3, 4, 5, 6} *)

Drop[ Range[ 9 ], 6 ]
(* {7, 8, 9} *)

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

FullForm@
Hold[  {x_ , y_} /; ( x === y ) ]

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

{Sequence[ 2, 3 ]}
(* {2, 3} *)

{Sequence[ 2 ]}
(* {2} *)

{Sequence[ ]}
(* {} *)

{Splice[ {2,3} ]}
(* {2, 3} *)

{Splice[ {3} ]}
(* {3} *)

{Splice[{}]}
(* {} *)

{Splice[]}
(* error *)

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

Map[Function[{xindex},
  Module[{xfront = Take[xmatrixList[[2]], xindex],
    xrest = Drop[xmatrixList[[2]], xindex], xfrontLen, xrestLen},
   xfrontLen = Length[xfront];
   xrestLen = Length[xrest];
Print["xfront ", xfront //MatrixForm ];
Print["xrest ", xrest //MatrixForm];
Print["xfrontLen ", xfrontLen ];
Print["xrestLen ", xrestLen ];
   If[xfrontLen <= xrestLen,
With[ { xnewfront = Reverse[xfront] ,
xnewrest = Take[xrest, xfrontLen]},
Print["xnewfront ", xnewfront //MatrixForm ];
Print["xnewrest ", xnewrest //MatrixForm];
xnewfront === xnewrest
] ,
With[{xnewfront = Take[xfront, -xrestLen] ,
xnewrest = Reverse[xrest]},
Print["xnewfront ", xnewfront //MatrixForm ];
Print["xnewrest ", xnewrest //MatrixForm];
xnewfront === xnewrest
] ]]],
xSameIndexList]

2024-08-28

BREAK 10 MINUTE. be back on
2024-08-28 18:20

goto

Xah Talk Show 2024-08-28 Ep580,
Advent of Code 2023, Day 13, Wolfram Language

http://xahlee.info/talk_show/xah_talk_show_2024-08-28.html

to see the current state of the art