# How to produce a Calder mobile?

Alexander Calder (1898 - 1976) was an American artist known for for his mobiles and his public sculptures.

Here are two examples of his mobiles which I want to approximately reproduce with Mathematica:

The second example has different colors:

We can use BSplineCurve to draw a Calder-like rounded shape:

gr = Graphics[BSplineCurve[{{0, 0}, {1, 0}, {2.5, 0.5}, {1, 0.5}, {0, 1}}, SplineClosed -> True]]


and this answer of kglr: How to draw a colored curved shape to fill it:

BoundaryDiscretizeGraphics[gr, MeshCellStyle -> {2 -> Darker @ Red}]


Maybe one could proceed with TreePlot, but with our rounded red shapes as VertexShapeFunction.

TreePlot[{1 -> 2, 2 -> 3, 3 -> 4, 4 -> 0, 5 -> 1, 6 -> 2, 7 -> 3, 8 -> 4, 9 -> 0},
VertexShapeFunction -> "RoundedTriangle",
VertexSize -> 0.2]


Or would it be easier to use Graphics- directives (slightly curved connected lines with randomized Calder-shapes)?

I don't know how to proceed and thank you in advance for any suggestions or, hopefully, a Calder-like solution.

• So I suppose you also want these mobiles to be "physically" correct? Namely, when they are suspended, the forces and torques are in balance? :) Nov 2, 2023 at 10:20
• Nope - I'm more interested in an aesthetically appealing image.
– eldo
Nov 2, 2023 at 10:23
• What is the meaning of "mobile" here? Any synonyms? Nov 2, 2023 at 11:29
• @azerbajdzan From the Cambridge Dictionary: "mobile: a decoration or work of art that has many parts that move freely in the air, for example hanging from threads" Nov 2, 2023 at 11:40
• @flinty: Yes, also a kinetic sculpture as I found on en.wikipedia.org/wiki/Mobile_(sculpture). Nov 2, 2023 at 11:43

With minor modifications of gr in OP:

ClearAll[randomLeaf]

randomLeaf  := Module[{tip = {RandomReal[{2, 5}], RandomReal[{-1/2, 0}]}},
Graphics[
BSplineCurve[{{0, 0}, {0, 0},  {1, -1/2}, tip, tip,
{RandomReal[{1, 3}], RandomReal[{0, 1/3}]}, {0, 1/2}},
SplineClosed -> True]]]

SeedRandom[1];

Row @ Table[Show[randomLeaf, ImageSize -> 200], 5]


We can use randomLeaf as custom arrowhead in a custom EdgeShapeFunction as follows:

ClearAll[calderESF]

calderESF[leaflist_, sizes_: {.05,.2},curvature_ : {-.2, .2}] :=
RandomReal[sizes], 0], 1.,
Show @ BoundaryDiscretizeGraphics[randomLeaf,
MeshCellStyle -> {2 -> RandomColor[]}]}}],
GraphComputationGraphElementData["CurvedEdge",
"Curvature" -> RandomReal[curvature]][##]} &


Examples:

branches =
Map[Reverse]@{1 -> 2, 2 -> 3, 3 -> 4, 4 -> 0, 5 -> 1, 6 -> 2,
7 -> 3, 8 -> 4, 9 -> 0};

leaves = GraphComputationSinkVertexList @ Graph @ branches;

SeedRandom[1];

Graph[branches,
PerformanceGoal -> "Quality",
EdgeShapeFunction -> calderESF[leaves],
VertexSize -> 0,
VertexShapeFunction -> None,
GraphLayout -> "LayeredDigraphEmbedding",
ImagePadding -> {{50, 50}, {100, 10}}]


SeedRandom[1];

branches2 = EdgeList@IndexGraph@RandomTree@20;

leaves2 = GraphComputationSinkVertexList @ Graph @ branches2;

SeedRandom[444];

Graph[branches2,
PerformanceGoal -> "Quality",
EdgeShapeFunction -> calderESF[leaves2],
VertexSize -> 0,
VertexShapeFunction -> None,
GraphLayout -> "LayeredDigraphEmbedding",
ImageSize -> 700,
ImagePadding -> {{220, 150}, {200, 10}}]


Replace "LayeredDigraphEmbedding" with "RadialEmbedding" and, ImagePadding -> ... with ImagePadding -> 200 to get

This answer is quite lacking, and there's a lot of improvements to be made. Maybe someone can improve on this however.

Using kirma's answer here (and modifying the parameters a little), we can get shapes (smoothed random polygons) that kind of look like Calder shapes.

We can then assign the VertexShapes to be these random smooth polygons:

SeedRandom[1234];
{minPolySides, maxPolySides} = {3, 6};
mobileStructure = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 0, 5 -> 1, 6 -> 2,
7 -> 3, 8 -> 4, 9 -> 0};
numberofThings = 10;

randomPolys =
Table[With[{coords =
Append[#, #[[1]]] &@
RandomPolygon[{"Convex",
RandomInteger[{minPolySides, maxPolySides}]}][[1]]},
With[{ip =
Interpolation[
Transpose@{Rescale@
Accumulate@
Prepend[EuclideanDistance @@@ Partition[coords, 2, 1], 0],
coords}, InterpolationOrder -> 1]},
Graphics[{FaceForm@Red,
Polygon@Table[
Mean@Table[ip[Mod[t + t0, 1]], {t0, 0, 0.3, .01}], {t, 0,
1., .01}]}]]], numberofThings];

vs = Thread[Range[0, numberofThings - 1] -> randomPolys];
TreePlot[mobileStructure,
VertexShape -> vs, VertexSize -> 0.5, EdgeStyle -> Thick,
BaseStyle -> Black]


This is still missing some critical properties of your two examples though:

1. It looks like in your examples of Calder's mobiles, some tree vertices do not have a "shape" on them, and are instead just branching points for multiple shapes to hang off of.
2. The shapes are really not perfect still, I think I may have made them too smooth
• +1 - it's much more than just a promising start :)
– eldo
Nov 2, 2023 at 16:40

Simple example that you can play with.

vf[{xc_, yc_}, name_, {w_, h_}] :=
Module[{rr = RandomReal[{-1/4, 0}]},
BoundaryDiscretizeGraphics[
BSplineCurve[{xc, yc} + RotationMatrix[rr*\[Pi]] . # & /@ {{0,
0}, {RandomReal[{0.5, 1}],
RandomReal[{-1, 0}]}, {RandomReal[{1, 2}],
RandomReal[{-1, 0}]}, {RandomReal[{1, 2}],
RandomReal[{1, 0}]}, {RandomReal[{0.5, 1}],
RandomReal[{1, 0}]}, {0, 0}}],
MeshCellStyle -> {2 -> ColorData[97, RandomInteger[15]]}]]

ef[pts_List, e_] :=
BSplineCurve[{pts[[1]], Mean[pts] + RandomReal[{-1, 1}, 2], pts[[2]]}]

Graph[{1 -> 2, 2 -> 3}, VertexCoordinates -> {{0, 0}, {0, 2}, {0, 4}},
VertexShapeFunction -> 1 | 2 | 3 -> vf,
EdgeShapeFunction -> (# -> ef & /@ {1 -> 2, 2 -> 3})]
`