# Sum of its parts - replicating a porcelain sculpture of Nuala O’Donovan

1. Introduction

Nuala O’Donovan is an Irish Artist, living and working in Cork. According to her website her research areas are "Irregularities in Patterns in Nature" and "The Geometry of Natural Forms".

Radiolaria Grid series, High fired porcelain, unglazed. Nuala O’Donovan 2015

Radiolaria Grid series – interior detail –

2. Question

I would like to replicate with Mathematica Nuala's sculpture pictured below. It is made of small porcelain tubes and called "The sum of its parts". A rectangular exterior turns into a mikado-like chaos as we move inside.

Nuala O’Donovan, The sum of its parts

I began with the interior:

Graphics3D[
Table[{
MaterialShading[<|"BaseColor" -> White, "RoughnessCoefficient" -> 0.1 |>],
Cylinder[RandomReal[40, {2, 3}]]}, {60}],
Boxed -> False,
BoxRatios -> {1, 1, 2},
Background -> GrayLevel[0],
Lighting -> "ThreePoint"]


and immediately (as usual) got a problem:

• Due to the changed BoxRatios, the tubes appear to be oval rather than round, and I don't know how to fix this distortion.
• The next question is how we can "surround" the inner randomly scattered "mikados" with a rectangular outside structure. How to get the "sum of its parts", so to say.
• And a third (non-essential) question: Would it be possible to give the background a grayish gradient-like appearance like in the above photo?
• Interesting, do you know the material of these objects? Commented Nov 26, 2023 at 13:42
• Try ClipPlanes instead of adjusting bounding box. Commented Nov 26, 2023 at 13:49
• Thanks, Yarchik, ClipPlanes might be a good idea. Will try later. The objects are made of high fired unglazed porcelain.
– eldo
Commented Nov 26, 2023 at 14:53

• We select random points in the cube and select random directions to draw infinitelines and cut their by the PlotRange.
• We use DiscretizeRegion to the boundary of cube and extend the lines to infinitelines, after that we also cut it by PlotRange.
• Finally we use DiscretizeGraphics to get all the lines.
reg = Cuboid[{0, 0, 0}, {4, 3, 5}];
n = 60;
pts = RandomPoint[reg, n];
dirs= RandomPoint[Sphere[], n];
interior =
PlotRange -> RegionBounds[reg], Boxed -> False] //
DiscretizeGraphics;
δ = 1.2;
faces = Graphics3D[
MeshPrimitives[#,
1] & /@ (DiscretizeRegion[#,
MaxCellMeasure -> "Area" -> δ] & /@
MeshPrimitives[RegionBoundary@reg, 2]) /.
Line -> InfiniteLine, PlotRange -> RegionBounds[reg],
Boxed -> False] // DiscretizeGraphics;
Graphics3D[{MeshPrimitives[faces, 1] /. Line -> Tube,
MeshPrimitives[interior, 1] /. Line -> Tube}, Boxed -> False]


• For non convex region.
Clear["Global*"];
reg = RegionProduct[Annulus[{0, 0}, {1/2, 1}, {0, 3 Pi/2}],
Line[{{0}, {1.}}]];
n = 60;
pts = RandomPoint[reg, n];
dirs = RandomPoint[Sphere[], n];
interior =
Table[Tube[{pts[[i]] + #[[1]]*dirs[[i]],
pts[[i]] + #[[-1]]*dirs[[i]]}] & /@
Flatten@List[
Reduce[Rationalize[pts[[i]] + s*dirs[[i]] ∈ reg, 0],
s] /. Or -> List], {i, 1, n}];
lines = MeshPrimitives[
BoundaryDiscretizeRegion[reg, MaxCellMeasure -> ∞],
1][[;; , 1]];
faces = Table[
Tube[{line[[1]] + #[[1]]*(line[[2]] - line[[1]]),
line[[1]] + #[[-1]]*(line[[2]] - line[[1]])}] & /@
Flatten[List[
Reduce[Rationalize[
line[[1]] + s*(line[[2]] - line[[1]]) ∈ reg, 0],
s] /. Or -> List] /. s == 0 -> Nothing /.
False -> Nothing], {line, lines}];
Graphics3D[{interior, faces}, Boxed -> False]


• Use SignedRegionDistance to cut the infinite lines.
Clear["Global*"];
reg = RegionProduct[Annulus[{0, 0}, {1/2, 1}, {0, 3 Pi/2}],
Line[{{0}, {1.}}]];
n = 60;
pts = RandomPoint[reg, n];
dirs = RandomPoint[Sphere[], n];
dist = SignedRegionDistance@reg;
interior =
Table[ParametricPlot3D[
pts[[i]] + s*dirs[[i]] // Evaluate, {s, -10, 10},
RegionFunction -> Function[{x, y, z, s}, dist@{x, y, z} <= 0],
PlotStyle -> Tube[.01], PlotRange -> All, PlotPoints -> 200,
MaxRecursion -> 6], {i, 1, n}] // Show;
lines = MeshPrimitives[
BoundaryDiscretizeRegion[reg, MaxCellMeasure -> ∞],
1][[;; , 1]];
faces = Table[
ParametricPlot3D[
lines[[i, 1]] + s (lines[[i, 2]] - lines[[i, 1]]) //
Evaluate, {s, -10, 10},
RegionFunction ->
Function[{x, y, z, s},
dist[lines[[i, 1]] + s (lines[[i, 2]] - lines[[i, 1]])] <= 0],
PlotRange -> All, PlotPoints -> 100, MaxRecursion -> 2,
PlotStyle -> Tube[.01]], {i, 1, Length@lines}];
Show[interior, faces] // DiscretizeGraphics


• Another non convex regions.
Clear["Global*"];
reg = ConcaveHullMesh[{{0, 0, 0}, {0, 1, 0}, {0, 0, 1}, {0, 1, 1}, {1,
1/3, 1/3}, {1, 2/3, 1/3}, {1, 1/3, 2/3}, {1, 2/3, 2/3}, {2, 0,
0}, {2, 1, 0}, {2, 0, 1}, {2, 1, 1}}];
bd = RegionBounds[reg];
n = 50;
pts = RandomPoint[reg, n];
dirs = RandomPoint[Sphere[], n];
interior =
ParametricPlot3D[
Table[pts[[i]] + s*dirs[[i]], {i, 1, n}] // Evaluate, {s, -10, 10},
PlotPoints -> 400, MaxRecursion -> 0,
RegionFunction -> Function[{x, y, z, t}, Element[{x, y, z}, reg]],
PlotRange -> bd];
faces = MeshPrimitives[RegionBoundary@reg, 2];
m = 8;
boundary = Table[
With[{pts = RandomPoint[face, m]},
ParametricPlot3D[
Table[{1 - s, s} . {pts[[i]], pts[[j]]}, {i, 1, m}, {j, 1, i}] //
Flatten, {s, -2, 2},
RegionFunction ->
Function[{x, y, z, s}, {x, y, z} \[Element] reg],
PlotRange -> RegionBounds[reg], PlotRange -> bd]], {face, faces}];
Graphics3D[
MeshPrimitives[
Show[interior, boundary, Boxed -> False, Axes -> False] //
DiscretizeGraphics, 1] /. Line -> Tube, Boxed -> False]


Clear["Global*"];
SeedRandom[4];
cba = Flatten[#, 2] &@
CoordinateBoundsArray[{{0, 3}, {0, 3}, {0, 5}}, 1] ;
{f1a, f1b} = GatherBy[cba, {#[[1]]} &][[{1, -1}]];
{f2a, f2b} = GatherBy[cba, {#[[2]]} &][[{1, -1}]];
{f3a, f3b} = GatherBy[cba, {#[[3]]} &][[{1, -1}]];
chm = ConvexHullMesh[cba + RandomReal[{-0.3, 0.3}, {96, 3}]];
cpts = RandomPoint[chm, 400] // Partition[#, 2] &;
cyls = Cylinder[#, RandomReal[{0.02, 0.05}]] & /@ cpts;

cyls1a = Cylinder[#,
RandomReal[{0.02, 0.05}]] & /@ (Tuples[f1a, 2] //
MaximalBy[#, Apply[EuclideanDistance], Length@#] &)[[1 ;; ;;
7]];

cyls1b = Cylinder[#,
RandomReal[{0.02, 0.05}]] & /@ (Tuples[f1b, 2] //
MaximalBy[#, Apply[EuclideanDistance], Length@#] &)[[1 ;; ;;
9]];

cyls2a = Cylinder[#,
RandomReal[{0.02, 0.05}]] & /@ (Tuples[f2a, 2] //
MaximalBy[#, Apply[EuclideanDistance], Length@#] &)[[1 ;; ;;
5]];

cyls2b = Cylinder[#,
RandomReal[{0.02, 0.05}]] & /@ (Tuples[f2b, 2] //
MaximalBy[#, Apply[EuclideanDistance], Length@#] &)[[1 ;; ;;
9]];

cyls3a = Cylinder[#,
RandomReal[{0.02, 0.05}]] & /@ (Tuples[f3a, 2] //
MaximalBy[#, Apply[EuclideanDistance], Length@#] &)[[1 ;; ;;
7]];

cyls3b = Cylinder[#,
RandomReal[{0.02, 0.05}]] & /@ (Tuples[f3b, 2] //
MaximalBy[#, Apply[EuclideanDistance], Length@#] &)[[1 ;; ;;
7]];

art = Graphics3D[{
EdgeForm[None]
, RGBColor[0.85, 0.83, 0.79] (* #FFF6E5 , RGBColor["#E3DAC9"]*)
, cyls1a , cyls1b
, cyls2a, cyls2b
, cyls3a, cyls3b
, cyls
, AbsolutePointSize[6], Ball[#, RandomReal[{0.03, 0.07}]] &@cba
}
, SphericalRegion -> True
, Lighting -> "Neutral"
, Boxed -> False
, ImageSize -> 600
]


• Excellent, thank you very much!
– eldo
Commented Nov 27, 2023 at 17:00
• You are welcome. @eldo
– Syed
Commented Nov 27, 2023 at 17:02

I came across your work today and found it fascinating seeing my work interpreted using codes and computer programmes. The original work is in porcelain and handbuilt - so that all the elements are slightly irregular Love the variations on the original piece. Bravo! Nuala

• Thanks, Nuala, nice to meet you here - and congrats for your fascinating pieces of art :)
– eldo
Commented Jun 8 at 16:38
• This has to be one of those most rare cases, where a "non-answer" (by MSE standards) is nonetheless a wonderful response. Commented Jun 8 at 17:52
Clear["Global*"]
tube[l : {a : {x_, y_, z_}, b : {u_, v_, w_}}, s_ : 1] := Module[{}
, {Tube[BSplineCurve[Subdivide[a, b, 30]]
, RotateLeft[RandomReal[{.02, .048}, 30], RandomInteger[3]]]}];

slice[grid_ : {6, 4}, size_ : .15, deltaEdges_ : 100] :=
Module[{gg, edges, vcoord, mesh},
gg = GridGraph[grid];
vcoord = VertexCoordinates /. AbsoluteOptions[gg, VertexCoordinates];
edges = RandomSample[
Complement[UndirectedEdge @@@ Subsets[VertexList@gg, {2}], EdgeList@gg]
, deltaEdges];
mesh = MeshRegion[vcoord, Line[List @@@ edges]];
tube[#] & /@ Map[# /. {x_, y_} :> {x - 1, y, RandomReal[size]} &, Sequence @@@ MeshPrimitives[mesh, 1], {2}]
];

SeedRandom[312];
Graphics3D[{
MaterialShading[<|"BaseColor" -> White, "SheenColor" -> LightBlue
, "SheenRoughnessCoefficient" -> .9, "RoughnessCoefficient" -> 0.9, "SpecularColor" -> Yellow|>]
, slice[{6, 4}, 3., 140] (*Interior*)
, FoldList[Rotate[#,  - 90  °, {0, 1, 0}, #2] &
, slice[{6, 4}, .185, 65], {{0, 0, 0}, {0, 0, 3}, {3, 0, 3}}] (*Sides*)
, Rotate[slice[{4, 4}, .075, 55], 90 °, {1, 0, 0}, {0, 1, 0}] (*Top*)
, Rotate[slice[{4, 4}, .075, 55], 90 °, {1, 0, 0}, {0,  3.56, 2.54}] (*Bottom*)
}
, Axes -> False, Boxed -> False, SphericalRegion -> True
, ViewPoint -> {-2.8, 1.3, 2.5}, ViewVertical -> {0, -1, 0}
, Lighting -> "ThreePoint", ImageSize -> Large,
Background -> GrayLevel[0]]
`