21
$\begingroup$

Paul Klee

Paul Klee (1879 - 1940) was a Swiss-born German artist. His highly individual style was influenced by expressionism, cubism, and surrealism. Klee was a natural draftsman who deeply explored color-, form- and design theory. His Notebooks are held to be as important for modern art as Leonardo da Vinci's "A Treatise on Painting" was for the Renaissance.

enter image description here

Klee (left) and Kandinsky in front of their two-family villa (designed by Walter Gropius), Dessau, ca. 1927

In 1920, Walter Gropius appointed Klee to the Bauhaus in Weimar (later Dessau). Klee taught classes in elemental design theory as part of the preliminary course. The first Klee exhibition was organised in New York in 1924. In 1927, he became head of the free painting workshop. In 1931, having received a professorship at the Düsseldorf art academy, he left the Bauhaus. After the Nazis seized power in 1933 and classified Klee's work as "degenerate art", he was dismissed and emigrated to Switzerland the same year.

enter image description here

Paul Klee, Die Zwitscher-Maschine (Twittering Machine), 1922, MoMA New York

The Notebooks

In 2016, the Zentrum Paul Klee in Bern, Switzerland, made available online almost all 3,900 pages of Klee's Notebooks, which he used as the source for his Bauhaus teaching between 1921 and 1931. They contain extensively detailed studies on the mechanics of art, form and color. Although only published in German, the variety of graphics will appeal to all viewers.

Free line walks

On page BF/11 Klee sketched some winding patterns, which he called "free line in a detour":

enter image description here

Paul Klee, Notebooks, page BF/11

"In all of these examples the main line promenades free and unrestricted. It's a walk for its own sake, so to speak.", he remarked at the bottom of the page. As a "Meister" of the weaving class, Klee became a major supporter of Otti Berger, whose winding carpet patterns were certainly influenced by his "free promenades".

It is not too difficult to mimic unrestricted walks with Mathematica:

loops[f_, a_, r_][t_] :=
 Module[{x, y, p, s, sol},
  sol = {x'[s] == Sin[p @ s], y'[s] == Cos[1 p @ s], p'[s] == f[s], 
    x[0] == 0, y[0] == 0, p[0] == a};
  sol = NDSolve[sol, {x, y, p}, {s, -r, r}];
  {x[t], y[t]} /. sol[[1]]]

r = 55;
ParametricPlot[Evaluate[loops[Sin[0.2 #] &, 2.5, r][t]], {t, -r, r},
 AspectRatio -> 0.5,
 Axes -> False,
 Background -> RGBColor[0.7, 0.6, 0.3, 0.5],
 PlotPoints -> 100,
 PlotRangePadding -> None,
 PlotStyle -> Directive[GrayLevel[0.5], Opacity[0.5], Thickness[0.005]]]

enter image description here

Restricted line walks

The problem starts when we want to restrict the walk - demanding that a curve winds around certain grid points:

enter image description here

Paul Klee, Notebooks, page BF/116

Klee's nine grid points, the y-values being a RandomSample of Range[9]:

p = {{1, 5}, {2, 9}, {3, 1}, {4, 2}, {5, 6}, {6, 8}, {7, 7}, {8, 3}, {9, 4}};

My reproduction attempt misses the crucial features of Klee's swirling curve:

Show[

 Graphics[{
   PointSize[0.02], Point @ p,
   Table[Text[i, p[[i]] + {0.3, 0.3}], {i, 9}],
   Lighter @ Red, Opacity[0.5], Thickness[0.01], BSplineCurve[p, SplineDegree -> 2],
   Table[Circle[p[[i]], {0.3, 0.3}], {i, 9}]}],
 
 AspectRatio -> 0.75,
 Background -> RGBColor[0.7, 0.6, 0.3, 0.5],
 Frame -> True,
 FrameTicks -> {{Range @ 9, None}, {None, None}},
 GridLines -> {Range @ 9, Range @ 9},
 PlotRangePadding -> 0.5]

enter image description here

The curve doesn't even pass through the grid points, let alone loop around them.

One page later, Klee places a winding curve on a polar grid:

enter image description here

Paul Klee, Notebooks, page BF/117

My question

How can we reproduce either one of Klee's sketches? Or in a more general sense: How can we force a curve to loop around grid points? If looping is too difficult, I would also accept an answer, which (a) lets the curve almost touch the black points and (b) places roundish forms near them (like at point 6 of my above trial plot). The latter wouldn't be very elegant, but at least it would create the illusion of looping.

$\endgroup$

4 Answers 4

23
$\begingroup$
cp[x_] := 
 Module[{v}, 
  v = Append[#, First@#] &@
    CirclePoints[
     x[[2]], {0.2, 
      PlanarAngle[{x[[2]] + {1, 0}, x[[2]], Plus @@ AngleBisector[x]},
        "Counterclockwise"]}, 4];
  If[PlanarAngle[x, "Counterclockwise"] > Pi, v[[{1, 4, 3, 2, 1}]],
    v]
  ]

p = Transpose[{Range[15], RandomSample@Range[15]}/3];
pap = cp /@ Partition[p, 3, 1];
Graphics[{Red, Opacity[0.5], Thickness[0.01], 
  BSplineCurve[Join[{p[[1]]}, Flatten[pap, 1], {p[[-1]]}]], Black, 
  PointSize[0.02], Point@p}]

enter image description here

enter image description here

Works for any random points not only that are sorted left to right by x coordinate.

Images with p = CirclePoints[10] and p = RandomSample@CirclePoints[10].

enter image description here

enter image description here

"Masculine" in IntegerName does not seem to work well.

cp[x_, r_] := 
 Module[{v}, 
  v = Append[#, First@#] &@
    CirclePoints[
     x[[2]], {r, 
      PlanarAngle[{x[[2]] + {1, 0}, x[[2]], Plus @@ AngleBisector[x]},
        "Counterclockwise"]}, 4];
  If[PlanarAngle[x, "Counterclockwise"] > Pi, v[[{1, 4, 3, 2, 1}]], v]]

p = {{1, 5}, {2, 9}, {3, 1}, {4, 2}, {5, 6}, {6, 8}, {7, 7}, {8, 
     3}, {9, 4}} + 1/2;

pap = cp[#, 0.4] & /@ Partition[p, 3, 1];
Show[Graphics[{PointSize[0.02], Point@p, 
   Table[Text[i, p[[i]] + {0.3, 0.3}], {i, 9}], Lighter@Red, 
   Opacity[0.5], 
   Thickness[0.01], {Red, Opacity[0.5], Thickness[0.01], 
    BSplineCurve[Join[{p[[1]]}, Flatten[pap, 1], {p[[-1]]}]], Black, 
    PointSize[0.02], Point@p}}], AspectRatio -> 0.75, 
 Background -> RGBColor[0.7, 0.6, 0.3, 0.5], Frame -> False, 
 FrameTicks -> None, GridLines -> {Range@10, Range@10}, 
 PlotRangePadding -> 0.5, 
 Epilog -> {Inset[
      Style[IntegerName[#[[1]] - 1/2, {"German", "Masculine", 
         "Ordinal"}], FontFamily -> "Freestyle Script", 
       FontSize -> 25], {0, #[[2]]}] & /@ p}, 
 PlotRange -> {{-1, 10}, {1, 10}}]

enter image description here

p = {RotationMatrix[0.9] . {0, 1 + 1/2}, 
   RotationMatrix[-0.25] . {0, 9 + 1/2}, 
   RotationMatrix[-2.9] . {0, 8 + 1/2}, 
   RotationMatrix[2.6] . {0, 5 + 1/2}, 
   RotationMatrix[-0.3] . {0, 3 + 1/2}, 
   RotationMatrix[0.4] . {0, 7 + 1/2}, 
   RotationMatrix[-0.8] . {0, 6 + 1/2}, 
   RotationMatrix[2.0] . {0, 2 + 1/2}, 
   RotationMatrix[-2.0] . {0, 4 + 1/2}};
pap = cp[#, 0.6] & /@ Partition[p, 3, 1];

Show[Graphics[{PointSize[0.02], Point@p, 
   Disk[], {Gray, Circle[{0, 0}, #] & /@ Range[10]}, 
   Table[Text[i, p[[i]] + {0, 0.8}], {i, 9}], Lighter@Red, 
   Opacity[0.5], 
   Thickness[0.01], {Red, Opacity[0.6], Thickness[0.01], 
    BSplineCurve[Join[{p[[1]]}, Flatten[pap, 1], {p[[-1]]}]], Black, 
    PointSize[0.02], Point@p}}], 
 Background -> RGBColor[0.7, 0.6, 0.3, 0.5], Frame -> False, 
 FrameTicks -> None, PlotRangePadding -> 0.5, 
 Epilog -> {Inset[Position[p, #][[1, 1]], {0, -Norm[#]}] & /@ p}, 
 PlotRange -> 10]

enter image description here

And a bonus.

n = 30;
Graphics[{AbsoluteThickness[2], Opacity[0.7], 
  Line[AnglePath[
     Flatten@Table[{0, 1, 1, -1, -1, 0, -1, 0, 1} Pi/2, n]] + 
    Table[{0, Sin[2 x]}, {x, 0, 2  Pi - (2 Pi)/(9*n + 1), (2 Pi)/(
      9*n + 1)}]]}]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thank you, azerbajdzan, your latest additions are wonderful $\endgroup$
    – eldo
    Commented Mar 18 at 11:50
13
$\begingroup$

How about this

p = {{1, 5}, {2, 9}, {3, 1}, {4, 2}, {5, 6}, {6, 8}, {7, 7}, {8, 3}, {9, 4}};
Graphics[{BSplineCurve[
   Join[{p[[1]]},Flatten[CirclePoints[#, 0.3, 7] & /@ p[[2 ;; -2]], 1], {p[[-1]]}]], 
   Green, Line[p], Red, Point[p]}]

The algorithm can be improved by carefully specifying arguments of CirclePoints.

enter image description here

$\endgroup$
0
9
$\begingroup$

Not exactly as required but the result feels related somehow ..

p = {{1, 5}, {2, 9}, {3, 1}, {4, 2}, {5, 6}, {6, 8}, {7, 7}, {8, 3}, {9, 4}};

tf = MapIndexed[{#2[[1]]
   , FindGeometricTransform[#1, {{-.5, -.5}, {.5, .5}}][[2]]} &, Partition[p, 2, 1]];

plot[d_ : 1] := ParametricPlot[
   If[d == 1, Identity, Reverse]@{FresnelS[x], FresnelC[x]}, {x, -5, 5}
   , PlotStyle -> {AbsoluteThickness[1], Lighter@Red}];

Show[
  Graphics[{ 
   MapApply[GeometricTransformation[First@plot[Mod[#1, 2]], #2] &, tf]
   , Blue, PointSize[Medium], Point /@ p}]
  , PlotRange -> All, ImageSize -> Small
 ]

enter image description here

$\endgroup$
5
$\begingroup$

Starting with the answer from @yarchik and adjusting the circle points as follows:

  • First circle point depends on the relative angle to the flanking points
  • Circle points are reversed depending on the relative y-coordinate of the flanking points
p = {{1, 5}, {2, 9}, {3, 1}, {4, 2}, {5, 6}, {6, 8}, {7, 7}, {8, 
    3}, {9, 4}};

cp = Table[
   c = CirclePoints[p[[n]], {.5, Mean[
      {PlanarAngle[p[[n]] -> {p[[n]] + {1, 0}, p[[n - 1]]}], 
       PlanarAngle[p[[n]] -> {p[[n]] + {1, 0}, p[[n + 1]]}]}]}
      , 10];
   c = PadRight[c, 11, c]; 
   If[p[[n, 2]] > p[[n - 1, 2]], 
    If[p[[n + 1, 2]] > p[[n, 2]], Reverse[c], c], 
    If[p[[n + 1, 2]] < p[[n, 2]], c, Reverse[c]], Reverse[c]]
   , {n, 2, Length[p] - 1}];

Graphics[{PointSize[0.02], Point[p], Red, Opacity[0.5], 
  Thickness[0.01], 
  BSplineCurve[Join[{p[[1]]}, Flatten[cp, 1], {p[[-1]]}]]}]

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.