An inverted pyramid
A simple solution with And
, Xor
and Mod
:
n = 41;
Table[If[Abs[2 j - 1 - n] < i &&
Xor[Mod[Abs[2 j - 2 - n] - i, 3] == 0, 2 j > n + 1], 1, 0],
{i, n}, {j, n}] // ArrayPlot
The same for n = 333
:
To be more functional-style:
j = ConstantArray[Range@n, n];
i = Transpose@j;
UnitStep[i - 1 - Abs[2 j - 1 - n]] (1 +
(1 - 2 Unitize@Mod[Abs[2 j - 2 - n] - i, 3]) Sign[n + 2 - 2 j]) // ArrayPlot
(* the same result *)
If you were to allow CellularAutomaton
I think the simplest change is to drop every other row and column:
MatrixPlot[CellularAutomaton[57, {{1}, 0}, 80][[;; ;; 2, ;; ;; 2]],
ImageSize -> 400, Mesh -> All, PlotTheme -> "Monochrome"]
There is however a discontinuity in the center compared to your original.
I'll start working on other options.
From your earlier question seeking a functional solution I believe you wish to avoid Table
, Array
, etc., which the other existing answers use. One may be able to "cheat" to your satisfaction with SparseArray
, e.g.:
(* ybeltukov's conditional *)
n = 41;
SparseArray[
{i_, j_} /;
Abs[2 j - 1 - n] < i && Xor[Mod[Abs[2 j - 2 - n] - i, 3] == 0, 2 j > n + 1] ->
1, {n, n}] // ArrayPlot
If this is not to your liking, and since you wish to avoid CellularAutomaton
, perhaps this rather contrived yet hopefully functional approach, also using dropping rows:
k = Riffle[#, {0, 0, 0}] & /@ IdentityMatrix[3]
m = PadRight[{{}}, {41, 41}, Reverse @ k];
m2 = LowerTriangularize[#][[All, ;; ;; 2]] & /@ {m, 1 - m};
Join[Reverse[#2, {2}], #, 2] & @@ m2 // MatrixPlot
The closest I get is this
MatrixPlot@
Table[Boole@((Divisible[Abs[k - n], 3] ||
k >= 22) && (Divisible[Abs[-22 + k + n], 3] \[Implies]
k < 22) && n > 2 Abs[-22 + k]), {n, 41}, {k, 41}]