18
$\begingroup$

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.

enter image description here

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

enter image description here

My Mathematica reproduction of Antonio Asis' "Cercles 1995"

Interférences series

enter image description here

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?

$\endgroup$
3
  • 3
    $\begingroup$ (–1) Since you show no attempt by yourself. $\endgroup$
    – Domen
    Commented May 5 at 17:18
  • 11
    $\begingroup$ @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. $\endgroup$ Commented May 5 at 22:18
  • 5
    $\begingroup$ +1 for another very enjoyable and provoking post :-) $\endgroup$
    – Hans Olo
    Commented May 6 at 20:31

4 Answers 4

15
$\begingroup$

My procedure consists of the following steps:

  1. Define a function that produces the basic element - a circle with six alternating colour areas
  2. 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
  3. Define a mask, which is constructed in the same way (as random Disk on a grid)
  4. Define the mask border (Circles, later will be Darker[Darker[Red]])
  5. Invert the colours (1 - # &) of the image using ImageApply according to the mask
  6. 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]

enter image description here

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]

enter image description here

$\endgroup$
7
  • $\begingroup$ I do not get such images as presented here. My have rough boundary at each disk. Is it because of my version 13.0.? $\endgroup$
    – three777
    Commented May 6 at 21:35
  • $\begingroup$ @three777 I have tested MA 13.1 and 14.0. Works fine. $\endgroup$
    – yarchik
    Commented May 7 at 5:37
  • 1
    $\begingroup$ Thank you very much, yarchik $\endgroup$
    – eldo
    Commented May 8 at 7:50
  • 1
    $\begingroup$ @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/… $\endgroup$
    – yarchik
    Commented May 8 at 8:56
  • 1
    $\begingroup$ An astonishing correspondence $\endgroup$
    – eldo
    Commented May 8 at 9:06
13
$\begingroup$

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] &

enter image description here

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] &

enter image description here

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

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]

enter image description here

  • 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]

enter image description here

  • 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]

enter image description here

  • 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]

enter image description here

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]
$\endgroup$
1
  • $\begingroup$ Thank you, cvgmt, another amazing answer :) $\endgroup$
    – eldo
    Commented May 8 at 7:53
3
$\begingroup$

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]

enter image description here

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]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.