r/wljs

This idea is solely based on an amazing project MarkovJunior, which is essentially probabilistic pattern matching machine. I though, "ha. This must be the best fit for Wolfram Language!".

Indeed, no tricks were used, except mirroring and rotating the "canvas" to generalize 1D rules into 2D, the rest is purely default pattern matching of the language:

r[{before___, {a___, (RGBColor[1, 0, 0]),(GrayLevel[0]),(GrayLevel[0]), b___}, after___}] := 
  {before, {a, (RGBColor[0, 0, 1]),(RGBColor[0, 0, 1]),(RGBColor[1, 0, 0]), b}, after} /; (RandomReal[]<=0.5);

r[{before___, {a___, (RGBColor[1, 0, 0]),n_,(RGBColor[0, 0, 1]), b___}, after___}] := 
  {before, {a, (RGBColor[0, 0, 1]),n,(RGBColor[1, 0, 0]), b}, after} /; (RandomReal[]<=0.5);

r[any_] := any 

field = Table[(GrayLevel[0]), {30}, {30}];
field[[RandomInteger[{1,30}],RandomInteger[{1,30}]]] = (RGBColor[1, 0, 0]);

Refresh[ArrayPlot[field = applyInAllSymmetries[field]], 0.04]

where

rot[0][m_] := m;
rot[1][m_] := Transpose[Reverse[m]];
rot[2][m_] := Reverse[Reverse /@ m];
rot[3][m_] := Reverse[Transpose[m]];

mirror[m_] := Reverse /@ m;  (* left-right mirror *)

symmetries = Join[
   Table[rot[k], {k, 0, 3}],
   Table[rot[k] @* mirror, {k, 0, 3}]
];

inverseSymmetries = Join[
   Table[rot[Mod[-k, 4]], {k, 0, 3}],
   Table[mirror @* rot[Mod[-k, 4]], {k, 0, 3}]
];

applyInAllSymmetries[m_] :=
  Fold[
    #2[[2]][r[#2[[1]][#1]]] &,
    m,
    Transpose[{symmetries, inverseSymmetries}]
  ];

A small MarkovJunior-style rewrite engine in vanilla (almost) Wolfram Language https://github.com/JerryI/MarkovJunior

Why WL? It is generally built around pattern matching; therefore, MarkovJunior can be implemented easily using native ReplaceAll, Rule, and Pattern symbols. Most of the code is used for building a friendly API and performing error checks.

For example random filling can be done using:

Black -> Red

For self-avoiding walk:

{a___, Red,Black,Black, b___} :> {a, White,Gray,Red, b}

For this particular example (flowers) it is written as a set of replacing rules, which gradually build soil/sky and then grows some flowers...

AppendTo[rules, {
1, 1, Automatic, {
(* seed the soil region *)
Black -> Yellow
}
}];

AppendTo[rules, {
1, 3, Automatic, {
(* seed several sky regions *)
Black -> Red
}
}];

AppendTo[rules, {
1, Infinity, Automatic, {
(* grow the sky and soil regions from their seeds *)
{a___, Red,Black, b___} :> {a, Red,Red, b},
{a___, Yellow,Black, b___} :> {a, Yellow,Yellow, b}
}
}];

AppendTo[rules, {
All, Infinity, Automatic, {
(* convert temporary region colors into sky and soil *)
{a___, Red, b___} :> {a, LightBlue, b},
{a___, Yellow, b___} :> {a, Brown, b}
}
}];

AppendTo[rules, {
1, Infinity, All, {
(* plant the first stem segment along the soil line *)
{
bf___,
{a1___, LightBlue,LightBlue,LightBlue, b1___},
{a2___, LightBlue,LightBlue,LightBlue, b2___},
{a3___, Brown,Brown,Brown, b3___},
af___
} :> {
bf,
{a1 , LightBlue,LightBlue,LightBlue, b1 },
{a2 , LightBlue,Green,LightBlue, b2 },
{a3 , Brown,Brown,Brown, b3 },
af
} /; Length[{a1}]==Length[{a2}]==Length[{a3}]
}
}];

AppendTo[rules, {
1, Infinity, "MirrorX", {
(* grow stems and leaves with mirrored variants *)
(* weight it with some probabillity as well *)
{
bf___,
{a1___, LightBlue,LightBlue,LightBlue, b1___},
{a2___, LightBlue,LightBlue,Green, b2___},
{a3___, LightBlue,LightBlue,LightBlue, b3___},
af___
} :> {
bf,
{a1 , LightBlue,LightBlue,LightBlue, b1 },
{a2 , LightBlue,Green,Green, b2 },
{a3 , LightBlue,LightBlue,LightBlue, b3 },
af
} /; Length[{a1}]==Length[{a2}]==Length[{a3}],

{
bf___,
{a1___, LightBlue,LightBlue,LightBlue, b1___},
{a2___, LightBlue,LightBlue,LightBlue, b2___},
{a3___, LightBlue,Green,Green, b3___},
af___
} :> {
bf,
{a1 , LightBlue,LightBlue,LightBlue, b1 },
{a2 , LightBlue,Green,LightBlue, b2 },
{a3 , LightBlue,Green,Green, b3 },
af
} /; Length[{a1}]==Length[{a2}]==Length[{a3}],

{
bf___,
{a0___, LightBlue,LightBlue,LightBlue, b0___},
{a1___, LightBlue,LightBlue,LightBlue, b1___},
{a2___, LightBlue,LightBlue,LightBlue, b2___},
{a3___, LightBlue,Green,LightBlue, b3___},
af___
} :> {
bf,
{a0 , LightBlue,LightBlue,LightBlue, b0 },
{a1 , LightBlue,LightBlue,LightBlue, b1 },
{a2 , LightBlue,Green,LightBlue, b2 },
{a3 , LightBlue,Green,LightBlue, b3 },
af
} /; Length[{a1}]==Length[{a2}]==Length[{a3}]==Length[{a0}],

{
bf___,
{a0___, LightBlue,LightBlue,LightBlue,LightBlue, b0___},
{a1___, LightBlue,Green,LightBlue,LightBlue, b1___},
{a2___, LightBlue,Green,LightBlue,LightBlue, b2___},
{a3___, LightBlue,Green,LightBlue,LightBlue, b3___},
af___
} :> {
bf,
{a0 , LightBlue,LightBlue,LightBlue,LightBlue, b0 },
{a1 , LightBlue,LightBlue,LightBlue,LightBlue, b1 },
{a2 , LightBlue,Green,Green,LightBlue, b2 },
{a3 , LightBlue,Green,LightBlue,LightBlue, b3 },
af
} /; RandomReal[]<0.5 && Length[{a0}]==Length[{a1}]==Length[{a2}]==Length[{a3}],

{
bf___,
{a1___, LightBlue,LightBlue,LightBlue, b1___},
{a2___, LightBlue,LightBlue,LightBlue, b2___},
{a3___, LightBlue,Green,LightBlue, b3___},
af___
} :> {
bf,
{a1 , LightBlue,LightBlue,LightBlue, b1 },
{a2 , LightBlue,Red,LightBlue, b2 },
{a3 , LightBlue,Green,LightBlue, b3 },
af
} /; RandomReal[]<0.2 && Length[{a1}]==Length[{a2}]==Length[{a3}]
}
}];

AppendTo[rules, {
All, Infinity, All, {
(* turn mature stems into blossoms *)
{
bf___,
{a0___, LightBlue,LightBlue,LightBlue, b0___},
{a1___, LightBlue,Red,LightBlue, b1___},
{a2___, LightBlue,Green,LightBlue, b2___},
{a3___, LightBlue,Green,LightBlue, b3___},
af___
} :> {
bf,
{a0 , LightBlue,Red,LightBlue, b0 },
{a1 , Red,Yellow,Red, b1 },
{a2 , LightBlue,Red,LightBlue, b2 },
{a3 , LightBlue,Green,LightBlue, b3 },
af
} /; Length[{a0}]==Length[{a1}]==Length[{a2}]==Length[{a3}]
}
}];