Strategies for making a cellular automaton puzzle

Question

I am making a cellular automaton secret message puzzle for my kids, and am looking for help on strategies to make it. I am relatively new to Mathematica, thank you for your help!

The puzzle is a grid of random letters with initial seed blocks and rule set. Once the full grid is filled out according to the rules, the last several clear blocks contain letters that spell out a "secret" message.

The following creates the random letters and output of the cellular automaton. What is a good approach for replacing N random letters at the bottom of the grid in the clear boxes with the message? I can imagine doing it by hand by editing the array of random letters, but would like a more general approach so I can make several puzzles.

width = 21;
height = 21;
randomLetters = 
  Graphics[{Black, 
    Table[Text[
      ToUpperCase[FromLetterNumber[RandomInteger[{1, 26}]]], {n - 0.5,
        m - 0.5}], {n, 1, width}, {m, 1, height}]}];
init = {1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
  1}; (* seed blocks *)
arrayPlot1 = 
 ArrayPlot[CellularAutomaton[182, init, 20], 
  Mesh -> True]; (* filled in puzzle *)
arrayPlot2 = 
 ArrayPlot[CellularAutomaton[0, init, 20], 
  Mesh -> True]; (* empty puzzle (using rule 0) showing just seed
blocks *)
Show[arrayPlot2, randomLetters]
RulePlot[CellularAutomaton[182]]
Show[arrayPlot1, randomLetters]

"Secret" message appears approximately within the rectangle above.

Answer 1

The method to display the letters and the automaton gird works nicely. We need only to adust some procedures to insert a secret message into the grid. First, set the starting values. The length of init must be equal to width, so check that it's true.

width = 21;
height = 21;
secretRows = 4; (* number of rows for the secret message *)
rule = 182; (* automatron rule number *)
init = {1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1};
Length[init] == width
(* True *)

We need to know the number of "clear blocks" in the last rows of the automaton grid. Run the automaton for height - 1 cycles to make a grid of height rows and width columns. Find the clear blocks in the last rows of the automaton grid. Assign the positions of the clear blocks (value 0) to index the letters list.

SeedRandom[1234];(*for repeatable demonstration only*)
letters = RandomChoice[CharacterRange["A", "Z"], width*height];
ca = CellularAutomaton[rule, init, height - 1];
index = Flatten[
  Position[Flatten[ca][[-width*secretRows ;;]], 0]
    + Length[letters] - width*secretRows, 2]

(* {359, 361, 370, 374, 379, 383, 390, 392, 394, 396, 401, 403,
    405, 410, 418, 420, 427, 430, 432, 438} *)

There are 20 clear blocks in this example. Choose a 20-character word as a secret message to fill the grid positions. The length of the message in characters must be the same as the number of clear blocks in the last rows of the grid.

secret = ToUpperCase@
  RandomChoice[Select[WordList[], StringLength[#] == Length[index] &]]

(* "INTERNATIONALIZATION" *)

Assign the secret message to the clear blocks of the grid. Arrange letters by rows so that the first letter is in the upper, left corner. This puts the last rows of letters at the bottom of the grid. Display the solution grid and the unsolved puzzle.

letters[[index]] = Characters@secret;
letterArray = Graphics[{Black,
  Table[Text[
    letters[[width*(m - 1) + n]],
    {(n) - 0.5, (height - m + 1) - 0.5}],
    {n, 1, width}, {m, 1, height}]}];
arrayPlot1 = ArrayPlot[ca, Mesh -> True];
Show[arrayPlot1, letterArray]

arrayPlot2 = 
  ArrayPlot[CellularAutomaton[0, init, height - 1], Mesh -> True];
RulePlot[CellularAutomaton[rule]]
Show[arrayPlot2, letterArray]