Pi Day 2026: Formulas, Series, and Plots for π

Introduction

  • pathWithValuesLog = MapAt[N@*Log10, pathWithValues, {All, 3}];
    ListLinePlot3D[MovingAverage[pathWithValuesLog, 200], AspectRatio -> Automatic, PlotRange -> All, ImageSize -> Large, Ticks -> None]
  • pathWithValuesLog = MapAt[N@*Log10, pathWithValues, {All, 3}];
    ListLinePlot3D[MovingAverage[pathWithValuesLog, 200], AspectRatio -> Automatic, PlotRange -> All, ImageSize -> Large, Ticks -> None]
  • pathWithValuesLog = MapAt[N@*Log10, pathWithValues, {All, 3}];
    ListLinePlot3D[MovingAverage[pathWithValuesLog, 200], AspectRatio -> Automatic, PlotRange -> All, ImageSize -> Large, Ticks -> None]
  • pathWithValuesLog = MapAt[N@*Log10, pathWithValues, {All, 3}];
    ListLinePlot3D[MovingAverage[pathWithValuesLog, 200], AspectRatio -> Automatic, PlotRange -> All, ImageSize -> Large, Ticks -> None]

1. Continued fraction approximation

The built-in Wolfram Language (WL) constant Pi (or π ) can be computed to an arbitrary high precision:

N[Pi, 60]
# 3.14159265358979323846264338327950288419716939937510582097494

Let us compare it with a continued fraction approximation. For example, using the (first) sequence line of On-line Encyclopedia of Integer Sequences (OEIS) A001203 produces π with precision 100:

s = {3, 7, 15, 1, 292, 1, 1, 1, 2, 1, 3, 1, 14, 2, 1, 1, 2, 2, 2, 2, 1, 84, 2, 1, 1, 15, 3, 13, 1, 4, 2, 6, 6, 99, 1, 2, 2, 6, 3, 5, 1, 1, 6, 8, 1, 7, 1, 2, 3, 7, 1, 2, 1, 1, 12, 1, 1, 1, 3, 1, 1, 8, 1, 1, 2, 1, 6, 1, 1, 5, 2, 2, 3, 1, 2, 4, 4, 16, 1, 161, 45, 1, 22, 1,2, 2, 1, 4, 1, 2, 24, 1, 2, 1, 3, 1, 2, 1};
N[FromContinuedFraction[s], 120]
# 3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706808656553677697242141

Here we verify the precision using Wolfram Language:

N[Pi, 200] - %
# -1.0441745026369011477*10^-100

More details can be found in Wolfram MathWorld page “Pi Continued Fraction” , [EW1].


2. Continued fraction terms plots

It is interesting to consider the plotting the terms of continued fraction terms of \pi .

First we ingest the more “pi-terms” from OEIS A001203 (20k terms):

terms = Partition[ToExpression /@ StringSplit[Import["https://oeis.org/A001203/b001203.txt"], Whitespace], 2][[All, 2]];
Length[terms]
# 20000

Here is the summary:

ResourceFunction["RecordsSummary"][terms]
1n16eusjlod5s

Here is an array plot of the first 128 terms of the continued fraction approximating \pi :

mat = IntegerDigits[terms[[1 ;; 128]], 2];
maxDigits = Max[Length /@ mat];
mat = Map[Join[Table[0, maxDigits - Length[#]], #] &, mat];
ArrayPlot[Transpose[mat], Mesh -> True, ImageSize -> 1000]
1oesdxgitoh1u

Next, we show the Pareto principle manifestation of for the continued fraction terms. First we observe that the terms a distribution similar to Benford’s law :

tallyPi = KeySort[AssociationThread @@ Transpose[Tally[terms]]][[1 ;; 16]]/Length[terms];
termsB = RandomVariate[BenfordDistribution[10], 2000];
tallyB = KeySort[AssociationThread @@ Transpose[Tally[termsB]]]/Length[termsB];
data = {tallyPi, tallyB};
data = KeySort /@ Map[KeyMap[ToExpression, #] &, data];
data2 = First /@ Values@Merge[{data[[1]], Join[AssociationThread[Keys[data[[1]]],Null], data[[2]]]}, List];
BarChart[data2,
PlotLabel -> "Pi continued fraction terms vs. Benford's law",
ChartLegends -> {"\[Pi]", "Belford's law"},
PlotTheme -> "Detailed", ImageSize -> Large]
1fyfg7jl5cjof

Here is the Pareto principle plot — ≈5% of the unique term values correspond to ≈80% of the terms:

ResourceFunction["ParetoPrinciplePlot"][
terms,
PlotLabel -> "Pareto principle for Pi continued fraction terms",
ImageSize -> Large]
1cq0xm0gz37sk

3. Classic Infinite Series

Many ways to express π as an infinite sum — some converge slowly, others surprisingly fast.

Leibniz–Gregory series (1671/ Madhava earlier)

WL implementation:

PiLeibniz[n_Integer] := Block[{},
4*Total[Table[(-1)^i/(2 i + 1), {i, 0, n - 1}]]
]
N[PiLeibniz[1000], 20]
# 3.1405926538397929260

Verify with Wolfram Language (again):

N[Pi, 100] - N[PiLeibniz[1000], 1000]
# 0.000999999750000312499046880410106913745780068595381331607486808765908475046461390362862493334446861

Nilakantha series (faster convergence):

0293dofrmrlwe

WL:

PiNilakantha[n_Integer] := Block[{},
3 + 4*Total[Table[(-1)^(i + 1)/(2 i (2 i + 1) (2 i + 2)), {i, 1, n}]]
]
N[PiNilakantha[1000], 20]
# 3.1415926533405420519
N[Pi, 40] - N[PiNilakantha[1000], 40]
# 2.49251186562514647026299317045*10^-10

3. Beautiful Products

Wallis product (1655) — elegant infinite product:

1q0c5okxvywr4

WL running product:

 p = 2.0; 
   Do[
    p *= (2 n)^2/((2 n - 1) (2 n + 1)); 
    If[Divisible[n, 100], 
     Print[Row[{n, " -> ", p/\[Pi], " relative error"}]] 
    ], 
    {n, 1, 1000}]

| 100 | -> | 0.9975155394660373 | relative error |
| 200 | -> | 0.998753895533088 | relative error |
| 300 | -> | 0.9991683995999036 | relative error |
| 400 | -> | 0.9993759752213087 | relative error |
| 500 | -> | 0.9995006243131489 | relative error |
| 600 | -> | 0.9995837669635674 | relative error |
| 700 | -> | 0.9996431757700326 | relative error |
| 800 | -> | 0.9996877439728793 | relative error |
| 900 | -> | 0.9997224150056372 | relative error |
| 1000 | -> | 0.9997501561641055 | relative error |

4. Very Fast Modern Series — Chudnovsky Algorithm

One of the fastest-converging series used in record computations:

0b32wzezevyz0

Each term adds roughly 14 correct digits.


5. Spigot Algorithms — Digits “Drip” One by One

Spigot algorithms compute decimal digits using only integer arithmetic — no floating-point errors accumulate.

The classic Rabinowitz–Wagon spigot (based on a transformed Wallis product) produces base-10 digits sequentially.

Simple (but bounded) version outline in WL:

ClearAll[PiSpigotDigits, PiSpigotString];
PiSpigotDigits[n_Integer?Positive] :=
Module[{len, a, q, x, i, j, nines = 0, predigit = 0, digits = {}},
len = Quotient[10 n, 3] + 1;
a = ConstantArray[2, len];
For[j = 1, j <= n, j++, q = 0;
For[i = len, i >= 1, i--, x = 10 a[[i]] + q i;
a[[i]] = Mod[x, 2 i - 1];
q = Quotient[x, 2 i - 1];];
a[[1]] = Mod[q, 10];
q = Quotient[q, 10];
Which[
q == 9, nines++,
q == 10,
AppendTo[digits, predigit + 1];
digits = Join[digits, ConstantArray[0, nines]];
predigit = 0;
nines = 0,
True,
AppendTo[digits, predigit];
digits = Join[digits, ConstantArray[9, nines]];
predigit = q;
nines = 0];
];
AppendTo[digits, predigit];
Take[digits, n]
];
PiSpigotString[n_Integer?Positive] := Module[{d = PiSpigotDigits[n]}, ToString[d[[2]]] <> "." <> StringJoin[ToString /@ Rest[Rest[d]]]];
PiSpigotString[40]
# "3.14159265358979323846264338327950288419"
N[Pi, 100] - ToExpression[PiSpigotString[40]]
# 0.*10^-38

6. BBP Formula — Hex Digits Without Predecessors

Bailey–Borwein–Plouffe (1995) formula lets you compute the n-th hexadecimal digit of π directly (without earlier digits):

Very popular for distributed π-hunting projects. The best known digit-extraction algorithm .

WL snippet for partial sum (base 16 sense):

ClearAll[BBPTerm, BBPPiPartial, BBPPi]
BBPTerm[k_Integer?NonNegative] := 16^-k (4/(8 k + 1) - 2/(8 k + 4) - 1/(8 k + 5) - 1/(8 k + 6));
BBPPiPartial[n_Integer?NonNegative] := Sum[BBPTerm[k], {k, 0, n}];
BBPPi[prec_Integer?Positive] :=
Module[{n},
n = Ceiling[prec/4] + 5;
N[BBPPiPartial[n], prec]
];
BBPPiPartial[10] // N[#, 20] &
# 3.1415926535897931296
BBPPi[50]
# 3.1415926535897932384626433745157614859702375522676

7. (Instead of) Conclusion

  • π contains (almost surely) every finite sequence of digits — your birthday appears infinitely often.
  • The Feynman point : six consecutive 9s starting at digit 762.
  • Memorization world record > 100,000 digits.
  • π appears in the normal distribution, quantum mechanics, random walks, Buffon’s needle problem (probability ≈ 2/π).

Let us plot a “random walk” using the terms of continued fraction of Pi — the 20k or OEIS A001203 — to determine directions:

ListLinePlot[Reverse /@ AnglePath[terms], PlotStyle -> (AbsoluteThickness[0.6]), ImageSize -> Large, Axes -> False]
0q6uxinid6l9a

Here is a bubble chart based on the path points and term values:

pathWithValues = Flatten /@ Thread[{Reverse /@ Rest[path], terms}];
gr = BubbleChart[pathWithValues, ChartStyle -> "DarkRainbow", AspectRatio -> Automatic, Frame -> False, Axes -> False, PlotTheme -> "Minimal"];
Rasterize[gr, ImageSize -> 900, ImageResolution -> 72]
0q5w8txmqf5en

Remark: The bubble sizes indicate that some of terms are fairly large, but the majority of them are relatively small.

Here is a 3D point plot with of moving average of the 3D path modified to have the logarithms of the term values:

pathWithValuesLog = MapAt[N@*Log10, pathWithValues, {All, 3}];
ListLinePlot3D[MovingAverage[pathWithValuesLog, 200], AspectRatio -> Automatic, PlotRange -> All, ImageSize -> Large, Ticks -> None]
1w4cc4bgx9odc

References

[EW1] Eric Weisstein, “Pi Continued Fraction” , Wolfram MathWorld .

Maze making using graphs

Introduction

This document (notebook) describes three ways of making mazes (or labyrinths) using graphs. The first two are based on rectangular grids; the third on a hexagonal grid.

All computational graph features discussed here are provided by the Graph functionalities of Wolfram Language.

TL;DR

Just see the maze pictures below. (And try to solve the mazes.)

Procedure outline

The first maze is made by a simple procedure which is actually some sort of cheating:

  • A regular rectangular grid graph is generated with random weights associated with its edges.
  • The (minimum) spanning tree for that graph is found.
  • That tree is plotted with exaggeratedly large vertices and edges, so the graph plot looks like a maze.
    • This is “the cheat” — the maze walls are not given by the graph.

The second maze is made “properly”:

  • Two interlacing regular rectangular grid graphs are created.
  • The second one has one less row and one less column than the first.
  • The vertex coordinates of the second graph are at the centers of the rectangles of the first graph.
  • The first graph provides the maze walls; the second graph is used to make paths through the maze.
    • In other words, to create a solvable maze.
  • Again, random weights are assigned to edges of the second graph, and a minimum spanning tree is found.
  • There is a convenient formula that allows using the spanning tree edges to remove edges from the first graph.
  • In that way, a proper maze is derived.

The third maze is again made “properly” using the procedure above with two modifications:

  • Two interlacing regular grid graphs are created: one over a hexagonal grid, the other over a triangular grid.
    • The hexagonal grid graph provides the maze walls; the triangular grid graph provides the maze paths.
  • Since the formula for wall removal is hard to derive, a more robust and universal method based on nearest neighbors is used.

Simple Maze

In this section, we create a simple, “cheating” maze.

Remark: The steps are easy to follow, given the procedure outlined in the introduction.

RandomSeed[3021];
{n, m} = {10, 25};
g = GridGraph[{n, m}];
gWeighted = Graph[VertexList[g], UndirectedEdge @@@ EdgeList[g], EdgeWeight -> RandomReal[{10, 1000}, EdgeCount[g]]];
Information[gWeighted]

0s0wsdfzitdzq

Find the spanning tree of the graph:

mazeTree = FindSpanningTree[gWeighted];

Shortest path from the first vertex (bottom-left) to the last vertex (top-right):

path = FindShortestPath[mazeTree, 1, n*m];
Length[path]

Out[]= 46

Graph plot:

simpleMaze = Graph[VertexList[mazeTree], EdgeList[mazeTree], VertexCoordinates -> GraphEmbedding[g]];
 simpleMaze2 = EdgeAdd[simpleMaze, {"start" -> 1, Max[VertexList[simpleMaze]] -> "end"}];
 Clear[vf1, ef1];
 vf1[col_?ColorQ][{xc_, yc_}, name_, {w_, h_}] := {col, EdgeForm[None],Rectangle[{xc - w, yc - h}, {xc + w, yc + h}]};
 ef1[col_?ColorQ][pts_List, e_] := {col, Opacity[1], AbsoluteThickness[22], Line[pts]};
 grCheat = GraphPlot[simpleMaze2, VertexSize -> 0.8, VertexShapeFunction -> vf1[White], EdgeShapeFunction -> ef1[White], Background -> DarkBlue, ImageSize -> 800, ImagePadding -> 0];
 range = MinMax /@ Transpose[Flatten[List @@@ Cases[grCheat, _Rectangle, \[Infinity]][[All, All]], 1]];
 Show[grCheat, PlotRange -> range]

1bc8vj9fmf5ro

The “maze” above looks like a maze because the vertices and edges are rectangular with matching sizes, and they are thicker than the spaces between them. In other words, we are cheating.

To make that cheating construction clearer, let us plot the shortest path from the bottom left to the top right and color the edges in pink (salmon) and the vertices in red:

gPath = PathGraph[path, VertexCoordinates -> GraphEmbedding[g][[path]]];
Legended[
   Show[
    grCheat, 
    Graph[gPath, VertexSize -> 0.7, VertexShapeFunction -> vf1[Red], EdgeShapeFunction -> ef1[Pink], Background -> DarkBlue, ImageSize -> 800, ImagePadding -> 0], 
    PlotRange -> range 
   ], 
   SwatchLegend[{Red, Pink, DarkBlue}, {"Shortest path vertices", "Shortest path edges", "Image background"}]]

1q29onggyuwcc

Proper Maze

proper maze is a maze given with its walls (not with the space between walls).

Remark: For didactical reasons, the maze in this section is small so that the steps—outlined in the introduction—can be easily followed.

Make two regular graphs: one for the maze walls and the other for the maze paths.

{n, m} = {6, 12};
g1 = GridGraph[{n, m}, VertexLabels -> "Name"];
g1 = VertexReplace[g1, Thread[VertexList[g1] -> Map[w @@ QuotientRemainder[# - 1, n] &, VertexList[g1]]]];
g2 = GridGraph[{n - 1, m - 1}];
g2 = VertexReplace[g2, Thread[VertexList[g2] -> Map[QuotientRemainder[# - 1, n - 1] &, VertexList[g2]]]];
g2 = Graph[g2, VertexLabels -> "Name", VertexCoordinates -> Map[# + {1, 1}/2 &, GraphEmbedding[g2]]];
Grid[{{"Wall graph", "Paths graph"}, {Information[g1], Information[g2]}}]

0t91asf2eugz2

See how the graph “interlace”:

(*Show[g1,HighlightGraph[g2,g2],ImageSize->800]*)

Maze Path Graph:

mazePath = Graph[EdgeList[g2], EdgeWeight -> RandomReal[{10, 10000}, EdgeCount[g2]]];
mazePath = FindSpanningTree[mazePath, VertexCoordinates -> Thread[VertexList[g2] -> GraphEmbedding[g2]]];
Information[mazePath]

0t91asf2eugz2

Combined Graph:

g3 = Graph[
     Join[EdgeList[g1], EdgeList[mazePath]], VertexCoordinates -> Join[Thread[VertexList[g1] -> GraphEmbedding[g1]], Thread[VertexList[mazePath] -> GraphEmbedding[mazePath]]], 
     VertexLabels -> "Name"];
Information[g3]

0mdi2hih68mqo

Plot the combined graph:

HighlightGraph[g3, mazePath, ImageSize -> 800]

1kndzl5jned4z

Remove wall edges using a formula:

g4 = Graph[g3, VertexLabels -> None]; 
  
Do[{i, j} = e[[1]]; 
      {i2, j2} = e[[2]]; 
      If[i2 < i || j2 < j, {{i2, j2}, {i, j}} = {{i, j}, {i2, j2}}]; 
      
     (*Horizontal*) 
      If[i == i2 && j < j2, 
       g4 = EdgeDelete[g4, UndirectedEdge[w[i2, j2], w[i2 + 1, j2]]] 
      ]; 
      
     (*Vertical*) 
      If[j == j2 && i < i2, 
       g4 = EdgeDelete[g4, UndirectedEdge[w[i2, j2], w[i2, j2 + 1]]] 
      ]; 
     , {e, EdgeList[mazePath]}]; 
  
Information[g4]

0s9eo0feadbo8

Plot wall graph and maze paths (maze space) graph:

HighlightGraph[g4, mazePath, ImageSize -> 800]

05ekkh85mpfro

Fancier maze presentation with rectangular vertices and edges (with matching sizes):

g5 = Subgraph[g4, VertexList[g1]];
g5 = VertexDelete[g5, {w[0, 0], w[m - 1, n - 1]}];
g6 = Graph[g5, VertexShapeFunction -> None, EdgeShapeFunction -> ({Opacity[1], DarkBlue, AbsoluteThickness[30], Line[#1]} &), ImageSize -> 800]

0arq97krotgni

Here is how a solution can found and plotted:

(*solution=FindPath[#,VertexList[#][[1]],VertexList[#][[-1]]]&@mazePath;
 Show[g6,HighlightGraph[Subgraph[mazePath,solution],Subgraph[mazePath,solution]]]*)

Here is a (more challenging to solve) maze generated with $n=12$ and $m=40$:

1tmgs2lmz563k

Hexagonal Version

Let us create another maze based on a hexagonal grid. Here are two grid graphs:

  • The first is a hexagonal grid graph representing the maze’s walls.
  • The second graph is a triangular grid graph with one fewer row and column, and shifted vertex coordinates.
{n, m} = {6, 14}*2; 
g1 = ResourceFunction["HexagonalGridGraph"][{m, n}]; 
g1 = VertexReplace[g1, Thread[VertexList[g1] -> (w[#1] & ) /@ VertexList[g1]]]; 
g2 = ResourceFunction["https://www.wolframcloud.com/obj/antononcube/DeployedResources/Function/TriangularLatticeGraph/"][{n - 1, m - 1}]; 
g2 = Graph[g2, VertexCoordinates -> (#1 + {Sqrt[3], 1} & ) /@ GraphEmbedding[g2]]; 
{Information[g1], Information[g2]}

0eyicaepipiwo
Show[g1, HighlightGraph[g2, g2], ImageSize -> 800]

0bfc3uk2c4uw3

Maze Path Graph:

mazePath = Graph[EdgeList[g2], EdgeWeight -> RandomReal[{10, 10000}, EdgeCount[g2]]];
 mazePath = FindSpanningTree[mazePath, VertexCoordinates -> Thread[VertexList[g2] -> GraphEmbedding[g2]]];
 Information[mazePath]

0937puga1ahjz

Combine the walls-maze and the maze-path graphs (i.e., make a union of them), and plot the resulting graph:

g3 = GraphUnion[g1, mazePath, VertexCoordinates -> Join[Thread[VertexList[g1] -> GraphEmbedding[g1]], Thread[VertexList[mazePath] -> GraphEmbedding[mazePath]]]];
 Information[g3]

1foiaesyk9d5s
HighlightGraph[g3, mazePath, ImageSize -> 800]

1t4t24o8zwj7p

Make a nearest neighbor points finder functor:

finder = Nearest[Thread[GraphEmbedding[g1] -> VertexList[g1]]]

045ypuvgpbrq4

Take a maze edge and its vertex points:

e = First@EdgeList[mazePath];
aMazePathCoords = Association@Thread[VertexList[mazePath] -> GraphEmbedding[mazePath]];
 points = List @@ (e /. aMazePathCoords)

17k4mshnxw0tf

Find the edge’s midpoint and the nearest wall-graph vertices:

Print["Middle edge point: ", Mean[points]]
Print["Edge to remove: ", UndirectedEdge @@ finder[Mean[points]]]

0b52fvogi84bf
1xlaj83jf90c6

Loop over all maze edges, removing wall-maze edges:

g4 = g1;
Do[
    points = Map[aMazePathCoords[#] &, List @@ e]; 
     m = Mean[points]; 
     vs = finder[m]; 
     g4 = EdgeDelete[g4, UndirectedEdge @@ vs]; 
    , {e, EdgeList[mazePath]}] 
  
Information[g4]

11uvhhgtj2da4

Here is the obtained graph

Show[g4, ImageSize -> 800]

0zih3bdnlu25c

The start and end points of the maze:

aVertexCoordinates = Association@Thread[VertexList[g4] -> GraphEmbedding[g4]];
{start, end} = Keys[Sort[aVertexCoordinates]][[{1, -1}]]

Out[]= {w[1], w[752]}

Finding the Maze Solution:

Out[]= Sequence[1, 240]

solution = FindShortestPath[mazePath, Sequence @@ Keys[Sort[aMazePathCoords]][[{1, -1}]]];
solution = PathGraph[solution, VertexCoordinates -> Lookup[aMazePathCoords, solution]];

Plot the maze:

g5 = Graph[g4, VertexShapeFunction -> None, EdgeShapeFunction -> ({Opacity[1], DarkBlue, AbsoluteThickness[8], Line[#1]} &), ImageSize -> 800];
g5 = VertexDelete[g5, {start, end}]

0lpxgk7luqu30

Here is the solution of the maze:

Show[g5, HighlightGraph[solution, solution]]


Additional Comments


References

Articles, Blog Posts

[AA1] Anton Antonov, “Day 24 — Maze Making Using Graphs”, (2025), Raku Advent Calendar at WordPress .

Functions

[AAf1] Anton Antonov, TriangularLatticeGraph, (2025), Wolfram Function Repository.

[EWf1] Eric Weisstein, TriangularGridGraph, (2020), Wolfram Function Repository.

[WRIf1] Wolfram Research, HexagonalGridGraph, (2020), Wolfram Function Repository.

Packages

[AAp1] Anton Antonov, Graph, Raku package , (2024–2025), GitHub/antononcube .

[AAp2] Anton Antonov, Math::Nearest, Raku package , (2024), GitHub/antononcube .

Primitive roots generation trails

Introduction

In this blog post (notebook) we show how to make neat chord plots of primitive roots generation sequences. Primitive roots a generators of cyclic multiplicative integer groups modulo . See the built-in Wolfram Language functions PrimitiveRoot and PrimitiveRootList. We follow the ideas presented in “Modular Arithmetic Visualizations” by Peter Karpov.

Remark: The basis representation section follows “Re-exploring the structure of Chinese character images”, [AAn1]; the movie exporting section follows “Rorschach mask animations projected over 3D surfaces”, [AAn2].

Remark: The motivation for finding and making nice primary root trails came from on working on Number theory neat examples discussed in [AAv1, AAv2].

Procedure outline

  1. Try to figure out neat examples to visualize primitive roots.
    1. Browse Wolfram Demonstrations.
    2. Search World Wide Web.
  2. Program a few versions of circle chords based visualization routines.
    1. Called chord trail plots below.
  3. Marvel at chord trail plots for larger moduli.
    1. Make multiple collections of them.
    2. Look into number of primitive roots distributions.
  4. Consider making animations of the collections.
    1. The animations should not be “chaotic” — they should have some inherent visual flow in them.
  5. Consider different ways of sorting chord trail plots.
    1. Using number theoretic arguments.
      1. Yeah, would be nice, but requires too much head scratching and LLM-ing.
    2. Convert plots to images and sort them.
      1. Some might say that that is a “brute force” application.
      2. Simple image sort does not work.
  6. Latent Semantic Analysis (LSA) application.
    1. After failing to sort the chord trail image collections by “simple” means, the idea applying LSA came to mind.
    2. LSA being, of course, a favorite technique that was applied to sorting images multiple times in the past, in different contexts, [AAn1, AAn3, AAn4, AAn5, AAv3].
    3. Also, having a nice (monadic) paclet for doing LSA, [AAp1], helps a lot.
  7. Make the animations and marvel at them.
  8. Export the chord trail plots animations for different moduli to movies and GIFs and upload them.
  9. Make a blog post (notebook).

Chord plot

It is fairly easy to program a chord plot using Graph:

(* Modulus and primivite root*)
n = 509; r = 128; 
(* Coordinates of the chords plot*)
coords = AssociationThread[Range[n], Table[{Cos[2 Pi k/(n - 1) + Pi/2], Sin[2 Pi k/(n - 1) + Pi/2]}, {k, 0, n - 1}]]; 
(* Graph edges *) 
edges = UndirectedEdge @@@ Partition[PowerMod[r, #, n] & /@ Range[n], 2, 1]; 
(*Graph*) 
Graph[edges, VertexCoordinates -> coords, VertexSize -> 0, EdgeStyle -> AbsoluteThickness[0.6]]

0ja9nttj7gvy9

We make the function ChordTrailsGraph (see Section “Setup” below) encapsulating the code above. Here is an example:

ChordTrailsGraph[509, 47, EdgeStyle -> {AbsoluteThickness[0.8`]}, 
 VertexSize -> 0, VertexStyle -> EdgeForm[None], 
 EdgeStyle -> RGBColor[0.6093762755665056`, 0.7055193578067459`, 0.8512829338493225`]]

0w93mw9n87rvn

Instead of using Graph we can just a Graphics plot — again see the definition in “Setup”. Here is an example:

ChordTrails[509, 75, "Color" -> Automatic]

05fw4gbxvzil3

Note that the modular inverse is going to produce the same chord trails plot:

Row[{
   ChordTrails[257, 3, ImageSize -> 300], 
   ChordTrails[257, ModularInverse[3, 257], ImageSize -> 300] 
  }]

0ir0c5f83rko2

Making collections of plots

Here w pick a large enough modulus, we find the primitive roots, and keep only primitive roots that will produce unique chord trail plots:

n = 509;
rs = PrimitiveRootList[n];
Length[rs]
urs = Select[rs, # <= ModularInverse[#, n] &];
urs // Length

(*252*)

(*126*)

Here is the collection using Graph:

AbsoluteTiming[
  gs1 = Association@
      Map[# ->
          ChordTrailsGraph[n, #, EdgeStyle -> {AbsoluteThickness[0.8]},
            VertexSize -> 0, VertexStyle -> EdgeForm[None],
            EdgeStyle -> RGBColor[0.6093762755665056, 0.7055193578067459, 0.8512829338493225],
            ImageSize -> 300] &, urs];
]

(*{0.771692, Null}*)

Here is a sample of plots from the collection:

KeyTake[gs1, {2, 48, 69}]

1aa33rtlvkbnh

Here is the collection using Graphics:

AbsoluteTiming[
  gs2 = Association@Map[# -> ChordTrails[n, #, ImageSize -> 300] &, urs]; 
 ]

(*{1.13483, Null}*)

Here is a sample of plots from the collection (same indexes as above):

KeyTake[gs2, {2, 48, 69}]

1qeiu9fz57as7

Remark: It looks like that using Graph is faster and produces (admittedly, with tweaking options) better looking plots.

Since we want to make an animation of chord-trail plots, we convert the collection of plots into a collection of images:

AbsoluteTiming[
  imgs = Map[Rasterize[#, "Image", RasterSize -> 500, ImageSize -> 600] &, gs2]; 
 ]

(*{15.5664, Null}*)


Generalization

The function ChordTrails can be generalized to take a (pre-computed) chords argument. Here is an example of chords plot that connects integers that are modular inverses of each other:

m = 4000;
chords = Map[If[NumericQ@Quiet@ModularInverse[#, m], {#, ModularInverse[#, m]},Nothing] &, Range[m]];
ChordTrails[m, chords, PlotStyle -> AbsoluteThickness[0.01], ImageSize -> 400]

03q03q9hobjx5

LSAMon application

In order to sort the plots we find dimension reduction basis representation of the corresponding images and sort using that representation. For more details see “Re-exploring the structure of Chinese character images”, [AAn1].

Clear[ImagePreProcessing, ImageToVector];
ImagePreProcessing[img_Image] := ColorNegate@Binarize[img, 0.9];
ImageToVector[img_Image] := Flatten[ImageData[ImagePreProcessing[img]]];
ImageToVector[img_Image, imgSize_] := Flatten[ImageData[ColorConvert[ImageResize[img, imgSize], "Grayscale"]]];
ImageToVector[___] := $Failed;

aCImages = imgs;

AbsoluteTiming[aCImageVecs = ParallelMap[ImageToVector, aCImages];]

(*{0.184429, Null}*)

SeedRandom[32];
MatrixPlot[Partition[#, ImageDimensions[aCImages[[1]]][[2]]]] & /@ RandomSample[aCImageVecs, 3]

1tavxw8a8s8c7
mat = ToSSparseMatrix[SparseArray[Values@aCImageVecs], "RowNames" -> Map[ToString, Keys[aCImageVecs]], "ColumnNames" -> Automatic]

1wjcl3g3a3wd5
SeedRandom[777];
AbsoluteTiming[
  lsaAllObj = 
    LSAMonUnit[]⟹
     LSAMonSetDocumentTermMatrix[mat]⟹
     LSAMonApplyTermWeightFunctions["None", "None", "Cosine"]⟹
     LSAMonExtractTopics["NumberOfTopics" -> 120, Method -> "SVD", "MaxSteps" -> 15, "MinNumberOfDocumentsPerTerm" -> 0]⟹
     LSAMonNormalizeMatrixProduct[Normalized -> Right]; 
 ]

(*{7.56445, Null}*)

In case you want to see the basis (we show just a sample):

lsaAllObj⟹
   LSAMonEcho[Style["Sample of the obtained basis:", Bold, Purple]]⟹
   LSAMonEchoFunctionContext[ImageAdjust[Image[Partition[#, ImageDimensions[aCImages[[1]]][[1]]], ImageSize -> Tiny]] & /@ SparseArray[#H[[{2, 11, 60}, All]]] &];

0vmbr8ahsrf68
1s2uag61bl0wu
W2 = lsaAllObj⟹LSAMonNormalizeMatrixProduct[Normalized -> Right]⟹LSAMonTakeW;
Dimensions[W2]

(*{126, 120}*)

H = lsaAllObj⟹LSAMonNormalizeMatrixProduct[Normalized -> Right]⟹LSAMonTakeH;
Dimensions[H]

(*{120, 250000}*)

AbsoluteTiming[lsClusters = FindClusters[Normal[SparseArray[W2]] -> RowNames[W2], 40, Method -> {"KMeans"}];]
Length@lsClusters
ResourceFunction["RecordsSummary"][Length /@ lsClusters]

(*{0.2576, Null}*)

(*40*)

0i5ilivzw0nl5
matPixels = WeightTermsOfSSparseMatrix[lsaAllObj⟹LSAMonTakeWeightedDocumentTermMatrix, "IDF", "None", "Cosine"];
matTopics = WeightTermsOfSSparseMatrix[lsaAllObj⟹LSAMonNormalizeMatrixProduct[Normalized -> Left]⟹LSAMonTakeW, "None", "None", "Cosine"];

SeedRandom[33];
ind = RandomChoice[Keys[aCImages]];
imgTest = ImagePreProcessing@aCImages[ind];
matImageTest = ToSSparseMatrix[SparseArray@List@ImageToVector[imgTest, ImageDimensions[aCImages[[1]]]], "RowNames" -> Automatic, "ColumnNames" -> Automatic];
(*imgTest*)

H = lsaAllObj⟹LSAMonNormalizeMatrixProduct[Normalized -> Right]⟹LSAMonTakeH;
lsBasis = ImageAdjust[Image[Partition[#, ImageDimensions[aCImages[[1]]][[1]]]]] & /@ SparseArray[H];

matReprsentation = lsaAllObj⟹LSAMonRepresentByTopics[matImageTest]⟹LSAMonTakeValue;
lsCoeff = Normal@SparseArray[matReprsentation[[1, All]]];
ListPlot[MapIndexed[Tooltip[#1, lsBasis[[#2[[1]]]]] &, lsCoeff], Filling -> Axis, PlotRange -> All]

vecReprsentation = lsCoeff . SparseArray[H];
reprImg = Image[Unitize@Clip[#, {0.45, 1}, {0, 1}] &@Rescale[Partition[vecReprsentation, ImageDimensions[aCImages[[1]]][[1]]]]];
GridTableForm[Binarize@Show[#, ImageSize -> 350] & /@ {imgTest, reprImg}, TableHeadings -> {"Test", "Approximated"}]

19gvpmjp7dx8d
W = lsaAllObj⟹LSAMonNormalizeMatrixProduct[Normalized -> Left]⟹LSAMonTakeW;
Dimensions[W]

(*{126, 120}*)

aWVecs = KeyMap[ToExpression, AssociationThread[RowNames[W], Normal[SparseArray[W]]]];

ListPlot[Values@aWVecs[[1 ;; 3]], Filling -> Axis, PlotRange -> All]

0ajyn6ixlitgd
aWVecs2 = Sort[aWVecs];

aWVecs3 = aWVecs[[Ordering[Values@aWVecs]]];

Animate sorted

Here we make the animation of sorted chord trail plots:

ListAnimate[Join[Values[KeyTake[gs, Keys[aWVecs3]]], Reverse@Values[KeyTake[gs, Keys[aWVecs3]]]], DefaultDuration -> 24]

Playing the link to an uploaded movie:

Video["https://www.wolframcloud.com/obj/25b58db2-16f0-4148-9498-d73062387ebb"]


Export

Remark: The code below follows “Rorschach mask animations projected over 3D surfaces”.

Remark: The animations are exported in the subdirectory “AnimatedGIFs”.

Export to MP4 (white background)

lsExportImgs = Join[Values[KeyTake[imgs, Keys[aWVecs2]]], Reverse@Values[KeyTake[imgs, Keys[aWVecs2]]]];

AbsoluteTiming[
  Export[FileNameJoin[{NotebookDirectory[], "AnimatedGIFs", "PrimitiveRoots-" <> ToString[n] <> ".mp4"}], lsExportImgs, "MP4","DisplayDurations" -> 0.05]; 
 ]

Export to GIF (black background)

AbsoluteTiming[
  lsExportImgs2 = ColorNegate[ImageEffect[#, "Decolorization"]] & /@ Values[KeyTake[imgs, Keys[aWVecs2]]]; 
 ]

lsExportImgs2 = Join[lsExportImgs2, Reverse@lsExportImgs2];
lsExportImgs2 // Length

lsExportImgs2[[12]]

AbsoluteTiming[
  Export[FileNameJoin[{NotebookDirectory[], "AnimatedGIFs", "PrimitiveRoots-" <> ToString[n] <> ".gif"}], lsExportImgs2, "GIF", "AnimationRepetitions" -> Infinity, "DisplayDurations" -> 0.05]; 
 ]

Optionally, open the animations directory:

(*FileNameJoin[{NotebookDirectory[],"AnimatedGIFs"}]//SystemOpen*)


Setup

Load paclets

Needs["AntonAntonov`SSparseMatrix`"];
Needs["AntonAntonov`MonadicLatentSemanticAnalysis`"];
Needs["AntonAntonov`MonadicSparseMatrixRecommender`"];
Needs["AntonAntonov`OutlierIdentifiers`"];
Needs["AntonAntonov`DataReshapers`"];

Chord plots definitions

Clear[ChordTrailsGraph];
Options[ChordTrailsGraph] = Options[Graph];
ChordTrailsGraph[n_Integer, r_Integer, opts : OptionsPattern[]] := 
   Block[{coords, edges, g}, 
    coords = AssociationThread[Range[n], Table[{Cos[2 Pi k/(n - 1) + Pi/2], Sin[2 Pi k/(n - 1) + Pi/2]}, {k, 0, n - 1}]]; 
    edges = UndirectedEdge @@@ Partition[PowerMod[r, #, n] & /@ Range[n], 2, 1]; 
    g = Graph[edges, opts, VertexCoordinates -> coords]; 
    g 
   ];

Clear[ChordTrails];
Options[ChordTrails] = Join[{"Color" -> RGBColor[0.4659039108257499, 0.5977704831063181, 0.7964303267504351], PlotStyle -> {}}, Options[Graphics]];
ChordTrails[n_Integer, r_Integer, opts : OptionsPattern[]] :=
  Block[{chords},
   chords = Partition[PowerMod[r, #, n] & /@ Range[n], 2, 1];
   ChordTrails[n, chords, opts]
  ];
ChordTrails[n_Integer, chordsArg : {{_?IntegerQ, _?IntegerQ} ..}, opts : OptionsPattern[]] :=
  Block[{chords = chordsArg, color, plotStyle, coords},
   
   color = OptionValue[ChordTrails, "Color"];
   If[TrueQ[color === Automatic], 
    color = RGBColor[
     0.4659039108257499, 0.5977704831063181, 0.7964303267504351]];
   plotStyle = OptionValue[ChordTrails, PlotStyle];
   If[TrueQ[plotStyle === Automatic], plotStyle = {}];
   plotStyle = Flatten[{plotStyle}];
   
   coords = 
    AssociationThread[Range[n], 
     Table[{Cos[2 Pi k/(n - 1) + Pi/2], Sin[2 Pi k/(n - 1) + Pi/2]}, {k, 0, n - 1}]];
   chords = chords /. {i_Integer :> coords[[i]]};
   Which[
    ColorQ[color],
    Graphics[{Sequence @@ plotStyle, color, Line[chords]}, 
     FilterRules[{opts}, Options[Graphics]]],
    TrueQ[Head[color] === ColorDataFunction],
    Graphics[{Sequence @@ plotStyle, 
      MapIndexed[{color[#2[[1]]/Length[chords]], Line[#1]} &, chords]},
      FilterRules[{opts}, Options[Graphics]]],
    True,
    Echo["Unknown color spec.", "GroupClassChords:"];
    $Failed
    ]
   ];

References

Articles, posts

[PK1] Peter Karpov, “Modular Arithmetic Visualizations”, (2016), Inversed.ru.

Notebooks

[AAn1] Anton Antonov, “Re-exploring the structure of Chinese character images”, (2022), Wolfram Community.

[AAn2] Anton Antonov,  “Rorschach mask animations projected over 3D surfaces”, (2022), Wolfram Community.

[AAn3] Anton Antonov, “Handwritten Arabic characters classifiers comparison”, (2022), Wolfram Community.

[AAn4] Anton Antonov, “LSA methods comparison over random mandalas deconstruction — WL”, (2022), Wolfram Community.

[AAn5] Anton Antonov, “LSA methods comparison over random mandalas deconstruction — Python”, (2022), Wolfram Community.

Paclets

[AAp1] Anton Antonov, “MonadicLatentSemanticAnalysis”, (2023), Wolfram Language Paclet Repository.

Videos

[AAv1] Anton Antonov, “Number theory neat examples in Raku (Set 1)”, (2025), YouTube/@AAA4prediction.

[AAv2] Anton Antonov, “Number theory neat examples in Raku (Set 2)”, (2025), YouTube/@AAA4prediction.

[AAv3] Anton Antonov, “Random Mandalas Deconstruction in R, Python, and Mathematica (Greater Boston useR Meetup, Feb 2022)”, (2022), YouTube/@AAA4prediction.

Doomsday clock parsing and plotting

Introduction

The Doomsday Clock is a symbolic timepiece maintained by the Bulletin of the Atomic Scientists (BAS) since 1947. It represents how close humanity is perceived to be to global catastrophe, primarily nuclear war but also including climate change and biological threats. The clock’s hands are set annually to reflect the current state of global security; midnight signifies theoretical doomsday.

In this notebook we consider two tasks:

  • Parsing of Doomsday Clock reading statements
  • Evolution of Doomsday Clock times
    • We extract relevant Doomsday Clock timeline data from the corresponding Wikipedia page.
      • (Instead of using a page from BAS.)
    • We show how timeline data from that Wikipedia page can be processed with “standard” Wolfram Language (WL) functions and with LLMs.
    • The result plot shows the evolution of the minutes to midnight.
      • The plot could show trends, highlighting significant global events that influenced the clock setting.
      • Hence, we put in informative callouts and tooltips.

The data extraction and visualization in the notebook serve educational purposes or provide insights into historical trends of global threats as perceived by experts. We try to make the ingestion and processing code universal and robust, suitable for multiple evaluations now or in the (near) future.

Remark: Keep in mind that the Doomsday Clock is a metaphor and its settings are not just data points but reflections of complex global dynamics (by certain experts and a board of sponsors.)

Remark: Currently (2024-12-30) Doomsday Clock is set at 90 seconds before midnight.

Data ingestion

Here we ingest the Doomsday Clock timeline page and show corresponding statistics:

url = "https://thebulletin.org/doomsday-clock/timeline/";
txtEN = Import[url, "Plaintext"];
TextStats[txtEN]

(*<|"Characters" -> 77662, "Words" -> 11731, "Lines" -> 1119|>*)

By observing the (plain) text of that page we see the Doomsday Clock time setting can be extracted from the sentence(s) that begin with the following phrase:

startPhrase = "Bulletin of the Atomic Scientists";
sentence = Select[Map[StringTrim, StringSplit[txtEN, "\n"]], StringStartsQ[#, startPhrase] &] // First

(*"Bulletin of the Atomic Scientists, with a clock reading 90 seconds to midnight"*)

Grammar and parsers

Here is a grammar in Extended Backus-Naur Form (EBNF) for parsing Doomsday Clock statements:

ebnf = "
<TOP> = <clock-reading>  ;
<clock-reading> = <opening> , ( <minutes> | [ <minutes> , [ 'and' | ',' ] ] , <seconds> ) , 'to' , 'midnight' ;
<opening> = [ { <any> } ] , 'clock' , [ 'is' ] , 'reading' ; 
<any> = '_String' ;
<minutes> = <integer> <& ( 'minute' | 'minutes' )  <@ \"Minutes\"->#&;
<seconds> = <integer> <& ( 'second' | 'seconds' ) <@ \"Seconds\"->#&;
<integer> = '_?IntegerQ' ;";

Remark: The EBNF grammar above can be obtained with LLMs using a suitable prompt with example sentences. (We do not discuss that approach further in this notebook.)

Here the parsing functions are generated from the EBNF string above:

ClearAll["p*"]
res = GenerateParsersFromEBNF[ParseToEBNFTokens[ebnf]];
res // LeafCount

(*375*)

We must redefine the parser pANY (corresponding to the EBNF rule “”) in order to prevent pANY of gobbling the word “clock” and in that way making the parser pOPENING fail.

pANY = ParsePredicate[StringQ[#] && # != "clock" &];

Here are random sentences generated with the grammar:

SeedRandom[32];
GrammarRandomSentences[GrammarNormalize[ebnf], 6] // Sort // ColumnForm

54jfnd 9y2f clock is reading 46 second to midnight
clock is reading 900 minutes to midnight
clock is reading 955 second to midnight
clock reading 224 minute to midnight
clock reading 410 minute to midnight
jdsf5at clock reading 488 seconds to midnight

Verifications of the (sub-)parsers:

pSECONDS[{"90", "seconds"}]

(*{{{}, "Seconds" -> 90}}*)

pOPENING[ToTokens@"That doomsday clock is reading"]

(*{{{}, {{"That", "doomsday"}, {"clock", {"is", "reading"}}}}}*)

Here the “top” parser is applied:

str = "the doomsday clock is reading 90 seconds to midnight";
pTOP[ToTokens@str]

(*{{{}, {{{"the", "doomsday"}, {"clock", {"is", "reading"}}}, {{{}, "Seconds" -> 90}, {"to", "midnight"}}}}}*)

Here the sentence extracted above is parsed and interpreted into an association with keys “Minutes” and “Seconds”:

aDoomReading = Association@Cases[Flatten[pTOP[ToTokens@sentence]], _Rule]

(*<|"Seconds" -> 90|>*)

Plotting the clock

Using the interpretation derived above here we make a list suitable for ClockGauge:

clockShow = DatePlus[{0, 0, 0, 12, 0, 0}, {-(Lookup[aDoomReading, "Minutes", 0]*60 + aDoomReading["Seconds"]), "Seconds"}]

(*{-2, 11, 30, 11, 58, 30}*)

In that list, plotting of a Doomsday Clock image (or gauge) is trivial.

ClockGauge[clockShow, GaugeLabels -> Automatic]

Let us define a function that makes the clock-gauge plot for a given association.

Clear[DoomsdayClockGauge];
Options[DoomsdayClockGauge] = Options[ClockGauge];
DoomsdayClockGauge[m_Integer, s_Integer, opts : OptionsPattern[]] := DoomsdayClockGauge[<|"Minutes" -> m, "Seconds" -> s|>, opts];
DoomsdayClockGauge[a_Association, opts : OptionsPattern[]] :=
  Block[{clockShow},
   clockShow = DatePlus[{0, 0, 0, 12, 0, 0}, {-(Lookup[a, "Minutes", 0]*60 + Lookup[a, "Seconds", 0]), "Seconds"}];
   ClockGauge[clockShow, opts, GaugeLabels -> Placed[Style["Doomsday\nclock", RGBColor[0.7529411764705882, 0.7529411764705882, 0.7529411764705882], FontFamily -> "Krungthep"], Bottom]]
   ];

Here are examples:

Row[{
   DoomsdayClockGauge[17, 0], 
   DoomsdayClockGauge[1, 40, GaugeLabels -> Automatic, PlotTheme -> "Scientific"], 
   DoomsdayClockGauge[aDoomReading, PlotTheme -> "Marketing"] 
  }]

More robust parsing

More robust parsing of Doomsday Clock statements can be obtained in these three ways:

  • “Fuzzy” match of words
    • For misspellings like “doomsdat” instead of “doomsday.”
  • Parsing of numeric word forms.
    • For statements, like, “two minutes and twenty five seconds.”
  • Delegating the parsing to LLMs when grammar parsing fails.

Fuzzy matching

The parser ParseFuzzySymbol can be used to handle misspellings (via EditDistance):

pDD = ParseFuzzySymbol["doomsday", 2];
lsPhrases = {"doomsdat", "doomsday", "dumzday"};
ParsingTestTable[pDD, lsPhrases]

In order to include the misspelling handling into the grammar we manually rewrite the grammar. (The grammar is small, so, it is not that hard to do.)

pANY = ParsePredicate[StringQ[#] && EditDistance[#, "clock"] > 1 &];
pOPENING = ParseOption[ParseMany[pANY]]⊗ParseFuzzySymbol["clock", 1]⊗ParseOption[ParseSymbol["is"]]⊗ParseFuzzySymbol["reading", 2];
pMINUTES = "Minutes" -> # &⊙(pINTEGER ◁ ParseFuzzySymbol["minutes", 3]);
pSECONDS = "Seconds" -> # &⊙(pINTEGER ◁ ParseFuzzySymbol["seconds", 3]);
pCLOCKREADING = Cases[#, _Rule, Infinity] &⊙(pOPENING⊗(pMINUTES⊕ParseOption[pMINUTES⊗ParseOption[ParseSymbol["and"]⊕ParseSymbol["&"]⊕ParseSymbol[","]]]⊗pSECONDS)⊗ParseSymbol["to"]⊗ParseFuzzySymbol["midnight", 2]);

Here is a verification table with correct- and incorrect spellings:

lsPhrases = {
    "doomsday clock is reading 2 seconds to midnight", 
    "dooms day cloc is readding 2 minute and 22 sekonds to mildnight"};
ParsingTestTable[pCLOCKREADING, lsPhrases, "Layout" -> "Vertical"]

Parsing of numeric word forms

One way to make the parsing more robust is to implement the ability to parse integer names (or numeric word forms) not just integers.

Remark: For a fuller discussion — and code — of numeric word forms parsing see the tech note “Integer names parsing” of the paclet “FunctionalParsers”, [AAp1].

First, we make an association that connects integer names with corresponding integer values

aWordedValues = Association[IntegerName[#, "Words"] -> # & /@ Range[0, 100]];
aWordedValues = KeyMap[StringRiffle[StringSplit[#, RegularExpression["\\W"]], " "] &, aWordedValues];
Length[aWordedValues]

(*101*)

Here is how the rules look like:

aWordedValues[[1 ;; -1 ;; 20]]

(*<|"zero" -> 0, "twenty" -> 20, "forty" -> 40, "sixty" -> 60, "eighty" -> 80, "one hundred" -> 100|>*)

Here we program the integer names parser:

pUpTo10 = ParseChoice @@ Map[ParseSymbol[IntegerName[#, {"English", "Words"}]] &, Range[0, 9]];
p10s = ParseChoice @@ Map[ParseSymbol[IntegerName[#, {"English", "Words"}]] &, Range[10, 100, 10]];
pWordedInteger = ParseApply[aWordedValues[StringRiffle[Flatten@{#}, " "]] &, p10s\[CircleTimes]pUpTo10\[CirclePlus]p10s\[CirclePlus]pUpTo10];

Here is a verification table of that parser:

lsPhrases = {"three", "fifty seven", "thirti one"};
ParsingTestTable[pWordedInteger, lsPhrases]

There are two parsing results for “fifty seven”, because pWordedInteger is defined with p10s⊗pUpTo10⊕p10s… . This can be remedied by using ParseJust or ParseShortest:

lsPhrases = {"three", "fifty seven", "thirti one"};
ParsingTestTable[ParseJust@pWordedInteger, lsPhrases]

Let us change pINTEGER to parse both integers and integer names:

pINTEGER = (ToExpression\[CircleDot]ParsePredicate[StringMatchQ[#, NumberString] &])\[CirclePlus]pWordedInteger;
lsPhrases = {"12", "3", "three", "forty five"};
ParsingTestTable[pINTEGER, lsPhrases]

Let us try the new parser using integer names for the clock time:

str = "the doomsday clock is reading two minutes and forty five seconds to midnight";
pTOP[ToTokens@str]

(*{{{}, {"Minutes" -> 2, "Seconds" -> 45}}}*)

Enhance with LLM parsing

There are multiple ways to employ LLMs for extracting “clock readings” from arbitrary statements for Doomsday Clock readings, readouts, and measures. Here we use LLM few-shot training:

flop = LLMExampleFunction[{
    "the doomsday clock is reading two minutes and forty five seconds to midnight" -> "{\"Minutes\":2, \"Seconds\": 45}", 
    "the clock of the doomsday gives 92 seconds to midnight" -> "{\"Minutes\":0, \"Seconds\": 92}", 
    "The bulletin atomic scienist maybe is set to a minute an 3 seconds." -> "{\"Minutes\":1, \"Seconds\": 3}" 
   }, "JSON"]

Here is an example invocation:

flop["Maybe the doomsday watch is at 23:58:03"]

(*{"Minutes" -> 1, "Seconds" -> 57}*)

The following function combines the parsing with the grammar and the LLM example function — the latter is used for fallback parsing:

Clear[GetClockReading];
GetClockReading[st_String] := 
   Block[{op}, 
    op = ParseJust[pTOP][ToTokens[st]]; 
    Association@
     If[Length[op] > 0 && op[[1, 1]] === {}, 
      Cases[op, Rule], 
     (*ELSE*) 
      flop[st] 
     ] 
   ];

Robust parser demo

Here is the application of the combine function above over a certain “random” Doomsday Clock statement:

s = "You know, sort of, that dooms-day watch is 1 and half minute be... before the big boom. (Of doom...)";
GetClockReading[s]

(*<|"Minutes" -> 1, "Seconds" -> 30|>*)

Remark: The same type of robust grammar-and-LLM combination is explained in more detail in the video “Robust LLM pipelines (Mathematica, Python, Raku)”, [AAv1]. (See, also, the corresponding notebook [AAn1].)

Timeline

In this section we extract Doomsday Clock timeline data and make a corresponding plot.

Parsing page data

Instead of using the official Doomsday clock timeline page we use Wikipedia:

url = "https://en.wikipedia.org/wiki/Doomsday_Clock";
data = Import[url, "Data"];

Get timeline table:

tbl = Cases[data, {"Timeline of the Doomsday Clock [ 13 ] ", x__} :> x, Infinity] // First;

Show table’s columns:

First[tbl]

(*{"Year", "Minutes to midnight", "Time ( 24-h )", "Change (minutes)", "Reason", "Clock"}*)

Make a dataset:

dsTbl = Dataset[Rest[tbl]][All, AssociationThread[{"Year", "MinutesToMidnight", "Time", "Change", "Reason"}, #] &];
dsTbl = dsTbl[All, Append[#, "Date" -> DateObject[{#Year, 7, 1}]] &];
dsTbl[[1 ;; 4]]

Here is an association used to retrieve the descriptions from the date objects:

aDateToDescr = Normal@dsTbl[Association, #Date -> BreakStringIntoLines[#Reason] &];

Using LLM-extraction instead

Alternatively, we can extract the Doomsday Clock timeline using LLMs. Here we get the plaintext of the Wikipedia page and show statistics:

txtWk = Import[url, "Plaintext"];
TextStats[txtWk]

(*<|"Characters" -> 43623, "Words" -> 6431, "Lines" -> 315|>*)

Here we get the Doomsday Clock timeline table from that page in JSON format using an LLM:

res = 
  LLMSynthesize[{
    "Give the time table of the doomsday clock as a time series that is a JSON array.", 
    "Each element of the array is a dictionary with keys 'Year', 'MinutesToMidnight', 'Time', 'Description'.", 
    txtWk, 
    LLMPrompt["NothingElse"]["JSON"] 
   }, 
   LLMEvaluator -> LLMConfiguration[<|"Provider" -> "OpenAI", "Model" -> "gpt-4o", "Temperature" -> 0.4, "MaxTokens" -> 5096|>] 
  ]

(*"```json[{\"Year\": 1947, \"MinutesToMidnight\": 7, \"Time\": \"23:53\", \"Description\": \"The initial setting of the Doomsday Clock.\"},{\"Year\": 1949, \"MinutesToMidnight\": 3, \"Time\": \"23:57\", \"Description\": \"The Soviet Union tests its first atomic bomb, officially starting the nuclear arms race.\"}, ... *)

Post process the LLM result:

res2 = ToString[res, CharacterEncoding -> "UTF-8"];
res3 = StringReplace[res2, {"```json", "```"} -> ""];
res4 = ImportString[res3, "JSON"];
res4[[1 ;; 3]]

(*{{"Year" -> 1947, "MinutesToMidnight" -> 7, "Time" -> "23:53", "Description" -> "The initial setting of the Doomsday Clock."}, {"Year" -> 1949, "MinutesToMidnight" -> 3, "Time" -> "23:57", "Description" -> "The Soviet Union tests its first atomic bomb, officially starting the nuclear arms race."}, {"Year" -> 1953, "MinutesToMidnight" -> 2, "Time" -> "23:58", "Description" -> "The United States and the Soviet Union test thermonuclear devices, marking the closest approach to midnight until 2020."}}*)

Make a dataset with the additional column “Date” (having date-objects):

dsDoomsdayTimes = Dataset[Association /@ res4];
dsDoomsdayTimes = dsDoomsdayTimes[All, Append[#, "Date" -> DateObject[{#Year, 7, 1}]] &];
dsDoomsdayTimes[[1 ;; 4]]

Here is an association that is used to retrieve the descriptions from the date objects:

aDateToDescr2 = Normal@dsDoomsdayTimes[Association, #Date -> #Description &];

Remark: The LLM derived descriptions above are shorter than the descriptions in the column “Reason” of the dataset obtained parsing the page data. For the plot tooltips below we use the latter.

Timeline plot

In order to have informative Doomsday Clock evolution plot we obtain and partition dataset’s time series into step-function pairs:

ts0 = Normal@dsDoomsdayTimes[All, {#Date, #MinutesToMidnight} &];
ts2 = Append[Flatten[MapThread[Thread[{#1, #2}] &, {Partition[ts0[[All, 1]], 2, 1], Most@ts0[[All, 2]]}], 1], ts0[[-1]]];

Here are corresponding rule wrappers indicating the year and the minutes before midnight:

lbls = Map[Row[{#Year, Spacer[3], "\n", IntegerPart[#MinutesToMidnight], Spacer[2], "m", Spacer[2], Round[FractionalPart[#MinutesToMidnight]*60], Spacer[2], "s"}] &, Normal@dsDoomsdayTimes];
lbls = Map[If[#[[1, -3]] == 0, Row@Take[#[[1]], 6], #] &, lbls];

Here the points “known” by the original time series are given callouts:

aRules = Association@MapThread[#1 -> Callout[Tooltip[#1, aDateToDescr[#1[[1]]]], #2] &, {ts0, lbls}];
ts3 = Lookup[aRules, Key[#], #] & /@ ts2;

Finally, here is the plot:

DateListPlot[ts3, 
  PlotStyle -> Directive[{Thickness[0.007`], Orange}],
  Epilog -> {PointSize[0.01`], Black, Point[ts0]}, 
  PlotLabel -> Row[(Style[#1, FontSize -> 16, FontColor -> Black, FontFamily -> "Verdana"] &) /@ {"Doomsday clock: minutes to midnight,", Spacer[3], StringRiffle[MinMax[Normal[dsDoomsdayTimes[All, "Year"]]], "-"]}], 
  FrameLabel -> {"Year", "Minutes to midnight"}, 
  Background -> GrayLevel[0.94`], Frame -> True, 
  FrameTicks -> {{Automatic, (If[#1 == 0, {0, Style["00:00", Red]}, {#1, Row[{"23:", 60 - #1}]}] &) /@ Range[0, 17]}, {Automatic, Automatic}}, GridLines -> {None, All},
  AspectRatio -> 1/3, ImageSize -> 1200
]

Remark: By hovering with the mouse over the black points the corresponding descriptions can be seen. We considered using clock-gauges as tooltips, but showing clock-settings reasons is more informative.

Remark: The plot was intentionally made to resemble the timeline plot in Doomsday Clock’s Wikipedia page.

Conclusion

As expected, parsing, plotting, or otherwise processing the Doomsday Clock settings and statements are excellent didactic subjects for textual analysis (or parsing) and temporal data visualization. The visualization could serve educational purposes or provide insights into historical trends of global threats as perceived by experts. (Remember, the clock’s settings are not just data points but reflections of complex global dynamics.)

One possible application of the code in this notebook is to make a “web service“ that gives clock images with Doomsday Clock readings. For example, click on this button:

Setup

Needs["AntonAntonov`FunctionalParsers`"]

Clear[TextStats];
TextStats[s_String] := AssociationThread[{"Characters", "Words", "Lines"}, Through[{StringLength, Length@*TextWords, Length@StringSplit[#, "\n"] &}[s]]];

BreakStringIntoLines[str_String, maxLength_Integer : 60] := Module[
    {words, lines, currentLine}, 
    words = StringSplit[StringReplace[str, RegularExpression["\\v+"] -> " "]]; 
    lines = {}; 
    currentLine = ""; 
    Do[
       If[StringLength[currentLine] + StringLength[word] + 1 <= maxLength, 
          currentLine = StringJoin[currentLine, If[currentLine === "", "", " "], word], 
          AppendTo[lines, currentLine]; 
          currentLine = word; 
        ], 
       {word, words} 
     ]; 
    AppendTo[lines, currentLine]; 
    StringJoin[Riffle[lines, "\n"]] 
  ]

References

Articles, notebooks

[AAn1] Anton Antonov, “Making robust LLM computational pipelines from software engineering perspective”, (2024), Wolfram Community.

Paclets

[AAp1] Anton Antonov, “FunctionalParsers”, (2023), Wolfram Language Paclet Repository.

Videos

[AAv1] Anton Antonov, “Robust LLM pipelines (Mathematica, Python, Raku)”, (2024), YouTube/@AAA4prediction.

Robust LLM pipelines

… or “Making Robust LLM Computational Pipelines from Software Engineering Perspective”

Abstract

Large Language Models (LLMs) are powerful tools with diverse capabilities, but from Software Engineering (SE) Point Of View (POV) they are unpredictable and slow. In this presentation we consider five ways to make more robust SE pipelines that include LLMs. We also consider a general methodological workflow for utilizing LLMs in “every day practice.”

Here are the five approaches we consider:

  1. DSL for configuration-execution-conversion
    • Infrastructural, language-design level solution
  2. Detailed, well crafted prompts
    • AKA “Prompt engineering”
  3. Few-shot training with examples
  4. Via a Question Answering System (QAS) and code templates
  5. Grammar-LLM chain of responsibility
  6. Testings with data types and shapes over multiple LLM results

Compared to constructing SE pipelines, Literate Programming (LP) offers a dual or alternative way to use LLMs. For that it needs support and facilitation of:

  • Convenient LLM interaction (or chatting)
  • Document execution (weaving and tangling)

The discussed LLM workflows methodology is supported in Python, Raku, Wolfram Language (WL). The support in R is done via Python (with “reticulate”, [TKp1].)

The presentation includes multiple examples and showcases.

Modeling of the LLM utilization process is hinted but not discussed.

Here is a mind-map of the presentation:

Here are the notebook used in the presentation:


General structure of LLM-based workflows

All systematic approaches of unfolding and refining workflows based on LLM functions, will include several decision points and iterations to ensure satisfactory results.

This flowchart outlines such a systematic approach:


References

Articles, blog posts

[AA1] Anton Antonov, “Workflows with LLM functions”, (2023), RakuForPrediction at WordPress.

Notebooks

[AAn1] Anton Antonov, “Workflows with LLM functions (in Raku)”, (2023), Wolfram Community.

[AAn2] Anton Antonov, “Workflows with LLM functions (in Python)”, (2023), Wolfram Community.

[AAn3] Anton Antonov, “Workflows with LLM functions (in WL)”, (2023), Wolfram Community.

Packages

Raku

[AAp1] Anton Antonov, LLM::Functions Raku package, (2023-2024), GitHub/antononcube. (raku.land)

[AAp2] Anton Antonov, LLM::Prompts Raku package, (2023-2024), GitHub/antononcube. (raku.land)

[AAp3] Anton Antonov, Jupyter::Chatbook Raku package, (2023-2024), GitHub/antononcube. (raku.land)

Python

[AAp4] Anton Antonov, LLMFunctionObjects Python package, (2023-2024), PyPI.org/antononcube.

[AAp5] Anton Antonov, LLMPrompts Python package, (2023-2024), GitHub/antononcube.

[AAp6] Anton Antonov, JupyterChatbook Python package, (2023-2024), GitHub/antononcube.

[MWp1] Marc Wouts, jupytext Python package, (2021-2024), GitHub/mwouts.

R

[TKp1] Tomasz Kalinowski, Kevin Ushey, JJ Allaire, RStudio, Yuan Tang, reticulate R package, (2016-2024)

Videos

[AAv1] Anton Antonov, “Robust LLM pipelines (Mathematica, Python, Raku)”, (2024), YouTube/@AAA4Predictions.

[AAv2] Anton Antonov, “Integrating Large Language Models with Raku”, (2023), The Raku Conference 2023 at YouTube.

Age at creation for programming languages stats

Introduction

In this blog post (notebook) we ingest programming languages creation data from Programming Language DataBase” and visualize several statistics of it.

We do not examine the data source and we do not want to reason too much about the data using the stats. We started this notebook by just wanting to make the bubble charts (both 2D and 3D.) Nevertheless, we are tempted to say and justify statements like:

  • Pareto holds, as usual.
  • Language creators tend to do it more than once.
  • Beware the Second system effect.

References

Here are reference links with explanations and links to dataset files:


Data ingestion

Here we get the TSC file with Wolfram Function Repository (WFR) function ImportCSVToDataset:

url = "https://pldb.io/posts/age.tsv";
dsData = ResourceFunction["ImportCSVToDataset"][url, "Dataset", "FieldSeparators" -> "\t"];
dsData[[1 ;; 4]]

Here we summarize the data using the WFR function RecordsSummary:

ResourceFunction["RecordsSummary"][dsData, "MaxTallies" -> 12]

Here is a list of languages we use to “get orientated” in the plots below:

lsFocusLangs = {"C++", "Fortran", "Java", "Mathematica", "Perl 6", "Raku", "SQL", "Wolfram Language"};

Here we find the most important tags (used in the plots below):

lsTopTags = ReverseSortBy[Tally[Normal@dsData[All, "tags"]], Last][[1 ;; 7, 1]]

(*{"pl", "textMarkup", "dataNotation", "grammarLanguage", "queryLanguage", "stylesheetLanguage", "protocol"}*)

Here we add the column “group” based on the focus languages and most important tags:

dsData = dsData[All, Append[#, "group" -> Which[MemberQ[lsFocusLangs, #id], "focus", MemberQ[lsTopTags, #tags], #tags, True, "other"]] &];

Distributions

Here are the distributions of the variables/columns:

  • age at creation
    • i.e. “How old was the creator?”
  • appeared”
    • i.e. “In what year the programming language was proclaimed?”
Association @ Map[# -> Histogram[Normal@dsData[All, #], 20, "Probability", Sequence[ImageSize -> Medium, PlotTheme -> "Detailed"]] &, {"ageAtCreation", "appeared"}]

Here are corresponding Box-Whisker plots together with tables of their statistics:

aBWCs = Association@
Map[# -> BoxWhiskerChart[Normal@dsData[All, #], "Outliers", Sequence[BarOrigin -> Left, ImageSize -> Medium, AspectRatio -> 1/2, PlotRange -> Full]] &, {"ageAtCreation", "appeared"}];

Pareto principle manifestation

Number of creations

Here is the Pareto principle plot of for the number of created (or renamed) programming languages per creator (using the WFR function ParetoPrinciplePlot):

ResourceFunction["ParetoPrinciplePlot"][Association[Rule @@@ Tally[Normal@dsData[All, "creators"]]], ImageSize -> Large]

We can see that ≈25% of the creators correspond to ≈50% of the languages.

Popularity

Obviously, programmers can and do use more than one programming language. Nevertheless, it is interesting to see the Pareto principle plot for the languages “mind share” based on the number of users estimates.

ResourceFunction["ParetoPrinciplePlot"][Normal@dsData[Association, #id -> #numberOfUsersEstimate &], ImageSize -> Large]

Remark: Again, the plot above is “wrong” — programmers use more than one programming language.


Correlations

In order to see meaningful correlation, pairwise plots we take logarithms of the large value columns:

dsDataVar = dsData[All, {"appeared", "ageAtCreation", "numberOfUsersEstimate", "numberOfJobsEstimate", "rank", "measurements", "pldbScore"}];
dsDataVar = dsDataVar[All, Append[#, <|"numberOfUsersEstimate" -> Log10[#numberOfUsersEstimate + 1], "numberOfJobsEstimate" -> Log10[#numberOfJobsEstimate + 1]|>] &];

Remark: Note that we “cheat” by adding 1 before taking the logarithms.

We obtain the tables of correlations plots using the newly introduced, experimental PairwiseListPlot. If we remove the rows with zeroes some of the correlations become more obvious. Here is the corresponding tab view of the two correlation tables:

TabView[{
"data" -> PairwiseListPlot[dsDataVar, PlotTheme -> "Business", ImageSize -> 800],
"zero-free data" -> PairwiseListPlot[dsDataVar[Select[FreeQ[Values[#], 0] &]], PlotTheme -> "Business", ImageSize -> 800]}]

Remark: Given the names of the data columns and the corresponding obvious interpretations we can say that the stronger correlations make sense.


Bubble chart 2D

In this section we make an informative 2D bubble chart with (tooltips).

First, note that not all triplets of “appeared”,”ageAtCreation”, and “numberOfUsersEstimate” are unique:

ReverseSortBy[Tally[Normal[dsData[All, {"appeared", "ageAtCreation", "numberOfUsersEstimate"}]]], Last][[1 ;; 3]]

(*{{<|"appeared" -> 2017, "ageAtCreation" -> 33, "numberOfUsersEstimate" -> 420|>, 2}, {<|"appeared" -> 2023, "ageAtCreation" -> 39, "numberOfUsersEstimate" -> 11|>, 1}, {<|"appeared" -> 2022, "ageAtCreation" -> 55, "numberOfUsersEstimate" -> 6265|>, 1}}*)

Hence we make two datasets: (1) one for the core bubble chart, (2) the other for the labeling function:

aData = GroupBy[Normal@dsData, #group &, KeyTake[#, {"appeared", "ageAtCreation", "numberOfUsersEstimate"}] &];
aData2 = GroupBy[Normal@dsData, #group &, KeyTake[#, {"appeared", "ageAtCreation", "numberOfUsersEstimate", "id", "creators"}] &];

Here is the labeling function (see the section “Applications” of the function page of BubbleChart):

Clear[LangLabeler];
LangLabeler[v_, {r_, c_}, ___] := Placed[Grid[{
{Style[aData2[[r, c]]["id"], Bold, 12], SpanFromLeft},
{"Creator(s):", aData2[[r, c]]["creators"]},
{"Appeared:", aData2[[r, c]]["appeared"]},
{"Age at creation:", aData2[[r, c]]["ageAtCreation"]},
{"Number of users:", aData2[[r, c]]["numberOfUsersEstimate"]}
}, Alignment -> Left], Tooltip];

Here is the bubble chart:

BubbleChart[
aData,
FrameLabel -> {"Age at Creation", "Appeared"},
PlotLabel -> "Number of users estimate",
BubbleSizes -> {0.05, 0.14},
LabelingFunction -> LangLabeler,
AspectRatio -> 1/2.5,
ChartStyle -> 7,
PlotTheme -> "Detailed",
ChartLegends -> {Keys[aData], None},
ImageSize -> 1000
]

Remark: The programming language J is a clear outlier because of creators’ ages.


Bubble chart 3D

In this section we a 3D bubble chart.

As in the previous section we define two datasets: for the core plot and for the tooltips:

aData3D = GroupBy[Normal@dsData, #group &, KeyTake[#, {"appeared", "ageAtCreation", "measurements", "numberOfUsersEstimate"}] &];
aData3D2 = GroupBy[Normal@dsData, #group &, KeyTake[#, {"appeared", "ageAtCreation", "measurements", "numberOfUsersEstimate", "id", "creators"}] &];

Here is the corresponding labeling function:

Clear[LangLabeler3D];
LangLabeler3D[v_, {r_, c_}, ___] := Placed[Grid[{
{Style[aData3D2[[r, c]]["id"], Bold, 12], SpanFromLeft},
{"Creator(s):", aData3D2[[r, c]]["creators"]},
{"Appeared:", aData3D2[[r, c]]["appeared"]},
{"Age at creation:", aData3D2[[r, c]]["ageAtCreation"]},
{"Number of users:", aData3D2[[r, c]]["numberOfUsersEstimate"]}
}, Alignment -> Left], Tooltip];

Here is the 3D chart:

BubbleChart3D[
aData3D,
AxesLabel -> {"appeared", "ageAtCreation", "measuremnts"},
PlotLabel -> "Number of users estimate",
BubbleSizes -> {0.02, 0.07},
LabelingFunction -> LangLabeler3D,
BoxRatios -> {1, 1, 1},
ChartStyle -> 7,
PlotTheme -> "Detailed",
ChartLegends -> {Keys[aData], None},
ImageSize -> 1000
]

Remark: In the 3D bubble chart plot “Mathematica” and “Wolfram Language” are easier to discern.


Second system effect traces

In this section we try — and fail — to demonstrate that the more programming languages a team of creators makes the less successful those languages are. (Maybe, because they are more cumbersome and suffer the Second system effect?)

Remark: This section is mostly made “for fun.” It is not true that each sets of languages per creators team is made of comparable languages. For example, complementary languages can be in the same set. (See, HTTP, HTML, URL.) Some sets are just made of the same language but with different names. (See, Perl 6 and Raku, and Mathematica and Wolfram Language.) Also, older languages would have the First mover advantage.

Make creators to index association:

aCreators = KeySort@Association[Rule @@@ Select[Tally[Normal@dsData[All, "creators"]], #[[2]] > 1 &]];
aNameToIndex = AssociationThread[Keys[aCreators], Range[Length[aCreators]]];

Make a bubble chart with relative popularity per creators team:

aNUsers = Normal@GroupBy[dsData, #creators &, (m = Max[1, Max[Sqrt@KeyTake[#, "numberOfUsersEstimate"]]]; Map[Tooltip[{#appeared, #creators /. aNameToIndex, Sqrt[#numberOfUsersEstimate]/m}, Grid[{{Style[#id, Black, Bold], SpanFromLeft}, {"Creator(s):", #creators}, {"Users:", #numberOfUsersEstimate}}, Alignment -> Left]] &, #]) &];
aNUsers = KeySort@Select[aNUsers, Length[#] > 1 &];
BubbleChart[aNUsers, AspectRatio -> 2, BubbleSizes -> {0.02, 0.05}, ChartLegends -> Keys[aNUsers], ImageSize -> Large, GridLines -> {None, Values[aNameToIndex]}, FrameTicks -> {{Reverse /@ (List @@@ Normal[aNameToIndex]), None}, {Automatic, Automatic}}]

From the plot above we cannot decisively say that:

The most recent creation of a team of programming language creators is not team's most popular creation.

That statement, though, does hold for a fair amount of cases.


Instead of conclusions

Consider:

  • Making an interactive interface for the variables, types of plots, etc.
  • Placing callouts for the focus languages in bubble charts.

Extracting Russian casualties in Ukraine data from Mediazona publications

Introduction

In this blog post (corresponding to this notebook) we discuss data extraction techniques from the Web site Mediazona that tracks the Russian casualties in Ukraine. See [MZ1].

Since we did not find a public source code (or data) repository (like GitHub) of the data, we extract the data directly from the web site [MZ1]. We can use both (i) image processing and (ii) web browser automation. But since we consider the latter to be both time consuming and unreliable to reproduce, in this notebook we consider only image processing (combined with AI vision.)

We did not “harvest” all types of data from Mediazona, only the casualties per week and day for all troops. (Which we see as most important.)

This notebook is intentionally kept to be only “technical know-how”, without further data analysis, or correlation confirmations with other publications, or model applications, etc. We plan to do analysis and modeling in other notebooks/articles. (Using data from Mediazona and other sources.)

Remark: At the time of programming the extractions of this notebook, (2023-11-29), Midiazona, [MZ1], says that the Russian casualties it presents are corroborated by publicly available data as of 17 November, 2023.

Remark: Mediazona is Anti Putinist, [Wk1], and (judging from its publications) it is pro-Ukraine and pro-West.

Similar other data sources

Here is a couple of other data sources with similar intent or mission:

Remark: Those are pro-Russian sites.

TL;DR

Here is the data that is extracted below using image processing and OpenAI’s LLM vision capabilities, [AAn1, OAIb1]:

Here is the corresponding JSON file.

Here is a bar chart with tooltips for the weekly casualties that corresponds to the weekly casualties bar chart in [MZ1] (for all troops):

bcCol = RGBColor @@ ({143, 53, 33}/255);
xTicks = MapIndexed[{#2[[1]], DateString[First@#WeekSpan, {"MonthNameShort", " '", "YearShort"}]} &, mediaZonaData];
BarChart[Map[Tooltip[#["total_casualties"], Labeled[Grid[Map[{#[[1]], " : ", #[[2]]} &, List @@@ Normal[#["count_per_day"]]]], Column[{Style[#["week_span"], Blue], Row[{"total casualties:", Spacer[3], Style[#["total_casualties"], Red]}]}], Top]] &, mediaZonaData 
  ], 
  PlotTheme -> "Detailed", 
  FrameLabel -> Map[Style[#, FontSize -> 14] &, {"Week", "Number of killed"}], FrameTicks -> {{Automatic, Automatic}, {{#[[1]], Rotate[#[[2]], \[Pi]/6]} & /@ xTicks[[1 ;; -1 ;; 4]], Automatic}}, PlotLabel -> Style["Confirmed Russian casualties in Ukraine per week", Bold, FontSize -> 18], 
  ChartStyle -> Block[{tcs = Map[#["total_casualties"] &, mediaZonaData]}, Blend[{White, bcCol}, #] & /@ (tcs/Max[tcs])], 
  ImageSize -> 1000, 
  AspectRatio -> 1/1.8 
 ]

Document structure

The rest of document has the following sections:

  • Images with data
  • Weekly casualties extraction
  • Daily data extraction from daily bar chart
  • Daily data extraction from weekly bar chart tooltips
  • Additional comments and remarks

The second and fourth sections have subsections that outline the corresponding procedures.

Images with data

At first we got two images from [MZ1]: one for casualties per week and one for casualties per day. (For all troops.)

Then in order to extract more faithful daily casualties data we took ≈90 screenshots of the weekly casualties bar chart at [MZ1], each screenshot with a tooltip shown for a different week.

Casualties per week

Casualties per day

Screenshots of weekly bar chart with tooltips

In order to get more faithful data readings of the daily casualties multiple (≈90) screenshots were taken of the weekly casualties bar chart, each of the screenshots having a tooltip table of one (unique) bar. It took ≈15 minutes to take those screenshots. They can be obtained from this Google Drive link.

Here is how one of them looks like:

Number of days and number weeks

Here is the number of weeks we expect to see in the “Casualties per week” plot:

nWeeks = Round@DateDifference[DateObject[{2022, 02, 24}], DateObject[{2023, 11, 17}], "Week"]

(* 90 wk *)

Here is the number of days we expect to see in the “Casualties per day” plot:

nDays = Round@DateDifference[DateObject[{2022, 02, 24}], DateObject[{2023, 11, 03}]]

(*617 days*)

Weekly data extraction

Procedure

Here is the outline of the procedure:

  • Crop the image, so only the bar chart elements are on it
  • Binarize the image, and negated
    • So all visible bars are white on black background
  • Extracting morphological components
  • Find the bar sizes from the extracted components
  • Rescale to match real data
  • Check the absolute and relative errors between derived total number of casualties and the published one

Crop image

Here we take “the bars only” part of the image:

imgCasualtiesPerWeek2 = ImageTake[imgCasualtiesPerWeek, {120, -140}, {100, -60}]

Binarization and color negation

Binarize the cropped the image:

img = Binarize[imgCasualtiesPerWeek2, 0.85]

Here we binarize and color negate the image:

img2 = ColorNegate@Binarize[img]

Extracting morphological components

Here is the result of an application of morphological components finder:

MorphologicalComponents[img2] // Colorize

Find the bounding boxes of the morphological components:

aBoxes = SortBy[Association[ComponentMeasurements[img2, "BoundingBox"]], #[[1, 1]] &];
aBoxes = AssociationThread[Range@Length@aBoxes, Values@aBoxes];
aBoxes[[1 ;; 4]]

(*<|1 -> {{14., 6.}, {24., 473.}}, 2 -> {{25., 6.}, {35., 533.}}, 3 -> {{37., 6.}, {47., 402.}}, 4 -> {{48., 6.}, {58., 235.}}|>*)

Here we see are all component bounding boxes having the same minimum y-coordinate:

Tally@Values[aBoxes][[All, 1, 2]]

(*{{6., 66}, {7., 22}}*)

Find the heights of the rectangles and make a corresponding bar plot:

(*aHeights=Map[#\[LeftDoubleBracket]2,2\[RightDoubleBracket]-#\[LeftDoubleBracket]1,2\[RightDoubleBracket]&,aBoxes];*)
  aHeights = Map[#[[2, 2]] - Min[Values[aBoxes][[All, 1, 2]]] &, aBoxes]; 
   BarChart[aHeights, PlotTheme -> "Detailed", ImageSize -> 900]

Rescaling to match real data

The extracted data has to be rescaled to match the reported data. (We can see we have to “calibrate” the extracted data over a few points of the real data.)

Here we remake the plot above to include characteristic points we can use the calibration:

pos = Position[aHeights, Max[aHeights]][[1, 1, 1]];
pos2 = 23;
aHeights2 = aHeights;
Do[aHeights2[p] = Callout[aHeights2[[p]]], {p, {1, pos2, pos}}];
BarChart[aHeights2, GridLines -> {pos, None}, PlotTheme -> "Detailed",ImageSize -> 900]

Here are a few characteristic points of the real data

aRealHeights = <|1 -> 544, 7 -> 167, 23 -> 96, pos2 -> 414, pos -> 687|>

(*<|1 -> 544, 7 -> 167, 23 -> 414, 50 -> 687|>*)

Rescaling formula:

frm = Rescale[x, {aHeights[pos2], aHeights[pos]}, {aRealHeights[pos2], aRealHeights[pos]}]

(*369.219 + 0.539526 x*)
frm = Rescale[x, {0, aHeights[pos]}, {0, aRealHeights[pos]}]

(*0. + 1.16638 x*)

Rescaling function:

f = With[{fb = frm /. x -> Slot[1]}, fb &]

(*0. + 1.16638 #1 &*)

Apply the rescaling function:

aHeightsRescaled = Ceiling@*f /@ aHeights

(*<|1 -> 545, 2 -> 615, 3 -> 462, 4 -> 268, 5 -> 370, 6 -> 205, 7 -> 168, 8 -> 213, 9 -> 321, 10 -> 247, 11 -> 299, 12 -> 200, 13 -> 335, 14 -> 261, 15 -> 202, 16 -> 174, 17 -> 202, 18 -> 233, 19 -> 234, 20 -> 215, 21 -> 201, 22 -> 139, 23 -> 97, 24 -> 152, 25 -> 187, 26 -> 150, 27 -> 222, 28 -> 333, 29 -> 263, 30 -> 256, 31 -> 385, 32 -> 440, 33 -> 356, 34 -> 352, 35 -> 404, 36 -> 415, 37 -> 408, 38 -> 378, 39 -> 331, 40 -> 311, 41 -> 530, 42 -> 418, 43 -> 399, 44 -> 404, 45 -> 616, 46 -> 549, 47 -> 614, 48 -> 580, 49 -> 647, 50 -> 687, 51 -> 504, 52 -> 469, 53 -> 486, 54 -> 516, 55 -> 500, 56 -> 511, 57 -> 427, 58 -> 336, 59 -> 311, 60 -> 250, 61 -> 289, 62 -> 259, 63 -> 313, 64 -> 320, 65 -> 238, 66 -> 195, 67 -> 284, 68 -> 269, 69 -> 282, 70 -> 234, 71 -> 235, 72 -> 214, 73 -> 196, 74 -> 242, 75 -> 179, 76 -> 156, 77 -> 125, 78 -> 165, 79 -> 173, 80 -> 171, 81 -> 163, 82 -> 159, 83 -> 122, 84 -> 114, 85 -> 163, 86 -> 207, 87 -> 144, 88 -> 47|>*)

Here are some easy to check points (post-rescaling):

KeyTake[aHeightsRescaled, {1, 2, 7, Length[aHeightsRescaled]}]

(*<|1 -> 545, 2 -> 615, 7 -> 168, 88 -> 47|>*)

Verification check

Here is the image-extraction, estimated total:

imgTotal = aHeightsRescaled // Total

(*26961*)

The estimated total is close to the reported $26882$, with $79$absolute error and$\approx 3$‰ relative error:

reportTotal = 26882;
errAbs = N@Abs[reportTotal - imgTotal]
errRatio = N@Abs[reportTotal - imgTotal]/reportTotal

(*79.*)

(*0.00293877*)

Remark: The reported total number of casualties can be seen in the original weekly casualties screenshot above.

Daily data extraction from daily bar chart

Daily casualties extraction is not that easy with technique applied to the weekly casualties plot. One of the reasons is that the daily casualties plot is also a user input interface(on that web page).

Since we want to get daily data for calibration of (generalized) Lanchester law models we can simply extrapolate the weekly data with daily averages. We can also over-impose in some way the two images (or plots) in order to convince ourselves that we have a faithful enough interpolation.

lsDailyHeightsRescaled = Flatten@Map[Table[#, 7]/7 &, Values[aHeightsRescaled]];
BarChart[lsDailyHeightsRescaled, ImageSize -> 900, AspectRatio -> 1/8,PlotTheme -> "Web"]

Nevertheless, more faithful daily data can be obtained by image- and LLM processing the tooltips of the weekly casualties chart. (See the next section.)


Daily data extraction from weekly bar chart tooltips

Procedure

Here is the procedure outline:

  • Take multiple screenshots of the weekly casualties bar chart
    • A screenshot for each week with the corresponding tooltip shown
    • Make sure all screenshots have the same size (or nearly the same size)
      • E.g. take “window screenshots”
    • ≈90 screenshots can be taken within 15 minutes
  • Crop the screenshots appropriately
  • In order to get the tooltip tables only for each screenshot:
  • Verify good tooltips table image is obtained for each screenshot (week)
  • Do Optical Character Recognition (OCR) over the images
    • One option is to send them to an Artificial Intelligence (AI) vision service
    • Another option is to use WL’s TextRecognize
  • Parse or otherwise process the obtained OCR (or AI vision) results
  • Verify that each week is reflected in the data
    • It might happen that screenshots are not “a full set“
  • Make time series with the obtained data and compare or verify with published data and plots
    • Check are the casualties totals the same, do the plots look similar, etc.
  • Make an informative bar chart with tooltips
    • That resembles the one the screenshots were taken from
    • See the subsection “TL;DR” in the introduction

Remark: When using AI vision the prompt engineering might take a few iterations, but not that many.

Remark: The few experiments with the WL built-in text recognition produced worse results than using AI vision. Hence, they were not extended further.

Screenshots ingestion

Get screenshot file names

dirNameImport = FileNameJoin[{NotebookDirectory[], "Screenshots-Mediazona-weekly-casualties-histogram"}];
lsFileNames = FileNames["*.png", dirNameImport];
Length[lsFileNames]

(*94*)

Import images

AbsoluteTiming[
  lsImgs = Import /@ lsFileNames; 
 ]

(*{2.50844, Null}*)

Here is one of the imported images:

ImageResize[lsImgs[[14]], 900]

Definition

Here define a function that is used to batch transform the screenshots:

Clear[MakeEasyToRead];
Options[MakeEasyToRead] = {"BoundingBox" -> Automatic, "BinarizingLimits" -> Automatic};
MakeEasyToRead[img_?ImageQ, opts : OptionsPattern[]] := 
   Block[{boundingBox, mbLimits, img2, img3}, 
    
    boundingBox = OptionValue[MakeEasyToRead, "BoundingBox"]; 
    If[TrueQ[boundingBox === Automatic], boundingBox = {{380, -180}, {280, -280}}]; 
    
    mbLimits = OptionValue[MakeEasyToRead, "BinarizingLimits"]; 
    If[TrueQ[mbLimits === Automatic], mbLimits = {0.2, 0.75}]; 
    
    img2 = ImageTake[img, Sequence @@ boundingBox]; 
    img3 = MorphologicalBinarize[ColorNegate@img2, mbLimits]; 
    ImageCrop[ColorNegate[img3]] 
   ];

Remark: This function corresponds to the second and third step of the procedure outlined above.

Batch transform

AbsoluteTiming[
  lsImgTables = MakeEasyToRead[#, "BoundingBox" -> {{380, -100}, {280, -280}}, "BinarizingLimits" -> {0.4, 0.76}] & /@ lsImgs; 
 ]

(*{9.76089, Null}*)
MapIndexed[Labeled[#, #2[[1]], Top] &, lsImgTables]

Batch AI-vision application

Load the package “LLMVision.m”, [AAp1, AAn1]:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/Misc/LLMVision.m"]

Here we do batch AI vision application, [AAn1], using an appropriate prompt:

h = 11;
AbsoluteTiming[
  lsImgTableJSONs = 
    Table[(
      Echo[Style[{i, i + (h - 1)}, Purple, Bold], "Span:"]; 
      t = 
       LLMVisionSynthesize[{
         "Get the 1) week span, 2) total casualties 3) count per day from the image.\n", 
         "Give the result as a JSON record with keys 'week_span', 'total_casualties', and 'count_per_day'.\n", 
         "Here is example of the JSON record for each image:{\"week_span\": \"10 Mar 2022 - 16 Mar 2022\",\"total_casualties\": 462,\"count_per_day\": {\"10 Mar\": 50,\"11 Mar\": 64,\"12 Mar\": 98,\"13 Mar\": 65,\"14 Mar\": 76,\"15 Mar\": 57,\"16 Mar\": 52}}", 
         LLMPrompt["NothingElse"]["JSON"] 
        }, 
        Take[lsImgTables, {i, UpTo[i + (h - 1)]}], 
        "MaxTokens" -> 1200, "Temperature" -> 0.1]; 
      Echo[t, "OCR:"]; 
      t 
     ), 
     {i, 1, Length[lsImgs], h}]; 
 ]
(*{260.739, Null}*)

Process AI-vision results

Extract JSONs and import them as WL structures:

pres1 = Map[ImportString[StringReplace[#, {"```json" -> "", "```" -> ""}], "RawJSON"] &, lsImgTableJSONs];
pres1[[1 ;; 2]]

(*{{<|"week_span" -> "24 Feb 2022 - 2 Mar 2022", "total_casualties" -> 544, "count_per_day" -> <|"24 Feb" -> 109, "25 Feb" -> 93, "26 Feb" -> 89, "27 Feb" -> 98, "28 Feb" -> 69, "1 Mar" -> 39, "2 Mar" -> 47|>|>, <|"week_span" -> "3 Mar 2022 - 9 Mar 2022", "total_casualties" -> 614, "count_per_day" -> <|"3 Mar" -> 84, "4 Mar" -> 71, "5 Mar" -> 94, "6 Mar" -> 132, "7 Mar" -> 83, "8 Mar" -> 88, "9 Mar" -> 62|>|>, <|"week_span" -> "10 Mar 2022 - 16 Mar 2022", "total_casualties" -> 462, "count_per_day" -> <|"10 Mar" -> 50, "11 Mar" -> 64, "12 Mar" -> 98, "13 Mar" -> 65, "14 Mar" -> 76, "15 Mar" -> 57, "16 Mar" -> 52|>|>, <|"week_span" -> "17 Mar 2022 - 23 Mar 2022","total_casualties" -> 266, "count_per_day" -> <|"17 Mar" -> 28, "18 Mar" -> 44, "19 Mar" -> 33, "20 Mar" -> 36, "21 Mar" -> 51, "22 Mar" -> 28, "23 Mar" -> 46|>|>, <|"week_span" -> "24 Mar 2022 - 30 Mar 2022","total_casualties" -> 369, "count_per_day" -> <|"24 Mar" -> 61, "25 Mar" -> 70, "26 Mar" -> 49, "27 Mar" -> 30, "28 Mar" -> 46, "29 Mar" -> 57, "30 Mar" -> 56|>|>, <|"week_span" -> "31 Mar 2022 - 6 Apr 2022", "total_casualties" -> 204, "count_per_day" -> <|"31 Mar" -> 40, "1 Apr" -> 53, "2 Apr" -> 31, "3 Apr" -> 14, "4 Apr" -> 17, "5 Apr" -> 28, "6 Apr" -> 21|>|>, <|"week_span" -> "7 Apr 2022 - 13 Apr 2022", "total_casualties" -> 167, "count_per_day" -> <|"7 Apr" -> 12, "8 Apr" -> 12, "9 Apr" -> 25, "10 Apr" -> 25, "11 Apr" -> 21, "12 Apr" -> 24, "13 Apr" -> 48|>|>, <|"week_span" -> "14 Apr 2022 - 20 Apr 2022","total_casualties" -> 212, "count_per_day" -> <|"14 Apr" -> 35, "15 Apr" -> 26, "16 Apr" -> 28, "17 Apr" -> 21, "18 Apr" -> 37, "19 Apr" -> 36, "20 Apr" -> 29|>|>, <|"week_span" -> "21 Apr 2022 - 27 Apr 2022","total_casualties" -> 320, "count_per_day" -> <|"21 Apr" -> 55, "22 Apr" -> 67, "23 Apr" -> 41, "24 Apr" -> 30, "25 Apr" -> 57, "26 Apr" -> 27, "27 Apr" -> 43|>|>, <|"week_span" -> "28 Apr 2022 - 4 May 2022", "total_casualties" -> 245, "count_per_day" -> <|"28 Apr" -> 40, "29 Apr" -> 22, "30 Apr" -> 40, "1 May" -> 31, "2 May" -> 37, "3 May" -> 45, "4 May" -> 30|>|>, <|"week_span" -> "5 May 2022 - 11 May 2022", "total_casualties" -> 298, "count_per_day" -> <|"5 May" -> 42, "6 May" -> 62, "7 May" -> 41, "8 May" -> 47, "9 May" -> 30, "10 May" -> 37, "11 May" -> 39|>|>}, {<|"week_span" -> "12 May 2022 - 18 May 2022", "total_casualties" -> 199, "count_per_day" -> <|"12 May" -> 29, "13 May" -> 25, "14 May" -> 30, "15 May" -> 29, "16 May" -> 28, "17 May" -> 38, "18 May" -> 20|>|>, <|"week_span" -> "19 May 2022 - 25 May 2022","total_casualties" -> 334, "count_per_day" -> <|"19 May" -> 74, "20 May" -> 50, "21 May" -> 45, "22 May" -> 43, "23 May" -> 56, "24 May" -> 39, "25 May" -> 27|>|>, <|"week_span" -> "26 May 2022 - 1 Jun 2022", "total_casualties" -> 260, "count_per_day" -> <|"26 May" -> 45, "27 May" -> 37, "28 May" -> 41, "29 May" -> 44, "30 May" -> 26, "31 May" -> 26, "1 Jun" -> 41|>|>, <|"week_span" -> "2 Jun 2022 - 8 Jun 2022", "total_casualties" -> 201, "count_per_day" -> <|"2 Jun" -> 21, "3 Jun" -> 33, "4 Jun" -> 25, "5 Jun" -> 42, "6 Jun" -> 24, "7 Jun" -> 31, "8 Jun" -> 25|>|>, <|"week_span" -> "9 Jun 2022 - 15 Jun 2022", "total_casualties" -> 173, "count_per_day" -> <|"9 Jun" -> 35, "10 Jun" -> 22, "11 Jun" -> 24,"12 Jun" -> 24, "13 Jun" -> 21, "14 Jun" -> 34, "15 Jun" -> 13|>|>, <|"week_span" -> "16 Jun 2022 - 22 Jun 2022","total_casualties" -> 201, "count_per_day" -> <|"16 Jun" -> 23, "17 Jun" -> 37, "18 Jun" -> 14, "19 Jun" -> 26, "20 Jun" -> 27, "21 Jun" -> 40, "22 Jun" -> 34|>|>, <|"week_span" -> "30 Jun 2022 - 6 Jul 2022", "total_casualties" -> 233, "count_per_day" -> <|"30 Jun" -> 39, "1 Jul" -> 13, "2 Jul" -> 40, "3 Jul" -> 43, "4 Jul" -> 41, "5 Jul" -> 28, "6 Jul" -> 29|>|>, <|"week_span" -> "7 Jul 2022 - 13 Jul 2022", "total_casualties" -> 214, "count_per_day" -> <|"7 Jul" -> 39, "8 Jul" -> 48, "9 Jul" -> 47, "10 Jul" -> 18, "11 Jul" -> 14, "12 Jul" -> 17, "13 Jul" -> 31|>|>, <|"week_span" -> "14 Jul 2022 - 20 Jul 2022","total_casualties" -> 200, "count_per_day" -> <|"14 Jul" -> 17, "15 Jul" -> 13, "16 Jul" -> 29, "17 Jul" -> 28, "18 Jul" -> 24, "19 Jul" -> 46, "20 Jul" -> 43|>|>, <|"week_span" -> "21 Jul 2022 - 27 Jul 2022","total_casualties" -> 138, "count_per_day" -> <|"21 Jul" -> 21, "22 Jul" -> 44, "23 Jul" -> 22, "24 Jul" -> 11, "25 Jul" -> 20, "26 Jul" -> 3, "27 Jul" -> 17|>|>}}*)

Make a list of weekly records and make sure to have unique data records:

pres2 = Union[Flatten[pres1]];
Length[pres2]

(*89*)

To each record add a WL expression for the extracted week span and sort the records by week start date:

pres3 = Map[Prepend[#, "WeekSpan" -> Map[DateObject@*StringTrim, StringSplit[#["week_span"], "-"]]] &, pres2];
pres3 = SortBy[pres3, First@#WeekSpan &];

Here are the first two records:

pres3[[1 ;; 2]]

Verification (all weeks are present)

Summarize the starts of week:

ResourceFunction["RecordsSummary"][Map[First@#WeekSpan &, pres3]]

Make sure consistent weekly data is obtained:

Differences[Sort@Map[First@#WeekSpan &, pres3]] // Tally

Plots

Here is bar chart with tooltips based using the extracted data:

BarChart[Tooltip[#["total_casualties"], Labeled[Grid[Map[{#[[1]], " : ", #[[2]]} &, List @@@ Normal[#["count_per_day"]]]], Column[{Style[#["week_span"], Blue], Row[{"total casualties:", Spacer[3], Style[#["total_casualties"], Red]}]}], Top]] & /@ pres3, AxesLabel -> {"Week", "Number of\nkilled"}, ImageSize -> 700]

Remark: See the subsection “TL;DR” in the introduction for a better plot.

Here we make the corresponding daily casualties time series and plot it:

pres4 = Map[AssociationThread[DateRange @@ #WeekSpan, Values[#["count_per_day"]]] &, pres3];
pres5 = Join @@ pres4;
tsCasualties = TimeSeries[pres5];
DateListPlot[tsCasualties, PlotRange -> All, AspectRatio -> 1/6, FrameLabel -> {"Time", "Number of killed"}, ImageSize -> 1200]

Verification (with published results)

Here is the total number casualties based on the extracted data:

tooltipTotal = Total@tsCasualties

(*26879*)

It compares very well with the total number in the Mediazona’s plot — $3$ as an absolute error and$\approx 0.1$‰ relative error:

reportTotal = 26882;
errAbs = N@Abs[reportTotal - tooltipTotal]
errRatio = N@Abs[reportTotal - tooltipTotal]/reportTotal

(*3.*)

(*0.000111599*)

Additional comments and remarks

Good agreement between the two procedures

The two data extraction procedures agree very well over the extracted totals of casualties.

(Also good agreement with the “official” published total — approximately $3$‰ and $0.1$‰ respectively.)

LLMVision package

The function LLMVisionSynthesize used above is from the package “LLMVision.m”, [AAp1, AAn1]. One of the primary reasons to develop the package “LLMvision.m” was to use it in workflows like those above — extracting data from different sources in order to do war simulations.

Remark: In the section above LLMVisionSynthesize uses Base64 conversion of images. OpenAI’s Vision documentation advices to use URLs instead of Base64 images in long conversations.

Why apply image transformations when using AI vision?

One can ask:

Why do certain image transformations, or other image preprocessing, if we are using AI vision functionalities? 

Can’t we just apply the AI?!

There are multiple reasons for preprocessing the images that are on different conceptual and operational levels:

  • We want to be able to use the same workflow but with different OCR algorithms that are “smaller” and “less AI”
  • Images having only the information to be extracted produce more reliable results
    • This obvious when OCR functions are used (like TextRecognize)
    • Less prompt engineering would be needed with AI-vision (most likely)
  • It is much cheaper — both computationally and money-wise — to use some smaller images for processed conveniently

Remark: OpenAI’s vision documentation discusses the money costs, preferred image formats, and reliability — see this “Limitations” section.

JSON data

The extracted daily Mediazona data was exported to JSON with this command:

(*Export[FileNameJoin[{NotebookDirectory[],"mediaZonaData.json"}],Map[Normal,mediaZonaData]/.d_DateObject:>DateString[d,"ISODate"]]*)

References

Articles

[MZ1] Mediazona, Russian casualties in Ukraine, (2022-2023).

[OAIb1] OpenAI team, “New models and developer products announced at DevDay” , (2023), OpenAI/blog .

[Wk1] Wikipedia, “Mediazona”.

Functions

[WRIf1] Wolfram Research, Inc., MorphologicalBinarize, Wolfram Language function,(2010), (updated 2012).

[WRIf2] Wolfram Research, Inc, ImageCrop, Wolfram Language function,(2008), (updated 2021).

[WRIf3] Wolfram Research, Inc, TextRecognize, Wolfram Language function,(2010), (updated 2020).

Notebooks

[AAn1] Anton Antonov, “AI vision via Wolfram Language​​”, November 26, (2023), Wolfram Community, STAFF PICKS.

Packages, paclets

[AAp1] Anton Antonov, LLMVision.m, Mathematica package, (2023), GitHub/antononcube .

AI vision via Wolfram Language

Introduction

In the fall of 2023 OpenAI introduced the image vision model “gpt-4-vision-preview”, [OAIb1].

The model “gpt-4-vision-preview” represents a significant enhancement to the GPT-4 model, providing developers and AI enthusiasts with a more versatile tool capable of interpreting and narrating images alongside text. This development opens up new possibilities for creative and practical applications of AI in various fields.

For example, consider the following Wolfram Language (WL), developer-centric applications:

  • Narration of UML diagrams
  • Code generation from narrated (and suitably tweaked) narrations of architecture diagrams and charts
  • Generating presentation content draft from slide images
  • Extracting information from technical plots
  • etc.

A more diverse set of the applications would be:

  • Dental X-ray images narration
  • Security or baby camera footage narration
    • How many people or cars are seen, etc.
  • Transportation trucks content descriptions
    • Wood logs, alligators, boxes, etc.
  • Web page visible elements descriptions
    • Top menu, biggest image seen, etc.
  • Creation of recommender systems for image collections
    • Based on both image features and image descriptions
  • etc.

As a first concrete example, consider the following image that fable-dramatizes the name “Wolfram” (https://i.imgur.com/UIIKK9w.jpg):

RemoveBackground@Import[URL["https://i.imgur.com/UIIKK9wl.jpg"]]
1xg1w9gct6yca

Here is its narration:

LLMVisionSynthesize["Describe very concisely the image", "https://i.imgur.com/UIIKK9w.jpg", "MaxTokens" -> 600]

You are looking at a stylized black and white illustration of a wolf and a ram running side by side among a forest setting, with a group of sheep in the background. The image has an oval shape.

Remark: In this notebook Mathematica and Wolfram Language (WL) are used as synonyms.

Remark: This notebook is the WL version of the notebook “AI vision via Raku”, [AA3].

Ways to use with WL

There are five ways to utilize image interpretation (or vision) services in WL:

  • Dedicated Web API functions, [MT1, CWp1]
  • LLM synthesizing, [AAp1, WRIp1]
  • LLM functions, [AAp1, WRIp1]
  • Dedicated notebook cell type, [AAp2, AAv1]
  • Any combinations of the above

In this document are demonstrated the second, third, and fifth. The first one is demonstrated in the Wolfram Community post “Direct API access to new features of GPT-4 (including vision, DALL-E, and TTS)” by Marco Thiel, [MT1]. The fourth one is still “under design and consideration.”

Remark: The model “gpt-4-vision-preview” is given as a “chat completion model” , therefore, in this document we consider it to be a Large Language Model (LLM).

Packages and paclets

Here we load WL package used below, [AAp1, AAp2, AAp3]:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/Misc/LLMVision.m"]

Remark: The package LLMVision is “temporary” – It should be made into a Wolfram repository paclet, or (much better) its functionalities should be included in the “LLMFunctions” framework, [WRIp1].

Images

Here are the links to all images used in this document:

tblImgs = {{Row[{"Wolf and ram running together in forest"}], Row[{"https://i.imgur.com/UIIKK9w.jpg", ""}]}, {Row[{"LLM", " ", "functionalities", " ", "mind-map", ""}], Row[{"https://i.imgur.com/kcUcWnql.jpg", ""}]}, {Row[{"Single", " ", "sightseer", ""}], Row[{"https://i.imgur.com/LEGfCeql.jpg", ""}]}, {Row[{"Three", " ", "hunters", ""}], Row[{"https://raw.githubusercontent.com/antononcube/Raku-WWW-OpenAI/main/resources/ThreeHunters.jpg", ""}]}, {Row[{"Cyber", " ", "Week", " ", "Spending", " ", "Set", " ", "to", " ", "Hit", " ", "New", " ", "Highs", " ", "in", " ", "2023", ""}], Row[{"https://cdn.statcdn.com/Infographic/images/normal/7045.jpeg", ""}]}};
tblImgs = Map[Append[#[[1 ;; 1]], Hyperlink[#[[-1, 1, 1]]]] &, tblImgs];
TableForm[tblImgs, TableHeadings -> {None, {"Name", "Link"}}] /. {ButtonBox[n_, BaseStyle -> "Hyperlink", ButtonData -> { URL[u_], None}] :> Hyperlink[n, URL[u]]}
Name Link
Wolf and ram running together in forest Link
LLM functionalities mind-map Link
Single sightseer Link
Three hunters Link
Cyber Week Spending Set to Hit New Highs in 2023 Link

Document structure

Here is the structure of the rest of the document:

  • LLM synthesizing
    … using multiple image specs of different kind.
  • LLM functions
    … workflows over technical plots.
  • Dedicated notebook cells
    … just excuses why they are not programmed yet.
  • Combinations (fairytale generation)
    … Multi-modal applications for replacing creative types.
  • Conclusions and leftover comments
    … frustrations untold.

LLM synthesizing

The simplest way to use the OpenAI’s vision service is through the function LLMVisionSynthesize of the package “LLMVision”, [AAp1]. (Already demoed in the introduction.)

If the function LLMVisionSynthesize is given a list of images, a textual result corresponding to those images is returned. The argument “images” is a list of image URLs, image file names, or image Base64 representations. (Any combination of those element types can be specified.)

Before demonstrating the vision functionality below we first obtain and show a couple of images.

Images

Here is a URL of an image: (https://i.imgur.com/LEGfCeql.jpg). Here is the image itself:

Import[URL["https://i.imgur.com/LEGfCeql.jpg"]]
1u02ytqvf7xi9

OpenAI’s vision endpoint accepts POST specs that have image URLs or images converted into Base64 strings. When we use the LLMVisionSynthesize function and provide a file name under the “images” argument, the Base64 conversion is automatically applied to that file. Here is an example of how we apply Base64 conversion to the image  from a given file path:

img1 = Import[$HomeDirectory <> "/Downloads/ThreeHunters.jpg"];
ColumnForm[{
   img1, 
   Spacer[10], 
   ExportString[img1, {"Base64", "JPEG"}] // Short}]
0wmip47gloav0

Image narration

Here is an image narration example with the two images above, again, one specified with a URL, the other with a file path:

LLMVisionSynthesize["Give concise descriptions of the images.", {"https://i.imgur.com/LEGfCeql.jpg", $HomeDirectory <> "/Downloads/ThreeHunters.jpg"}, "MaxTokens" -> 600]

1. The first image depicts a single raccoon perched on a tree branch, surrounded by a plethora of vibrant, colorful butterflies in various shades of blue, orange, and other colors, set against a lush, multicolored foliage background.

2. The second image shows three raccoons sitting together on a tree branch in a forest setting, with a warm, glowing light illuminating the scene from behind. The forest is teeming with butterflies, matching the one in the first image, creating a sense of continuity and shared environment between the two scenes.

Description of a mind-map

Here is an application that should be more appealing to WL-developers – getting a description of a technical diagram or flowchart. Well, in this case, it is a mind-map from [AA2]:

Import[URL["https://i.imgur.com/kcUcWnql.jpeg"]]
1ukmn97ui4o98

Here are get the vision model description of the mind-map above (and place the output in Markdown format):

mmDescr = LLMVisionSynthesize["How many branches this mind-map has? Describe each branch separately. Use relevant emoji prefixes.", "https://imgur.com/kcUcWnq.jpeg", "MaxTokens" -> 900]
This mind map has four primary branches, each diverging from a \
central node labeled "LLM functionalities." I will describe each one \
using relevant emoji prefixes:

1. 🖼️ **DALL-E** branch is in yellow and represents an access point to \
the DALL-E service, likely a reference to a Large Language Model \
(LLM) with image generation capabilities.

2. 🤖 **ChatGPT** branch in pink is associated with the ChatGPT \
service, suggesting it's a conversational LLM branch. There are two \
sub-branches:
   - **LLM prompts** indicates a focus on the prompts used to \
communicate with LLMs.
   - **Notebook-wide chats** suggests a feature or functionality for \
conducting chats across an entire notebook environment.

3. 💬 **LLM chat objects** branch in purple implies that there are \
objects specifically designed for chat interactions within LLM \
services.

4. ✍️ **LLM functions** branch in green seems to represent various \
functional aspects or capabilities of LLMs, with a sub-branch:
   - **Chatbooks** which may indicate a feature or tool related to \
managing or organizing chat conversations as books or records.

Converting descriptions to diagrams

Here from the obtained description we request a (new) Mermaid-JS diagram to be generated:

mmdChart = LLMSynthesize[{LLMPrompt["CodeWriter"], "Make the corresponding Mermaid-JS diagram code for the following description. Give the code only, without Markdown symbols.", mmDescr}]
graph TB
    center[LLM functionalities]
    center --> dalle[DALL-E]
    center --> chat[ChatGPT]
    center --> chatobj[LLM chat objects]
    center --> functions[LLM functions]
    chat --> prompts[LLM prompts]
    chat --> notebook[Notebook-wide chats]
    functions --> chatbooks[Chatbooks]

Here is a diagram made with the Mermaid-JS spec obtained above using the resource function of “MermaidInk”, [AAf1]:

ResourceFunction["MermaidInk"][mmdChart]
1qni2g4n8vywf

Below is given an instance of one of the better LLM results for making a Mermaid-JS diagram over the “vision-derived” mind-map description.

ResourceFunction["MermaidInk"]["
graph 
 TBA[LLM services access] --> B[DALL-E]
 A --> C[ChatGPT]
 A --> D[PaLM]
 A --> E[LLM chat objects]
 A --> F[Chatbooks]
 B -->|related to| G[DALL-E AI system]
 C -->|associated with| H[ChatGPT]
 D -->|related to| I[PaLM model]
 E -->|part of| J[chat-related objects/functionalities]
 F -->|implies| K[Feature or application related to chatbooks]
"]
0f0fuo9nexxl8

Code generation from image descriptions

Here is an example of code generation based on the “vision derived” mind-map description above:

LLMSynthesize[{LLMPrompt["CodeWriter"], "Generate the Mathematica code of a graph that corresponds to the description:\n", mmDescr}]
Graph[{"LLM services access" -> "DALL-E","LLM services access" -> "ChatGPT",
"LLM services access" -> "PaLM",
"LLM services access" -> "LLM functionalities",
"LLM services access" -> "Chatbooks","LLM services access" -> "Notebook-wide chats",
"LLM services access" -> "Direct access of LLM services","LLM functionalities" -> "LLM prompts",
"LLM functionalities" -> "LLM functions","LLM functionalities" -> "LLM chat objects"},
VertexLabels -> "Name"]
ToExpression[%]
0cmyq0lep1q7f

Analyzing graphical WL results

Consider another “serious” example – that of analyzing chess play positions. Here we get a chess position using the paclet “Chess”, [WRIp3]:

175o8ba3cxgoh
0scq7lbpp7xfs

Here we describe it with “AI vision”:

LLMVisionSynthesize["Describe the position.", Image[b2], "MaxTokens" -> 1000, "Temperature" -> 0.05]
This is a chess position from a game in progress. Here's the \
description of the position by algebraic notation for each piece:

White pieces:
- King (K) on c1
- Queen (Q) on e2
- Rooks (R) on h1 and a1
- Bishops (B) on e3 and f1
- Knights (N) on g4 and e2
- Pawns (P) on a2, b2, c4, d4, f2, g2, and h2

Black pieces:
- King (K) on e8
- Queen (Q) on e7
- Rooks (R) on h8 and a8
- Bishops (B) on f5 and g7
- Knights (N) on c6 and f6
- Pawns (P) on a7, b7, c7, d7, f7, g7, and h7

It's Black's turn to move. The position suggests an ongoing middle \
game with both sides having developed most of their pieces. White has \
castled queenside, while Black has not yet castled. The white knight \
on g4 is putting pressure on the black knight on f6 and the pawn on \
h7. The black bishop on f5 is active and could become a strong piece \
depending on the continuation of the game.

Remark: In our few experiments with these kind of image narrations, a fair amount of the individual pieces are described to be at wrong chessboard locations.

Remark: In order to make the AI vision more successful, we increased the size of the chessboard frame tick labels, and turned the “a÷h” ticks uppercase (into “A÷H” ticks.) It is interesting to compare the vision results over chess positions with and without that transformation.

LLM Functions

Let us show more programmatic utilization of the vision capabilities.

Here is the workflow we consider:

  1. Ingest an image file and encode it into a Base64 string
  2. Make an LLM configuration with that image string (and a suitable model)
  3. Synthesize a response to a basic request (like, image description)
    • Using LLMSynthesize
  4. Make an LLM function for asking different questions over image
    • Using LLMFunction
  5. Ask questions and verify results
    • ⚠️ Answers to “hard” numerical questions are often wrong.
    • It might be useful to get formatted outputs

Remark: The function LLMVisionSynthesize combines LLMSynthesize and step 2. The function LLMVisionFunction combines LLMFunction and step 2.

Image ingestion and encoding

Here we ingest an image and display it:

imgBarChart = Import[$HomeDirectory <> "/Downloads/Cyber-Week-Spending-Set-to-Hit-New-Highs-in-2023-small.jpeg"]
0iyello2xfyfo

Remark: The image was downloaded from the post “Cyber Week Spending Set to Hit New Highs in 2023” .

Configuration and synthesis

Here we synthesize a response of a image description request:

LLMVisionSynthesize["Describe the image.", imgBarChart, "MaxTokens" -> 600]
The image shows a bar chart infographic titled "Cyber Week Spending \
Set to Hit New Highs in 2023" with a subtitle "Estimated online \
spending on Thanksgiving weekend in the United States." There are \
bars for five years (2019, 2020, 2021, 2022, and 2023) across three \
significant shopping days: Thanksgiving Day, Black Friday, and Cyber \
Monday.

The bars represent the spending amounts, with different colors for \
each year. The spending for 2019 is shown in navy blue, 2020 in a \
lighter blue, 2021 in yellow, 2022 in darker yellow, and 2023 in dark \
yellow, with a pattern that clearly indicates the 2023 data is a \
forecast.

From the graph, one can observe an increasing trend in estimated \
online spending, with the forecast for 2023 being the highest across \
all three days. The graph also has an icon that represents online \
shopping, consisting of a computer monitor with a shopping tag.

At the bottom of the infographic, there is a note that says the \
data's source is Adobe Analytics. The image also contains the \
Statista logo, which indicates that this graphic might have been \
created or distributed by Statista, a company that specializes in \
market and consumer data. Additionally, there are Creative Commons \
(CC) icons, signifying the sharing and use permissions of the graphic.

It's important to note that without specific numbers, I cannot \
provide actual figures, but the visual trend is clear -- \
there is substantial year-over-year growth in online spending during \
these key shopping dates, culminating in a forecasted peak for 2023.

Repeated questioning

Here we define an LLM function that allows multiple question request invocations over the image:

fst = LLMVisionFunction["For the given image answer the question: ``. Be as concise as possible in your answers.", imgBarChart, "MaxTokens" -> 300]
0nmz56wwuboz3
fst["How many years are presented in that image?"]
"Five years are presented in the image."
fst["Which year has the highest value? What is that value?"]
"2023 has the highest value, which is approximately $11B on Cyber Monday."

Remark: Numerical value readings over technical plots or charts seem to be often wrong. Often enough, OpenAI’s vision model warns about this in the responses.

Formatted output

Here we make a function with a specially formatted output that can be more easily integrated in (larger) workflows:

fjs = LLMVisionFunction["How many `1` per `2`? " <> LLMPrompt["NothingElse"]["JSON"], imgBarChart, "MaxTokens" -> 300, "Temperature" -> 0.1]
032vcq74auyv9

Here we invoke that function (in order to get the money per year “seen” by OpenAI’s vision):

res = fjs["money", "shopping day"]
```json
{
  "Thanksgiving Day": {
    "2019": "$4B",
    "2020": "$5B",
    "2021": "$6B",
    "2022": "$7B",
    "2023": "$8B"
  },
  "Black Friday": {
    "2019": "$7B",
    "2020": "$9B",
    "2021": "$9B",
    "2022": "$10B",
    "2023": "$11B"
  },
  "Cyber Monday": {
    "2019": "$9B",
    "2020": "$11B",
    "2021": "$11B",
    "2022": "$12B",
    "2023": "$13B"
  }
}
```

Remark: The above result should be structured as shopping-day:year:value. But occasionally it might be structured as year::shopping-day::value. In the latter case just re-run LLM invocation.

Here we parse the obtained JSON into WL association structure:

aMoney = ImportString[StringReplace[res, {"```json" -> "", "```" -> ""}], "RawJSON"]
<|"Thanksgiving Day" -> <|"2019" -> "$4B", "2020" -> "$5B", 
   "2021" -> "$6B", "2022" -> "$7B", "2023" -> "$8B"|>, 
 "Black Friday" -> <|"2019" -> "$7B", "2020" -> "$9B", 
   "2021" -> "$9B", "2022" -> "$10B", "2023" -> "$11B"|>, 
 "Cyber Monday" -> <|"2019" -> "$9B", "2020" -> "$11B", 
   "2021" -> "$11B", "2022" -> "$12B", "2023" -> "$13B"|>|>

Remark: Currently LLMVisionFunction does not have an interpreter (or “form”) parameter as LLMFunction does. This can be seen as one of the reasons to include LLMVisionFunction in the “LLMFunctions” framework.

Here we convert the money strings into money quantities:

AbsoluteTiming[
  aMoney2 = Map[SemanticInterpretation, aMoney, {-1}] 
 ]
08ijuwuchj31q

Here is the corresponding bar chart and the original bar chart (for
comparison):

0rt43fezbbp4b
1lpfhko7c2g6e

Remark: The comparison shows “pretty good vision” by OpenAI! But, again, small (or maybe significant) discrepancies are observed.

Dedicated notebook cells

In the context of the “well-established” notebook solutions OpenAIMode, [AAp2], or Chatbook,
[WRIp2], we can contemplate extensions to integrate OpenAI’s vision service.

The main challenges here include determining how users will specify images in the notebook, such as through URLs, file names, or Base64 strings, each with unique considerations. Additionally, we have to explore how best to enable users to input prompts or requests for image processing by the AI/LLM service.

This integration, while valuable, it is not my immediate focus as there are programmatic ways to access OpenAI’s vision service already. (See the previous sections.)

Combinations (fairy tale generation)

Consider the following computational workflow for making fairy tales:

  1. Draw or LLM-generate a few images that characterize parts of a story.
  2. Narrate the images using the LLM “vision” functionality.
  3. Use an LLM to generate a story over the narrations.

Remark: Multi-modal LLM / AI systems already combine steps 2 and 3.

Remark: The workflow above (after it is programmed) can be executed multiple times until satisfactory results are obtained.

Here are image generations using DALL-E for four different requests with the same illustrator name in them:

storyImages = 
   Map[
    ImageSynthesize["Painting in the style of John Bauer of " <> #] &,
    {"a girl gets a basket with wine and food for her grandma.", 
     "a big bear meets a girl carrying a basket in the forest.", 
     "a girl that gives food from a basket to a big bear.", 
     "a big bear builds a new house for girl's grandma."} 
   ];
storyImages // Length

(*4*)

Here we display the images:

storyImages
13qqfe3pzqfn9

Here we get the image narrations (via the OpenAI’s “vision service”):

storyImagesDescriptions = LLMVisionSynthesize["Concisely describe the images.", storyImages, "MaxTokens" -> 600]
1. A painting of a woman in a traditional outfit reaching into a
    basket filled with vegetables and bread beside a bottle.
2. An illustration of a person in a cloak holding a bucket and
    standing next to a large bear in a forest.
3. An artwork depicting a person sitting naked by a birch tree,
    sharing a cake with a small bear.
4. A picture of a person in a folk costume sitting next to a bear
    with a ladder leaning against a house.

Here we extract the descriptions into a list:

descr = StringSplit[storyImagesDescriptions, "\n"];

Here we generate the story from the descriptions above (using OpenAI’s ChatGPT):

 LLMSynthesize[{"Write a story that fits the following four descriptions:", Sequence @@ descr}, LLMEvaluator -> LLMConfiguration["MaxTokens" -> 1200]]
In a small village nestled deep within a lush forest, lived a woman \
named Anya. She was gentle and kind-hearted, known for her artistic \
talent and love for nature. Anya had a keen eye for capturing the \
beauty of the world around her through her paintings. Each stroke of \
her brush seemed to hold a piece of her soul, and her art touched the \
hearts of all who laid their eyes upon it.

One sunny day, on the outskirts of the village, Anya set up her easel \
amidst a lively farmers' market. In front of her, she placed a large \
canvas, ready to bring her latest vision to life. With her palette \
filled with vibrant colors, she began painting a woman dressed in a \
traditional outfit, delicately reaching into a woven basket filled to \
the brim with fresh vegetables and warm bread. Beside the basket lay \
an empty bottle, hinting at a joyous feast anticipated for the day.

As Anya skillfully brought her painting to life, a cloak-wrapped \
figure caught her attention. Intrigued, she turned her easel slightly \
to capture the essence of this mysterious wanderer standing beside a \
mighty bear deep within the heart of the forest. In her illustration, \
she depicted the cloaked person, holding a bucket, their gaze met by \
the curious eyes of the regal woodland creature. The bond between \
them was palpable, a silent understanding as they stood together, \
guardians of the ancient woods.

Meanwhile, in a clearing not too far away, Anya discovered a scene \
that touched her deeply. She stumbled upon a person sitting naked \
beneath the shade of a majestic birch tree, a cake placed lovingly \
between them and a small bear. The artwork she created was a tender \
portrayal of the intimate connection shared by the two, a testament \
to the innate kindness that existed between species. Together, they \
enjoyed the sweet treat, their hearts entwined in empathy, neither \
fearing the vulnerability of their exposed selves.

Driven by her artistry, Anya's imagination continued to explore the \
fascinating relationship between humans and bears in her village. In \
her final artwork, she turned her focus to a person in a folk \
costume, sitting comfortably beside a towering bear. A ladder leaned \
against a charming wooden house in the background, illustrating the \
close bond shared between the village folks and their wild \
companions. Together, they stood tall, their spirits entwined in a \
balance of mutual respect and harmony.

As Anya showcased her artwork to the villagers, they were captivated \
by the depth of emotion expressed through her brushstrokes. Her \
paintings served as a reminder that love and understanding knew no \
boundaries, whether lived within the confines of villages or amidst \
the enchanting wilderness.

Anya became a celebrated artist, known far and wide for her ability \
to weave tales of compassion and unity through her exquisite \
paintings. Her work inspired generations to see the world through the \
lens of empathy, teaching them that even in unconventional \
connections between humans and animals, beauty could be found.

And so, her legacy lived on, her art continuing to touch the hearts \
of those who recognized the profound messages hidden within her \
strokes of color. For in every stroke, Anya immortalized the timeless \
bond between humanity and the natural world, forever reminding us of \
the kinship we share with the creatures that roam our earth.

Conclusions and leftover comments

  • The new OpenAI vision model, “gpt-4-vision-preview”, as all LLMs produces too much words, and it has to be reined in and restricted.
  • The functions LLMVisionSynthesize and LLMVisionFunction have to be part of the “LLMFunctions” framework.
    • For example, “LLMVision*” functions do not have an interpreter (or “form”) argument.
  • The package “LLMVision” is meant to be simple and direct, not covering all angles.
  • It would be nice a dedicated notebook cell interface and workflow(s) for interacting with “AI vision” services to be designed and implemented.
    • The main challenge is the input of images.
  • Generating code from hand-written diagrams might be really effective demo using WL.
  • It would be interesting to apply the “AI vision” functionalities over displays from, say, chess or play-cards paclets.

References

Articles

[AA1] Anton Antonov, “Workflows with LLM functions (in WL)”,​ August 4, (2023), Wolfram Community, STAFF PICKS.

[AA2] Anton Antonov, “Raku, Python, and Wolfram Language over LLM functionalities”, (2023), Wolfram Community.

[AA3] Anton Antonov, “AI vision via Raku”, (2023), Wolfram Community.

[MT1] Marco Thiel, “Direct API access to new features of GPT-4 (including vision, DALL-E, and TTS)​​”, November 8, (2023), Wolfram Community, STAFF PICKS.

[OAIb1] OpenAI team, “New models and developer products announced at DevDay” , (2023), OpenAI/blog .

Functions, packages, and paclets

[AAf1] Anton Antonov, MermaidInk, WL function, (2023), Wolfram Function Repository.

[AAp1] Anton Antonov, LLMVision.m, Mathematica package, (2023), GitHub/antononcube .

[AAp2] Anton Antonov, OpenAIMode, WL paclet, (2023), Wolfram Language Paclet Repository.

[AAp3] Anton Antonov, OpenAIRequest.m, Mathematica package, (2023), GitHub/antononcube .

[CWp1] Christopher Wolfram, OpenAILink, WL paclet, (2023), Wolfram Language Paclet Repository.

[WRIp1] Wolfram Research, Inc., LLMFunctions, WL paclet, (2023), Wolfram Language Paclet Repository.

[WRIp2] Wolfram Research, Inc., Chatbook, WL paclet, (2023), Wolfram Language Paclet Repository.

[WRIp3] Wolfram Research, Inc., Chess, WL paclet, (2023), Wolfram Language Paclet Repository.

Videos

[AAv1] Anton Antonov, “OpenAIMode demo (Mathematica)”, (2023), YouTube/@AAA4Prediction.

Nightcore “Conflict” video making

Introduction

This notebook shows how to make Nightcore modifications to the animation video, “Conflict” (1983), Soyuzmultfilm.

Remark: In Russian: “Конфликт”, (1983), Союзмультфилм .

Remark: We use “Conflict” since its licencing allows copies of it to be (publicly) played via YouTube.

Remark: The notebook follows closely a previous post of mine about making Nightcore version of the song “Schweine”.

The Nightcore transformation of the video was fairly straightforward with Mathematica / WL. The video transformation and combination are also fairly straightforward or easy.

Remark: Here is the final result uploaded to YouTube: https://youtu.be/C2TtkKfQa9I

Get movies

Here are links to that video:

I downloaded the videos from after searching yandex.ru (dzen.ru). Alternatively, one can find and download videos in Firefox or Google Chrome via relevant plugins. (Or use VLC; or utilize the paclet described in the post “Playing with YouTube from Mathematica”, [BMI1].)

At this point I have a small official video and larger one. This gives the opportunity to demonstrate transferring of the “Dolphin” signature from the “official” video to the larger one. (See the frame manipulation below.)

Here we import the downloaded video:

vdConflict0 = Import["~/Downloads/Conflict-Soviet-Animation.mp4"]

Make Nightcore audio

The process for making a song to be in the Nightcore style is described in Wikipedia, [Wk1]. Basically, we just make the tempo 20-30% faster and raise the pitch with, $\approx 5.5$ semitones.

Remark: An alternative of the process shown in this section is to use audio transformation programs like Audacity and AmadeusPro.

Here we get the audio from the video:

auConflict = Audio[vdConflict0]

Here we change the tempo to be 20% faster:

AbsoluteTiming[ auConflictFaster = AudioTimeStretch[auConflict, 1/1.2] ]

Here we raise the pitch with $5.5$ semitones:

AbsoluteTiming[ auConflictNightcore = AudioPitchShift[auConflictFaster, Quantity[5.5, "Semitones"]] ]

Direct video styling

If we only wanted to change how the video looks we can directly manipulate the video frames with VideoFrameMap, [WRI6] :

AbsoluteTiming[ k = 0; vdConflict4 = VideoFrameMap[ImageEffect[#, "Tritanopia"] &, vdConflict0]; ] (*{75.6817, Null}*)

vdConflict4

Remark: Since we want to make both the audio and video shorter we have to use video frames.

Make Nightcore video

Get the frames of the video:

AbsoluteTiming[ lsFrames = VideoExtractFrames[vdConflict0, All]; ] (*{2.65153, Null}*)

Show the number of frames:

Length[lsFrames] (*10730*)

Generate (audio-less) video from the list of frames that have the same length as the generated audio:

AbsoluteTiming[ vdConflictNew = VideoGenerator[lsFrames, Duration[auConflictNightcore]]; ] (*{56.1004, Null}*)

Combine the video and audio (into a new video):

AbsoluteTiming[ vdConflictNightcore = VideoCombine[{vdConflictNew, auConflictNightcore}]; ] (*{0.144603, Null}*)

Here is the result:

vdConflictNightcore

Remark: Here we do not export the video, since Mathematica saves it in a “standard” location of the host operating system.

Cutting-off and re-splicing the movie credits

In order to engage better people from the Millennials and Gen Z generational cohorts, I want to move the movie credits from the start of the movie to be at the end. We use the function VideoSplit, [WRI10], and VideoJoin, [WRI11].

Here we show frames that indicate where to split the obtained Nightcore movie:

VideoExtractFrames[vdConflictNightcore, {1, 30, 36, 37, 38}]

Here we split the video:

{v1, v2} = VideoSplit[vdConflictNightcore, 37];

In order to have a better visual flow we color-invert the frames of the credits part:

v1Negative = VideoFrameMap[ColorNegate, v1];

Here we splice the “main” part with the “negated” credits part:

vdConflictNightcore2 = VideoJoin[v2, v1Negative]

References

[BMA1] b3m2ma1, “Playing with YouTube from Mathematica”, (2018), Wolfram Community. (GitHub link.)

[Wk1] Wikipedia entry, “Nightcore”.

[WRI1] Wolfram Research (2010), TextRecognize, Wolfram Language function, https://reference.wolfram.com/language/ref/TextRecognize.html (updated 2020).

[WRI2] Wolfram Research (2016), Audio, Wolfram Language function, https://reference.wolfram.com/language/ref/Audio.html (updated 2020).

[WRI3] Wolfram Research (2016), AudioTimeStretch, Wolfram Language function, https://reference.wolfram.com/language/ref/AudioTimeStretch.html (updated 2020).

[WRI4] Wolfram Research (2016), AudioPitchShift, Wolfram Language function, https://reference.wolfram.com/language/ref/AudioPitchShift.html (updated 2020).

[WRI5] Wolfram Research (2020), VideoExtractFrames, Wolfram Language function, https://reference.wolfram.com/language/ref/VideoExtractFrames.html.

[WRI6] Wolfram Research (2020), VideoFrameMap, Wolfram Language function, https://reference.wolfram.com/language/ref/VideoFrameMap.html (updated 2021).

[WRI7] Wolfram Research (2008), ImageEffect, Wolfram Language function, https://reference.wolfram.com/language/ref/ImageEffect.html (updated 13).

[WRI8] Wolfram Research (2020), VideoGenerator, Wolfram Language function, https://reference.wolfram.com/language/ref/VideoGenerator.html (updated 2021).

[WRI9] Wolfram Research (2020), VideoCombine, Wolfram Language function, https://reference.wolfram.com/language/ref/VideoCombine.html.

[WRI10] Wolfram Research (2020), VideoSplit, Wolfram Language function, https://reference.wolfram.com/language/ref/VideoSplit.html.

[WRI11] Wolfram Research (2020), VideoJoin, Wolfram Language function, https://reference.wolfram.com/language/ref/VideoJoin.html.

Wolfram Language conference in St. Petersburg

Two weeks ago (June 1st and 2nd) I participated in the Wolfram Language conference in St. Petersburg, Russia.
Here are the corresponding announcements:

The conference was co-organized by Kirill Belov and Petr Genadievich Tenishev.

Link to the GitHub repository with my conference presentation materials.

Here is a mind-map of the potential presentations Kirill and I discussed:

System dynamics presentation

I presented “Динамические системы : Расширение и улучшение эпидемиологических моделей”
(in English: “Dynamics systems: extending and improving epidemiological models”.)

The main presentation slides had a dozen supplements:

Making two presentations

Interestingly, I first prepared a Latent Semantic Analysis (LSA) talk, but then found out that the organizers listed another talk I discussed with them, on extending dynamic systems models. (The latter one is the first we discussed, so, it was my “fault” that I wanted to talk about LSA.)

Here are the presentation notebooks for LSA in English and Russian .

Some afterthoughts

  • Тhe conference was very “strong”, my presentation was the “weakest.”
    • With “strong” I refer to the content and style of the presentations.
  • This was also the first scientific presentation I gave in Russian. I also got a participation diploma .

to demonstrate generation of epidemiological modeling code.

  • Preparing for the conference reminded me of some the COVID-19 modeling hackathons I participated in.
  • I prepared the initial models of artillery shells manufacturing, but much more work has to be done in order to have a meaningful article or presentation. (Hopefully, I am finishing that soon.)

References

Articles, posts, presentations

[AA1] Антон Антонов,
“Динамические системы : Расширение и улучшение эпидемиологических моделей” .

[AA2] Антон Антонов,
“COVID-19 modeling over Botswana” ,

[AA3] Anton Antonov,
“WirVsVirus 2020 hackathon participation” ,
(2020),
MathematicaForPrediction at WordPress .