Re[2]: Julirätsel

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Liebe Freundinnen und Freunde von Bilderrätsellösungen,

> > was haben die beiden ArrayPlot's miteinander gemein?
>
> ... und wie kommt dieses Bild von Regel 150?

Einem zellularen Automaten

{{0,0,0,0,0,0,0,0,a[1,1],0,0,0,0,0,0,0,0},
 {0,0,0,0,0,0,0,a[2,1],a[2,2],a[2,3],0,0,0,0,0,0,0},
 {0,0,0,0,0,0,a[3,1],a[3,2],a[3,3],a[3,4],a[3,5],0,0,0,0,0,0},
 {0,0,0,0,0,a[4,1],a[4,2],a[4,3],a[4,4],a[4,5],a[4,6],a[4,7],0,0,0,0,0},
 {0,0,0,0,a[5,1],a[5,2],a[5,3],a[5,4],a[5,5],a[5,6],a[5,7],a[5,8],a[5,9],0,0,0,0},
 {0,0,0,a[6,1],a[6,2],a[6,3],a[6,4],a[6,5],a[6,6],a[6,7],a[6,8],a[6,9],a[6,10],a[6,11],0,0,0},
 {0,0,a[7,1],a[7,2],a[7,3],a[7,4],a[7,5],a[7,6],a[7,7],a[7,8],a[7,9],a[7,10],a[7,11],a[7,12],a[7,13],0,0},
 {0,a[8,1],a[8,2],a[8,3],a[8,4],a[8,5],a[8,6],a[8,7],a[8,8],a[8,9],a[8,10],a[8,11],a[8,12],a[8,13],a[8,14],a[8,15],0},
 
{a[9,1],a[9,2],a[9,3],a[9,4],a[9,5],a[9,6],a[9,7],a[9,8],a[9,9],a[9,10],a[9,11],a[9,12],a[9,13],a[9,14],a[9,15],a[9,16],a[9,17]}
}

der bei s - 1 Schritten ein {s, 2 s - 1} - Array darstellt, kann man  
verschiedene quadratische Arrays zuordnen:

(1) leftDCAMatrix

{{a[1,1],a[2,2],a[2,3],a[3,4],a[3,5],a[4,6],a[4,7]},
 {a[2,1],a[3,2],a[3,3],a[4,4],a[4,5],a[5,6],a[5,7]},
 {a[3,1],a[4,2],a[4,3],a[5,4],a[5,5],a[6,6],a[6,7]},
 {a[4,1],a[5,2],a[5,3],a[6,4],a[6,5],a[7,6],a[7,7]},
 {a[5,1],a[6,2],a[6,3],a[7,4],a[7,5],a[8,6],a[8,7]},
 {a[6,1],a[7,2],a[7,3],a[8,4],a[8,5],a[9,6],a[9,7]},
 {a[7,1],a[8,2],a[8,3],a[9,4],a[9,5],a[10,6],a[10,7]}
}

(2) rightDCAMatrix

{{a[1,1],a[2,2],a[2,1],a[3,2],a[3,1],a[4,2],a[4,1]},
 {a[2,3],a[3,4],a[3,3],a[4,4],a[4,3],a[5,4],a[5,3]},
 {a[3,5],a[4,6],a[4,5],a[5,6],a[5,5],a[6,6],a[6,5]},
 {a[4,7],a[5,8],a[5,7],a[6,8],a[6,7],a[7,8],a[7,7]},
 {a[5,9],a[6,10],a[6,9],a[7,10],a[7,9],a[8,10],a[8,9]},
 {a[6,11],a[7,12],a[7,11],a[8,12],a[8,11],a[9,12],a[9,11]},
 {a[7,13],a[8,14],a[8,13],a[9,14],a[9,13],a[10,14],a[10,13]}
}

(3) coneCAMatrix

{{a[1,1],a[2,3],a[3,5],a[4,7],a[5,9],a[6,11],a[7,13]},
 {a[2,1],a[2,2],a[3,4],a[4,6],a[5,8],a[6,10],a[7,12]},
 {a[3,1],a[3,2],a[3,3],a[4,5],a[5,7],a[6,9],a[7,11]},
 {a[4,1],a[4,2],a[4,3],a[4,4],a[5,6],a[6,8],a[7,10]},
 {a[5,1],a[5,2],a[5,3],a[5,4],a[5,5],a[6,7],a[7,9]},
 {a[6,1],a[6,2],a[6,3],a[6,4],a[6,5],a[6,6],a[7,8]},
 {a[7,1],a[7,2],a[7,3],a[7,4],a[7,5],a[7,6],a[7,7]}
}

(4) CAMatrix

{{a[1,1],0,0,0,0,0,0,0,0,0,0,0,0},
 {0,a[2,2],a[2,3],0,0,0,0,0,0,0,0,0,0},
 {0,a[2,1],a[3,3],a[3,4],a[3,5],0,0,0,0,0,0,0,0},
 {0,0,a[3,2],a[4,4],a[4,5],a[4,6],a[4,7],0,0,0,0,0,0},
 {0,0,a[3,1],a[4,3],a[5,5],a[5,6],a[5,7],a[5,8],a[5,9],0,0,0,0},
 {0,0,0,a[4,2],a[5,4],a[6,6],a[6,7],a[6,8],a[6,9],a[6,10],a[6,11],0,0},
 {0,0,0,a[4,1],a[5,3],a[6,5],a[7,7],a[7,8],a[7,9],a[7,10],a[7,11],a[7,12],a[7,13]},
 {0,0,0,0,a[5,2],a[6,4],a[7,6],a[8,8],a[8,9],a[8,10],a[8,11],a[8,12],a[8,13]},
 {0,0,0,0,a[5,1],a[6,3],a[7,5],a[8,7],a[9,9],a[9,10],a[9,11],a[9,12],a[9,13]},
 {0,0,0,0,0,a[6,2],a[7,4],a[8,6],a[9,8],a[10,10],a[10,11],a[10,12],a[10,13]},
 {0,0,0,0,0,a[6,1],a[7,3],a[8,5],a[9,7],a[10,9],a[11,11],a[11,12],a[11,13]},
 {0,0,0,0,0,0,a[7,2],a[8,4],a[9,6],a[10,8],a[11,10],a[12,12],a[12,13]},
 {0,0,0,0,0,0,a[7,1],a[8,3],a[9,5],a[10,7],a[11,9],a[12,11], a[13,13]}
}


CAMatrix ist ein Arrayisomorphismus.

Das eine Bildchen ist ein Arrayplot der coneCAMatrix der Regel 150, das  
zweite Bildchen ist ein Arrayplot der CAMatrix von Regel 150.

Gruss
Udo.

Clear[leftDCAMatrix]
leftDCAMatrix[r_Integer (* Rule *),
  n_Integer (* number of columns and rows *)] :=
 Module[{s  = (6 n + (-1)^n - 1)/4, mRes = ConstantArray[0, {n, n}]},
   cA = CellularAutomaton[Mod[r, 256], {{1}, 0}, {s - 1, All}];
   For[i = 1, i <= n, i++,
    For[j = 1, j <= n, j++,
     mRes[[i, j]] = cA[[i + Floor[j/2], s + j - i - Floor[j/2]]]
     ]
    ];
   mRes
   ] /; r > 0 && n > 1

Clear[rightDCAMatrix]
rightDCAMatrix[r_Integer (* Rule *),
  n_Integer (* number of columns and rows *)] :=
 Module[{s  = (6 n + (-1)^n - 1)/4, mRes = ConstantArray[0, {n, n}]},
   cA = CellularAutomaton[Mod[r, 256], {{1}, 0}, {s - 1, All}];
   For[i = 1, i <= n, i++,
    For[j = 1, j <= n, j++,
     mRes[[i, j]] = cA[[i + Floor[j/2], s - j +  i + Floor[j/2]]]
     ]
    ];
   mRes
   ] /; r > 0 && n > 1

Clear[coneCAMatrix]
coneCAMatrix[r_Integer (* Rule *),
  n_Integer (* number of columns and rows *)] :=
 Module[{s = n, mRes = ConstantArray[0, {n, n}]},
   cA = CellularAutomaton[Mod[r, 256], {{1}, 0}, {s - 1, All}];
   For[i = 1, i <= n, i++,
    For[j = 1, j <= n, j++,
     mRes[[i, j]] = cA[[Max[i, j], s + j - i]]
     ]
    ];
   mRes
   ] /; r > 0 && n > 1

Clear[CAMatrix]
CAMatrix[r_Integer (* Rule *),
  n_Integer (* number of columns and rows *)] :=
 Module[{s = n, mRes = ConstantArray[0, {n, n}]},
   cA = CellularAutomaton[Mod[r, 256], {{1}, 0}, {s - 1, All}];
   For[i = 1, i <= n, i++,
    For[j = 1, j <= n, j++,
     mRes[[i, j]] = cA[[Min[i, j], s + j - i]]
     ]
    ];
   mRes
   ] /; r > 0 && n > 1