Can we reproduce Antonio Asis circle interferences?

Question

Antonio Asis

Antonio Asis (1932 - 2019) was an Argentine artist and one of the main exponents of kinetic art and op art. Asis was born in Buenos Aires. At the age of 14 he enrolled at the National School of Fine Arts of his city which he attended until 1950. In 1956, Asis moved to Paris where he joined an international circuit of artists including Victor Vasarely, Jesús Rafael Soto and Jean Tinguely. In this dynamic environment, Asis became interested in the study of colours, focusing on the harmony between the chromatic ranges linked to geometric shapes. Among Asis' best known works are the "Cercles" and "Intérferences" series, which he produced in many different variants.

Antonio Asis, Interférences en bleu et jaune, 1965

Asis' works are represented in numerous collections, including the Centre Pompidou in Paris. Many of his works (including fascinating colour studies) are featured on the Anonio Asis site.

Cercles series

My reproduction of one of Asis' "Cercles" paintings was surprisingly simple and a matter of minutes rather than hours. I don't show the original because it is almost identical.

a =
  {Black, Annulus[{4.2, 4.4}],
   Darker @ Red, Annulus[{6.2, 7.6}],
   Black, Annulus[{7.8, 8.5}],
   Black, Annulus[{8.7, 8.8}],
   RGBColor[1, 0.0, 0.0, 0.4], Annulus[{9.3, 10}]};

b = 
  {Darker @ Red, Annulus[{4.2, 4.4}],
   Black, Annulus[{6.2, 7.6}],
   Darker @ Red, Annulus[{7.8, 8.5}],
   Darker @ Red, Annulus[{8.7, 8.8}],
   RGBColor[GrayLevel[0.7]], Annulus[{9.3, 10}]};

Grid[
 Map[Graphics, {{a, b, a}, {b, a, b}, {a, b, a}}, {2}],
 Background -> GrayLevel[0.8]]

My Mathematica reproduction of Antonio Asis' "Cercles 1995"

Interférences series

Antonio Asis, Interférences, 1965

On the other hand, I don't have enough skills to reproduce the above monochromatic "Interférences" variant. A few months ago I wouldn't have asked because a Mathematica replica seemed excessively difficult to me. But, given the many excellent solutions received on other complicated art-related questions, I now would like to ask

Question

How can we reproduce the monochromatic "Interférences" shown above?

@Domen, I appreciate your viewpoint Domen, but I enjoy these contributions—and hope the OP is not discouraged from posting them. Just my subjective opinion. — Craig Carter
– Craig Carter, Commented May 5, 2024 at 22:18

yarchik · Accepted Answer · 2024-05-06 21:05:47Z

My procedure consists of the following steps:

Define a function that produces the basic element - a circle with six alternating colour areas
Create a basic black and white random image consisting of a 3 by 3 grid of circles with slightly random coordinates and pretty random radii using Table with RandomReal
Define a mask, which is constructed in the same way (as random Disk on a grid)
Define the mask border (Circles, later will be Darker[Darker[Red]])
Invert the colours (1 - # &) of the image using ImageApply according to the mask
Combine together with the mask border and replace colours using ColorReplace

The code:

sixCircle[pos_, r_] := Module[{rs},
  rs = Accumulate[RandomReal[{0, r}, 6]];
  rs = rs/rs[[6]]*r;
  Flatten[Table[{c[Mod[i, 2]], Disk[pos, rs[[i]]]}, {i, 6, 1, -1}]]]

c[1] = Black;
c[0] = White;
gr = Graphics[{c[1], Rectangle[{0, 0}, {200, 200}], 
    RandomSample[
     Table[sixCircle[{10 + kx*40, 10 + ky*40} + 
        RandomReal[{0, 10}, 2], RandomReal[{20, 40}]], {kx, 3}, {ky, 
       3}]]}, PlotRange -> {{50, 150}, {50, 150}}];
im[1] = Rasterize[gr];
maskDisks = 
  Table[Disk[{10 + kx*50, 10 + ky*50} + RandomReal[{0, 10}, 2], 
    RandomReal[{10, 30}]], {kx, 2}, {ky, 2}];
topGraphics = 
  Graphics[{Darker[Darker[Red]], maskDisks /. Disk -> Circle}, 
   PlotRange -> {{50, 150}, {50, 150}}];
im[20] = Rasterize[topGraphics, ImageSize -> Medium];
mask = Graphics[maskDisks, PlotRange -> {{50, 150}, {50, 150}}];
im[2] = ImageApply[1 - # &, im[1], Masking -> mask];
c[10]=RGBColor[{0.8313,0.8235,0.8431}]
c[11]=RGBColor[{0.3294,0.2235,0.2431}]
im[3] = Rasterize[
  ColorReplace[im[2]*im[20], {White -> c[10], Black -> c[11]}], 
  ImageSize -> Medium]

In answering this type of questions I am only interested in the algorithmic part. It is clear that one can further tweak parameters and produce a more faithful or beautiful representations of the artwork. Such answers will surely follow. But I stop at this stage.

Update

Interférences en bleu et jaune is even simpler to generate if one does not attempt to so exactly

color = ColorData["BlueGreenYellow"];
nCircle[pos_, r_, n_] := Module[{rs},
  rs = Accumulate[RandomReal[{r/n, r}, n]];
  rs = rs/rs[[n]]*r;
  Flatten[Table[{color@RandomReal[0.5], Disk[pos, rs[[i]]]}, {i, n, 1, -1}]]]
rng = {{30, 170}, {30, 170}};
noise2d[] := RandomReal[{0, 10}, 2]
gr = Graphics[{color@RandomReal[{0, 0.5}], 
    Rectangle[{0, 0}, {200, 200}], 
    RandomSample[Table[nCircle[{-5 + kx*40, -5 + ky*40} + noise2d[], 
       RandomReal[{20, 35}], RandomInteger[{3, 12}]], {kx, 4}, {ky, 4}]]},
   PlotRange -> rng];
im[1] = Rasterize[gr];
mask = Graphics[Table[Disk[{kx*50, ky*50} + noise2d[], RandomReal[{15, 25}]], {kx, 3}, {ky, 3}], PlotRange -> rng];
im[2] = ImageApply[RotateLeft, im[1], Masking -> mask]

I do not get such images as presented here. My have rough boundary at each disk. Is it because of my version 13.0.? — three777
– three777, Commented May 6, 2024 at 21:35
@eldo Thanks for asking these interesting questions. A question related to Frank Stella's work could be timely: edition.cnn.com/2024/05/04/style/obituary-frank-stella-intl-hnk/… — yarchik
– yarchik, Commented May 8, 2024 at 8:56

vindobona · Accepted Answer · 2024-05-06 19:49:40Z

Update: Generating the highlighting disks over a grid and adding disk edges:

SeedRandom[2];
cercle[{x_, y_}, r_ : 3,  min_ : 7, max_ : 8] := 
  Module[{bands , rb, rw}, 
   bands = Subdivide[r, RandomInteger[{min, max}]];
   {rb, rw} = RandomSample[{Black, White}];
    Most@Reverse@MapIndexed[{If[OddQ @@ #2 , rb, rw]
        , EdgeForm[If[EvenQ @@ #2 , rb, rw]], 
        Disk[{x, y} , # + RandomReal[.2]]} &, bands]];

background = Image[
   Graphics[
    cercle[# + RandomReal[{.05}, 2], RandomInteger[{4, 5}]] & /@ 
     RandomSample[Flatten[Array[6.5 {##} &, {4, 4}], 1]]]
   , ImageResolution -> 200];

highlighting = 
  Disk[RandomReal[{-10, 10}] + #, 180  RandomReal[{.5, .7}]] & /@ 
   Flatten[Array[250 {##} &, {3, 3}], 1];

img = Image[
   HighlightImage[background
    , {EdgeForm[], highlighting}
    , ColorNegate@# &]
    , ImageResolution -> 400] //
  Image[
    ColorReplace[
     ColorNegate@#
     , {Black -> RGBColor[.36, .16, .18], 
      White -> RGBColor[.78, .77, .76]}]
    , ImageResolution -> 400] &

Original Post:

Generating a background image of random "cercles" and using HighlightImage in order to ColorNegate the background for the highlighted regions corresponding to a set of random disks.

SeedRandom[123];

cercle[{x_, y_}, r_ : 3,  min_ : 5, max_ : 5] := 
  Module[{bands , rb, rw}, 
   bands = Subdivide[r, RandomInteger[{min, max}]];
   {rb, rw} = RandomSample[{Black, White}];
    Reverse@MapIndexed[{If[OddQ @@ #2 , rb, rw]
       , EdgeForm[{Black}], Disk[{x, y} , # + RandomReal[.6]]} &, bands]];

background = Image[
   Graphics[
    cercle[# + RandomReal[{.05}, 2], RandomInteger[{3, 4}]] & /@ 
     RandomSample[Flatten[Array[5 {##} &, {4, 4}], 1]]]
   , ImageResolution -> 200];

hradius = 230;
hregion = 
  Rectangle[{150, 150}, ImageDimensions@background - {150, 150}];
hpoints = 
  RandomPointConfiguration[HardcorePointProcess[50, 1.2 hradius, 2], hregion];
highlighting = 
  Disk[#, hradius   RandomReal[{.38, .65}]] & /@ hpoints["Points"];

img = Image[
   HighlightImage[background
    , {EdgeForm[], highlighting}
    , ColorNegate@# &]
    , ImageResolution -> 400] //
  Image[
    ColorReplace[
     ColorNegate@#
     , {Black -> RGBColor[.36, .16, .18], 
      White -> RGBColor[.78, .77, .76]}]
    , ImageResolution -> 400] &

I do not get such images as presented here. My have rough boundary at each disk. Is it because of my version 13.0.? — three777
– three777, Commented May 6, 2024 at 21:35
@three777 It looks fine on 13.3 and 14.0. You could try to increase the ImageResolution to check if it makes a difference. — vindobona
– vindobona, Commented May 7, 2024 at 8:13
This is what I got when I run your code: i.sstatic.net/bZagNJbU.png — three777
– three777, Commented May 7, 2024 at 8:40
@three777 Are there any changes if you double the ImageResolution values ? — vindobona
– vindobona, Commented May 7, 2024 at 8:44

cvgmt · Accepted Answer · 2024-05-11 15:56:52Z

Edit

We change the operator order,that is, at first RegionUnion then RegionDifference ,now it work for all the 11,12,13,14 version.

Clear["Global`*"];
splitdisk[center_, r_] := Module[{radius, exterior, interior},
   radius = r*(Rest[Subdivide[0, 1, 7]] + RandomReal[{0, .1}, 7]);
   exterior = 
    FilledCurve[{Line@CirclePoints[center, #, 40]} & /@ radius];
   interior = 
    FilledCurve[{Line@CirclePoints[center, #, 40]} & /@ Most@radius];
   BoundaryDiscretizeGraphics /@ {interior, exterior}];
diskss = 
  splitdisk[#, RandomReal[{2, 3}]] & /@ 
   RandomSample[Tuples[{Range[-10, 10, 2], Range[-10, 10, 2]}]];
reg = Fold[RegionDifference[RegionUnion[#1, Last@#2], First@#2] &, 
  diskss[[1, 1]], Rest@diskss]

To make the animation faster, we use FilledCurve which provide Even-Odd rule.

pts = MeshCoordinates[reg];
data = MeshCells[reg, 1, "Multicells" -> True] /. 
   Line[indexs_] :> {BSplineCurve[pts[[indexs[[;; , 1]]]]]};
Manipulate[
 Graphics[{RGBColor[0.32, 0.18, 0.2], 
   FilledCurve[
    Join[data, {{BSplineCurve[CirclePoints[p, 4, 10]]}, {BSplineCurve[
        CirclePoints[q, 5, 10]]}}]]}, PlotRange -> 12], 
 Row[{Control[{{p, {2, 2}}, {-10, -10}, {10, 10}}], 
   Control[{{q, {0, 0}}, {-10, -10}, {10, 10}}]}], 
 ControlPlacement -> Top]

test another shapes rather then Disk.

font = Cases[
   Cases[First[
     First[ImportString[
       ExportString[
        Style["A", Bold, FontFamily -> "Helvetica", FontSize -> 10], 
        "PDF"], {"PDF", "PageGraphics"}, 
       "TextOutlines" -> True]]]], _FilledCurve, -1];
curve = GeometricFunctions`DecodeFilledCurve @@ font // First;
Manipulate[
 Graphics[{RGBColor[0.32, 0.18, 0.2], 
   FilledCurve[
    Join[data, curve /. {x_Real, y_Real} :> p + 2 {x, y}]]}, 
  PlotRange -> 12], {{p, {-10, -10}}, {-20, -20}, {0, -10}}, 
 ControlPlacement -> Top]

6 random Disk, need not disjoint.

centers = RandomPoint[Rectangle[{-10, -10}, {10, 10}], 6];
Graphics[{RGBColor[0.32, 0.18, 0.2], 
  FilledCurve[
   Join[data, {BSplineCurve[
        CirclePoints[#, RandomReal[{4, 5}], 10]]} & /@ centers]]}, 
 PlotRange -> 12]

Original

We use Region. Since the fragile of the region functions in the new version, here we only test n=10 in version 14.0,the case n=100 only work for version 11.3, we hope to find a way to overcome it.
We use RegionSymmetricDifference to get even-odd rule.

Clear["Global`*"];
SeedRandom[1];
disks[center_, r_] := 
  BoundaryDiscretizeGraphics[Disk[center, #], 
     MaxCellMeasure -> .01] & /@ (r (Rest[Subdivide[0, 1, 7]] + 
       RandomReal[{0, .05}, 7]));
n = 10;
diskss = disks[#, RandomReal[{2, 3}]] & /@ 
   RandomPoint[Rectangle[{-10, -10}, {10, 10}], n];
reg = Fold[
   RegionUnion[RegionDifference[#1, RegionUnion@#2], 
     RegionSymmetricDifference@#2] &, 
   RegionSymmetricDifference[First@diskss], Rest@diskss];
ani = Manipulate[
  Region[Fold[RegionSymmetricDifference, 
    Join[{BoundaryDiscretizeGraphics[Disk[p, 5]], 
      BoundaryDiscretizeGraphics[Disk[q, 4]]}, {reg}]], 
   PlotRange -> 10, ImageSize -> Large, 
   BaseStyle -> RGBColor[
    0.3201602967912482, 0.18216988264290768`, 0.1991970531583795]], 
  Row[{Control[{{p, {2, 2}}, {-10, -10}, {10, 10}}], 
    Control[{{q, {0, 0}}, {-10, -10}, {10, 10}}]}], 
  ControlPlacement -> Top]

Edit

Test CSGRegion.( for version 13 or 14)

Clear["Global`*"];
SeedRandom[1];
split[center_, r_] := 
 Module[{radius, interior, exterior}, 
  radius = r*(Rest[Subdivide[0, 1, 7]] + RandomReal[{0, .05}, 7]);
  exterior = 
   Fold[CSGRegion["Difference", {#2, #1}] &, 
    Disk[center, #] & /@ radius];
  interior = 
   Fold[CSGRegion["Difference", {#2, #1}] &, 
    Disk[center, #] & /@ Most[radius]];
  {interior, exterior}]
coverby[reg1_, regs_List] := 
 CSGRegion[
  "Difference", {CSGRegion["Union", {reg1, regs[[2]]}], regs[[1]]}]
n = 20;
diskss = 
  split[#, RandomReal[{2, 3}]] & /@ 
   RandomPoint[Rectangle[{-5, -5}, {5, 5}], n];
csgreg = Fold[coverby[#1, #2] &, diskss[[1, 1]], Rest@diskss];
reg = DiscretizeRegion[csgreg];
Manipulate[
 Graphics[{RGBColor[0.32, 0.17, 0.2], 
   Fold[RegionSymmetricDifference, 
    Join[{BoundaryDiscretizeGraphics[Disk[p, 1]], 
      BoundaryDiscretizeGraphics[Disk[q, 2]]}, {reg}]]}, 
  PlotRange -> 5, ImageSize -> Medium], 
 Row[{Control[{{p, {2, 2}}, {-3, -3}, {3, 3}}], 
   Control[{{q, {0, 0}}, {-5, -5}, {5, 5}}]}], 
 ControlPlacement -> Top]

$\begingroup$ Thank you, cvgmt, another amazing answer :) $\endgroup$

eldo
– eldo

2024-05-08 07:53:10 +00:00
Commented May 8, 2024 at 7:53 — eldo
– eldo, Commented May 8, 2024 at 7:53

azerbajdzan · Accepted Answer · 2024-06-18 16:28:17Z

All can be done by a single ImageApply applied to a two-colored image.

c = {ColorData[97, 1], ColorData[97, 2]};
g[fi_] := 
  Graphics[{Table[{c[[Mod[n + m, 2, 1]]], 
      Disk[2 {m, k}, 1, 
       2 (Mod[m + k, 2] - 1/2) fi + {n 2 Pi/10, (n + 1) 2 Pi/
           10}]}, {n, 10}, {m, 3}, {k, 3}]}, Background -> c[[1]], 
   ImageSize -> Medium, PlotRange -> {{1, 7}, {1, 7}}];
m = Graphics[{White, Disk[{3, 3}, Sqrt[2]], Disk[{5, 5}, Sqrt[2]], 
    Disk[{17/3, 7/3}, 4/3], Disk[{7/3, 17/3}, 4/3]}, 
   Background -> Black, ImageSize -> Medium, 
   PlotRange -> {{1, 7}, {1, 7}}];
fu = Plus @@ (List @@@ c);

Table[ImageApply[fu - # &, g[fi], Masking -> m], {fi, 
   0, (2 Pi)/5 - (2 Pi)/(5*30), (2 Pi)/(5*30)}];
Export["rot.gif", %]

Clear[c, g, m, fu]

So for OP's image we have:

dc = DominantColors[Import["https://i.sstatic.net/trR3eg2y.jpg"]];

cr1 = {{{50, 152}, {73, 57, 43, 29, 12}}, {{124, 73}, {63, 52, 31, 
     21}}, {{224, 37}, {83, 75, 63, 46, 35, 15}}, {{363, 45}, {67, 53,
      35, 26, 17, 8}}, {{322, 179}, {98, 85, 66, 57, 44, 29, 
     14}}, {{393, 257}, {74, 63, 54, 38, 18}}, {{264, 336}, {79, 63, 
     54, 40, 21}}, {{159, 347}, {82, 69, 58, 41, 31, 12}}, {{190, 
     195}, {82, 71, 54, 47, 32, 11}}, {{58, 268}, {67, 56, 47, 37, 23,
      16}}, {{380, 373}, {54, 43, 30, 13}}, {{49, 44}, {56, 43, 28, 
     18, 9}}, {{43, 353}, {49, 49, 41, 34, 21, 9}}};

gr1 = Graphics[(d |-> (MapIndexed[{dc[[Mod[#2[[1]], 2, 1]]], 
          EdgeForm[dc[[Mod[#2[[1]] + 1, 2, 1]]]], Disk[d[[1]], #]} &, 
        d[[2]]])) /@ cr1, PlotRange -> {{0, 397}, {0, 392}}, 
   Background -> dc[[2]], ImageSize -> Medium];

cr2 = {{70, 136, 5}, {77, 280, 97}, {59, 127, 140}, {64, 6, 196}, {71,
     304, 251}, {71, 126, 287}, {68, 234, 393}};

gr2 = Graphics[{White, Disk[#[[2 ;; 3]], #[[1]]] & /@ cr2}, 
   PlotRange -> {{0, 397}, {0, 392}}, Background -> Black, 
   ImageSize -> Medium];

fu = Plus @@ (List @@@ dc);
ImageApply[fu - # &, gr1, Masking -> gr2]

Clear[dc, cr1, gr1, cr2, gr2, fu]

Stack Exchange Network

Can we reproduce Antonio Asis circle interferences?

Antonio Asis

Cercles series

Interférences series

Question

4 Answers 4

Linked

Hot Network Questions

Can we reproduce Antonio Asis circle interferences?

Antonio Asis

Cercles series

Interférences series

Question

4 Answers 4

Linked

Related

Hot Network Questions