7
$\begingroup$

Frieder Nake

Frieder Nake (born 1938 in Stuttgart, Germany) is a mathematician, computer scientist, and pioneer of computer art. Nake is one of the "3N" computer pioneers, an abbreviation that has become acknowledged for Frieder Nake, Georg Nees and A. Michael Noll, whose graphics were created with digital computers.

enter image description here

Frieder Nake, "40 Artists Against the War in Vietnam", Stuttgart 1966

Nake produced his first works in 1963 being largely influenced by Max Bense's Information Aesthetics. Until 1969, he went through a succession of increasingly complex programs. Nake declared not to continue producing computer art in 1971 for political reasons. He published the note There should be no computer art in the "Bulletin of the Computer Arts Society".

enter image description here

Frieder Nake, Recheckschraffuren, (Rectangle Hatchings), 1965

He resumed publishing on computer art in the mid-1980s. Frieder Nake has been a full professor of computer science at the University of Bremen, Germany, since 1972. Since 2005, he has also been teaching at the University of the Arts, Bremen. Nake's work is collected by major institutions around the world including Tate Gallery and Victoria and Albert Museum, London.

Walk Through Raster

In 1966 Nake developed the program "walk-through-raster" in ALGOL60 (with some assembler-sub-programs). A punch tape contained the instructions for a Telefunken TR4 computer.The results were printed by a Zuse Z64 Graphomat.

enter image description here

Frieder Nake, "Walk Through Raster", four parts, 50 × 50 cm, ink on paper, 1966 (Nake: Ästhetik als Informationsverarbeitung, Springer 1974, p. 236, ill. 5.5-5)

The program selected signs from a repertoire depending on "the last chosen sign". As explained by Nake, the program simulated a "short memory". The sign repertoire is constituted by vertical and horizontal lines as well as by a blank field.

Reproduction attempt

v = Line[{{x, y}, {x, y + 1}}];

h = Line[{{x, y}, {x + 1, y}}];

n = 50;

lines = Flatten @ Table[RandomChoice[{v, v, v, v, h}], {x, n}, {y, n}];

erase = DiscretizeGraphics @ BezierCurve[RandomReal[{10, 40}, {100, 2}]];

Graphics[{Thickness[0.004], Select[lines, RegionDisjoint[erase, #] &]}]

enter image description here

Question

I know from a previous question how to erase random patterns inside an image. But how can I thin it out at its edges? In particular I would like to reproduce the first (top left) of Nake's four grids.

$\endgroup$

1 Answer 1

3
$\begingroup$

Update: Progressive thinning of the target region:

v = Line[{{x, y}, {x, y + 1}}];
h = Line[{{x, y}, {x + 1, y}}];
n = 50;
lines = Flatten@Table[RandomChoice[{v, v, v, v, h}], {x, n}, {y, n}];

lower = Table[Transpose@
    Reverse@LowerTriangularize[Array[1 &, {n, n}], -10 - d], {d, 0, 20, 5}];
lowerPoints = MapIndexed[RandomChoice[Position[1]@#, 75 - #2[[1]]*5] &, lower];

upper = Table[Transpose@
    Reverse@UpperTriangularize[Array[1 &, {n, n}], 10 + d], {d, 0, 20, 5}];
upperPoints = MapIndexed[RandomChoice[Position[1]@#, 75 - #2[[1]]*5] &, upper];

erase = DiscretizeGraphics@
   Line[List @@@ 
     EdgeList@
      NearestNeighborGraph[
       Flatten[Join[lowerPoints, upperPoints ], 1]]];

NearestNeighborGraph[Flatten[Join[lowerPoints, upperPoints ], 1]]

enter image description here

Graphics[{Thickness[0.004], Select[lines, RegionDisjoint[erase, #] &]}]

enter image description here

Original: An attempt, starting from the current proposal:

v = Line[{{x, y}, {x, y + 1}}];    
h = Line[{{x, y}, {x + 1, y}}];    
n = 50;
lines = Flatten@Table[RandomChoice[{v, v, v, v, h}], {x, n}, {y, n}];

(* Area of interest (lower left and upper right) *)
lower = Transpose@Reverse@LowerTriangularize[Array[1 &, {n, n}], -10];
upper = Transpose@Reverse@UpperTriangularize[Array[1 &, {n, n}], 10];

(* Random points for the target area *)
{lowerPoints, upperPoints} = RandomChoice[Position[1]@#, 200] & /@ {lower, upper};

(* Intersecting region *)
erase = 
  DiscretizeGraphics@
   Line[List @@@ 
    EdgeList@NearestNeighborGraph[Join[upperPoints, lowerPoints]]] ;

Graphics[{Thickness[0.004], Select[lines, RegionDisjoint[erase, #] &]}]

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.