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}]
}
}];

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}]
  ];

One of my favorite 1-line(er). Behind the scenes: Manipulate internally checks differences between two nearest states of Plot3D, then extracts changed vertices, indices and normals into 3 dynamic typed arrays. For all subsequent changes it syncs new data with 3 corresponding buffers of a GPU memory. If "too much" was changed it falls back to a full reevaluation, when all buffers are removed and are allocated back.

Manipulate[
  Plot3D[Sin[n x] Cos[n y], {x,-1,1}, {y,-1,1}], 
  {n, 1, 5, 0.3}, ContinuousAction->True
]

This is a 2D Gaussian random field with a 1/k^2 spectrum and linear dispersion ω∝k. We clip the field to positive values and square root it to give an edge to the "clouds":

n = 256;
k2 = Outer[Plus, #, #] &[RotateRight[N@Range[-n, n - 1, 2]/n, n/2]^2];

spectrum = With[{d := RandomReal[NormalDistribution[], {n, n}]},
   (1/n) (d + I d)/(0.000001 + k2)]; 
spectrum[[1, 1]] *= 0;

im[p_] := Clip[Re[InverseFourier[spectrum Exp[I p]]], {0, ∞}]^0.5

p0 = p = Sqrt[k2];

buffer = im[p0 += p];

Image[buffer // Offload, "Real32", Epilog->{
    EventHandler[AnimationFrameListener[buffer // Offload], 
      Function[Null, buffer = im[p0 += 2 p]]
    ]
}]

Spirograph-like curves arise from simple sums of rotating vectors; a tiny tweak in frequency or phase yields striking patterns. Here is my favorite example Rosetta:

Animate[ParametricPlot[{
  Power[I,-((20t)/(tt))]+3 Power[I,((20t)/(tt))]+Power[I,((20t)/(tt))]Sin[8 Pi ((20t)/(tt))/5],
  Power[I,-t]+3 Power[I,t],
  Power[I,-t]+3 Power[I,t]+Power[I,t]Sin[8 Pi t/5]
}//ReIm//Evaluate, {t,0,tt}, 
  PlotRange -> {-5,5}, PlotPoints -> 200,
  PlotStyle -> {LightGray,Default,(Hue[0.353, 0.78, 0.49])}, Axes->False,
  Epilog -> {
    {Thick,Red,Line[{ReIm[Power[I,-tt]+3 Power[I,tt]-Power[I,tt]],ReIm[Power[I,-tt]+3 Power[I,tt]+Power[I,tt]]}]}, {Thick,Circle[ReIm[Power[I,-tt]+3 Power[I,tt]+Power[I,tt]Sin[8 Pi tt/5]],0.1]}
  }, PlotPoints -> 10
],{{tt,19.9},0.01,4 5, 0.1}, Appearance -> None]

Here is an example with Plot3D

Plot3D[Sin[x] Cos[y], {x,-10,10}, {y,-10,10}][[1]];
Graphics3D[{%, Graphics3D`Materials["Glass"], Red, Sphere[{0,0,2}, 4]}, "Renderer"->"PathTracing", Axes->True]

I recently started designing a visual explanation of `Image` object in Wolfram and how to animate with it. If it works out with writing script and overall idea, I will publish a video on Youtube.

The animation is recorded in real-time and is composed from async functions of WLJS standard library (similar to Manim). The pipeline is still a bit rough and needs polishing, but we are getting there...

No JSON. No Base64. Just raw RGBA data streamed directly from the computational kernel to the GPU.

In WLJS, reassigning new pixel data to a symbol is enough to update the raster image.

Here is another demo on AnimationFramework made using low-level Graphics and async tools of WLJS.

size = 0.7;
molecules = 500;
history = Table[{-50 + i, 0.0}, {i, 0, 50}];
temperature = 0.05`;
avgs = 0;
theory = 0.634 molecules temperature / (*SpB[*)Power[size(*|*),(*|*)2](*]SpB*);

EventHandler[
  InputRange[0.01,0.1,0.01,0.05, "Label"->"T"], 
  Function[s, temperature=s; theory = 0.634 molecules temperature / (*SpB[*)Power[size(*|*),(*|*)2](*]SpB*)]
]
EventHandler[
  InputRange[0.4,2.0,0.1,size, "Label"->"Size"], 
  Function[s, size=s; theory = 0.634 molecules temperature / (*SpB[*)Power[size(*|*),(*|*)2](*]SpB*)]
]

Row[{Module[{
  contents = {
    RandomReal[{-size,size},{molecules,2}],
    {Cos[#1],Sin[#1]}& /@ RandomReal[{0,2 \[Pi]}, molecules], 
    Table[{0.5,0.5,1.}, {molecules}]
  } // Transpose, 
  data = {Table[{0,0,0}, {molecules}], Table[{0,0,0}, {molecules}]}//N, 
  indices = Range[molecules], collision = 0
},
  
    
    Graphics[
        {
            {EdgeForm[Black], GrayLevel[0.8], Rectangle[{-size, -size}//Offload, {size, size}//Offload]},
            GraphicsComplex[Offload[data[[1]]], {
                PointSize[0.01], Point[Offload[indices]]
              }, VertexColors->Offload[data[[2]]]
            ],
            EventHandler[
                AnimationFrameListener[Offload[data]],
                Function[Null,
                    
                    
                    collision = 0;
                    contents = ({#1[[1]] + #1[[2]] temperature, #1[[2]], 0.1 {0.5,1.0,1.0} + 0.90 #1[[3]]}&) /@ contents;
                    contents = (
                        If[Abs[#1[[1, 2]]] > size,
                            collision++;
                            {{#1[[1, 1]], 2 size Sign[#1[[1, 2]]] - #1[[1, 2]]}, {1, -1} #1[[2]], {1.,0.,1.}}
                            ,
                            #1
                        ]&
                    ) /@ contents;
                    
                    contents = (
                        If[Abs[#1[[1, 1]]] > size,
                            collision++;
                            {{2 size Sign[#1[[1, 1]]] - #1[[1, 1]], #1[[1, 2]]}, {-1, 1} #1[[2]], {1.,0.,1.}}
                            ,
                            #1
                        ]&
                    ) /@ contents;
                    
                    data = {First /@ contents, Last /@ contents};

                    history[[1,2]] += collision/size;
                    
                    If[avgs > 20.0,  
                      avgs=0;
                      history[[1,2]] /= 20.0;
                      history = Transpose[{history[[All,1]], RotateLeft[history[[All,2]], 1]}];
                    ];

                    avgs++;
                ]
            ]
        }, PlotRange->{{-1,1}, {-1,1}}
    ]
], Graphics[{Line[history//Offload], Red, Dashed, Line[{{-50, theory}, {0, theory}}//Offload]}, PlotRange->{{-50,0}, {0,100.0}}, TransitionType->None, ImageSize->300,Frame->True, FrameLabel->{"time", "P"}, "Controls"->False]}]

Here is a code for this little demo:

size = 1.`;
number = 500;
fps = 0.0;
time = AbsoluteTime[];

TextView[fps//Offload, "Label"->"FPS"]

Module[{
  contents = (*BB[*)(Transpose[{RandomReal[{-size,size},{number,2}],({Cos[#1],Sin[#1]}&)/@RandomReal[{0,2 \[Pi]},number], Table[{0.5,0.5,1.}, {number}]}])(*,*)(*"1:eJxTTMoPSmNmYGAo5gcSAUX5ZZkpqSn+BSWZ+XnFaYwgCRYg4ZGfk5LGBOLxAomwzNRyl9Tk/KLEkvyiYE6gSEhRYl5xQX5xajBISwhEKUhjUGlOajDYhNTEFFSlaIpYgQzXstS8ErCQX2lODgB64iTl"*)(*]BB*), 
  data = {Table[{0,0,0}, {number}],Table[{0,0,0}, {number}]}//N, 
  indices = Range[number], temperature = 0.05`, collision = 0
},
  
    
    Graphics[
        {
            GraphicsComplex[Offload[data[[1]]], {PointSize[0.01], Point[Offload[indices]]}, VertexColors->Offload[data[[2]]]]
            ,
            EventHandler[
                AnimationFrameListener[Offload[data]]
                ,
                Function[Null,
                    
                    
                    collision = 0;
                    contents = ({#1[[1]] + #1[[2]] temperature, #1[[2]], 0.1 {0.5,0.5,1.0} + 0.90 #1[[3]]}&) /@ contents;
                    contents = (
                        If[Abs[#1[[1, 2]]] > size,
                            {{#1[[1, 1]], 2 size Sign[#1[[1, 2]]] - #1[[1, 2]]}, {1, -1} #1[[2]], {1.,0.,0.}}
                            ,
                            #1
                        ]&
                    ) /@ contents;
                    
                    contents = (
                        If[Abs[#1[[1, 1]]] > size,
                            {{2 size Sign[#1[[1, 1]]] - #1[[1, 1]], #1[[1, 2]]}, {-1, 1} #1[[2]], {1.,0.,0.}}
                            ,
                            #1
                        ]&
                    ) /@ contents;
                    
                    data = {First /@ contents, Last /@ contents};
                    
                    With[{now = AbsoluteTime[]},
                      If[Random[]<0.3, fps = Round[fps 0.6 + 0.4/(now-time)]];
                      time = now;
                    ];
                ]
            ]
        }, PlotRange->{{-size,size}, {-size,size}}
    ]
]

A real-time animation based on the beautiful work of Simon Woods with a few adjustments

Basically we have a few rules for each point to follow:

• it moves 0.5% toward the centre,
• it takes a large step toward selected "friend", and a smaller step away from its "enemy".

At random times, one point picks a new "friend" and "enemy" points. Therese two are just indices. Color coding represents the speed.

Implementation is more or less described in the original post, I only optimized it for real-time animation using GraphicsComplex primitives, fixed size vertex buffer and added colors.

In this post, we attempt to solve Maxwell's equations for a 1D case with two interfaces. This work is based on John B. Schneider's Understanding the Finite-Difference Time-Domain Method, 2023.

I've never tried it in my life as a physicist, it is especially fun to add P, M (material equations), since it forces you to think in time-domain instead of frequency.

Since graphs and widgets are not easy to attach in reddit, here is a link to the full post: https://wljs.io/blog/fdtd