14

Josef Albers (1888 - 1976) was a German-born American artist. In 1920, Albers joined the Weimar Bauhaus as a student and became a faculty member in 1922, teaching the principles of handicrafts.

enter image description here

Josef Albers, Aufwärts (Upwards), ca. 1926

With the Bauhaus's move to Dessau in 1925, he was promoted to professor and married Anni Albers, a student at the institution who was to become famous as a textile artist:

How to weave Anni Albers Red Meander carpet?

Following the Bauhaus's closure under Nazi pressure in 1933, Josef and Anni Albers emigrated to the United States. He was appointed as the head of the painting program at Black Mountain College in North Carolina, a position he held until 1949.

enter image description here

Josef Albers (left) with Buckminster Fuller (Mid) and students at Black Mountain College, summer 1948: Construction of a geodesic dome.

In 1950, Albers left Black Mountain to head the department of design at Yale University. He is considered to be one of the most influential teachers of visual art in the twentieth century.

Between 1925 and 1929 Albers produced a series of abstract paintings, which I would like to replicate with Mathematica. Here is another one of them:

enter image description here

Josef Albers, Fabrik (Factory), 1925

More pieces of the series can be seen at the Josef & Anni Albers Foundation

My request

Can we produce rectangular patterns like these with a certain amount of randomness?

eldo
  • 67,911
  • 5
  • 60
  • 168

4 Answers4

10
  • We use KroneckerProduct to create some {0,1}-matrixs.
  • {m1,m2,...,m6,m7} are several types of such {0,1}-matrixs.
  • We set random grid points in the rectangle and choose some type of such matrixs and use Plus to mixing the types.
k = 8;
m1 = KroneckerProduct[PadRight[{0, 1}, k, "Periodic"], 
   PadRight[{0, 1}, k, "Periodic"]];
m2 = KroneckerProduct[PadRight[{0, 1}, k, "Periodic"], 
   PadRight[{1, 0}, k, "Periodic"]];
m3 = KroneckerProduct[PadRight[{1, 0}, k, "Periodic"], 
   PadRight[{0, 1}, k, "Periodic"]];
m4 = KroneckerProduct[PadRight[{1, 0}, k, "Periodic"], 
   PadRight[{1, 0}, k, "Periodic"]];
m5 = KroneckerProduct[PadRight[{1, 1}, k, "Periodic"], 
   PadRight[{1, 0}, k, "Periodic"]];
m6 = KroneckerProduct[PadRight[{1, 0}, k, "Periodic"], 
   PadRight[{1, 1}, k, "Periodic"]];
m7 = KroneckerProduct[PadRight[{1, 1}, k, "Periodic"], 
   PadRight[{1, 1}, k, "Periodic"]];
ArrayPlot/@{m1,m2,m3,m4,m5,m6,m7}

enter image description here

SeedRandom[1];
n = 25;
ArrayPlot[
 SparseArray[
  MapThread[
   Rule[Band[#1], #2] &, {RandomInteger[{1, n}, {n, 2}], 
    Table[RandomChoice[{m1, m2, m3, m4, m5, m6, m7}] + 
      RandomChoice[{m1, m2, m3, m4, m5, m6}], n]}]], 
 ColorRules -> {0 -> Red, 1 -> Black, 2 -> White}]

enter image description here

  • For the first picture, we can maily use type m6 and m7 by setting {0, 0, 0, 0, 0, 1, 1}->{m1, m2, m3, m4, m5, m6, m7}.
Clear[m, n];
SeedRandom[1];
m = 5  k;
n = 3  k; 
c = .9; 
pts = 
 RandomSample[Tuples[{Range[m], Range[n]}], Floor[m*n*c]]; ArrayPlot[
 SparseArray[
  MapThread[
   Rule[Band[#1], #2] &, {pts, 
    Table[RandomChoice[{0, 0, 0, 0, 0, 1, 1} -> {m1, m2, m3, m4, m5, 
         m6, m7}] + 
      RandomChoice[{0, 0, 0, 0, 0, 1, 1} -> {m1, m2, m3, m4, m5, m6, 
         m7}], Length@pts]}]], 
 ColorRules -> {0 -> White, 1 -> Black, 2 -> Lighter@Blue}, 
 PlotRangePadding -> 0]

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133
8

Clearly, there is room for automation here.

Clear["Global`*"];

rules = {1 -> Black, 2 -> Lighter@Blue, 3 -> White, 4 -> White, 
   5 -> Lighter@Blue, 6 -> Black};
parts = IntegerPartitions[30, {1, 6}] // Select[4 < Length@# < 8 &];
runs = RandomSample[parts, 40] // 
   Map[RotateLeft[#, RandomInteger[{1, 3}]] &];
cols = RandomInteger[{1, 6}, Length@#] & /@ runs;
cbars = (MapThread[Thread[{#1, #2}] &, {runs, cols}] /. {a_, b_} :> 
     Sequence @@ ConstantArray[Lookup[rules, b], a]);

To check where the errors (if any) can come from:

Dimensions /@ {rules, parts, runs, cols, cbars}

ArrayPlot[{
     cbars[[1]], cbars[[2]]
     , cbars[[1]], cbars[[2]]
     , cbars[[1]], cbars[[2]]


 , cbars[[9]], cbars[[6]]
 , cbars[[9]], cbars[[6]]
 , cbars[[9]], cbars[[6]]
 , cbars[[9]], cbars[[6]]

 , cbars[[21]], cbars[[15]]
 , cbars[[21]], cbars[[15]]
 , cbars[[21]], cbars[[15]]
 , cbars[[21]], cbars[[15]]

 , cbars[[10]], cbars[[13]]
 , cbars[[10]], cbars[[13]]
 , cbars[[10]], cbars[[13]]
 , cbars[[10]], cbars[[13]]

 , cbars[[22]], cbars[[25]]
 , cbars[[22]], cbars[[25]]
 , cbars[[22]], cbars[[25]]
 , cbars[[2]], cbars[[25]]
 , cbars[[2]], cbars[[25]]
 } // 
SubsetMap[
  RotateLeft[#, RandomInteger[{3, 6}]] &amp;, #, {All, 
   RandomInteger[{8, 12}]}] &amp; //



SubsetMap[
     RotateLeft[#, RandomInteger[{3, 6}]] &, #, {All, 
      RandomInteger[{18, 22}]}] & //
  SubsetMap[
    RotateLeft[#, RandomInteger[{3, 6}]] &, #, {All, 
     RandomInteger[{28, 30}]}] &
 ]

A typical output:

enter image description here

Syed
  • 52,495
  • 4
  • 30
  • 85
7
ClearAll[albersFabrik]

albersFabrik[clrs_ : Automatic, lines_ : Automatic, d_ : Automatic, 
   t_ : 15][opts : OptionsPattern[]] := 
 Module[{c = clrs /. Automatic -> {Black, Red, White}, 
   n = d /. Automatic -> 10}, 
  Graphics[
   Map[{Last[c = RotateRight[c]], 
       CapForm["Square"], AbsoluteThickness[t], Line @ #} &]@
    RandomSample @
     Map[Table[
         RandomChoice[{Map[Reverse], Identity}]@RandomSample[#, 2], 
         lines /. Automatic -> 20] &]@
      Outer[List, Range[0, 3  n, 3], Range[0, 3 n, 3]], opts, 
   ImageSize -> Medium, 
   Background -> First[clrs /. Automatic -> {Black, Red, White}], 
   PlotRangePadding -> 2]]

Examples:

SeedRandom[777];

Row[{albersFabrik[][], albersFabrik[][], albersFabrik[][]}, Spacer[10]]

enter image description here

Row[{albersFabrik[RandomColor[3]][], 
     albersFabrik[RandomColor[3]][], 
     albersFabrik[RandomColor[3]][]}, Spacer[10]]

enter image description here

Row[{albersFabrik[Automatic, 4][], 
     albersFabrik[Automatic, 15][], 
     albersFabrik[Automatic, 25][]}, Spacer[10]]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
5
upwards := Module[
  {colors = {Lighter@Blue, Black, White}, partitions = 8, rows = 40, cols = 30, matrix, part},
  {part["rows"], part["cols"]} = 
     Partition[Join[{1}, Sort@RandomSample[Range[2, # - 1], partitions], {#}], 2, 1] & 
       /@ {rows, cols};
  matrix = Array[If[ Mod[#, 2] == 0, Lighter@Blue, Black] &, {rows, cols}] ;
  Outer[{rows, cols} |->
    matrix[[Span @@ rows, Span @@ cols]] //= 
      ReplaceAll[#,  Rule @@ RandomSample[colors, 2]] &, part["rows"], part["cols"], 1];
  matrix // ArrayPlot]

SeedRandom[1];
Multicolumn[Table[upwards, 6], 3]

enter image description here

vindobona
  • 3,241
  • 1
  • 11
  • 19