Off[General::spell1]

Zu Beginn einlesen:

Unprotect[Random];
\(Random[p_List] := 
        Block[{x, w, m}, 
		x[1] = p[\([1]\)]; 
		
          x[k_] := x[k - 1] + p[\([k]\)]; 
		m = Array[x, Length[p]]; 

          		w = Union[m, {Random[]}]; 
		
          \(Position[w, _Real]\)[\([1, 1]\)] - 1
		]\);
\(graphics[x__] := 
        Block[{xMax, xMin, yMax, yMin}, 
		
          g = Graphics[{x}, PlotRange -> All]; 

          		{{xMin, xMax}, {yMin, yMax}} = FullOptions[g, PlotRange]; 
		
          Graphics[{x}, 
			PlotRange -> All, 
			
            AspectRatio -> \((yMax - yMin)\)/\((xMax - xMin)\)]]\);

Fixmengen

affine abbildungen

Beispiel 1

\(Dreh[φ_]
         := {{\ Cos[φ], \(-\ Sin[φ]\)}, {\ 
              Sin[φ], Cos[φ]}}.#&; 

    Streck[r_] := {{r, 0}, {0, r}}.#&; \)

Dreh[π/2][{1, 1}]

\(quadrat = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}; 
Dreh[π/2]/@quadrat\)

Beispiel 2

Dreh[φ_, r_] := Composition[Dreh[φ], Streck[r]];

Dreh[π/2, 0.5]/@quadrat

Bemerkung

\(\(ShowAbb[w__] := 
      Block[{l, q, urbild, bild}, 
		
        l = {{.1, .9}, {.1, .6}, {.3, .6}, {.3, .7}, {.2, .7}, {.2, .9}, {.1, .9}}; 
		q = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {0, 0}}; 
		
        urbild = Sequence[Dashing[{0.01, 0.01}], Line[l], Line[q]]; 
		
        bild = Sequence[
				Line[Composition[w]/@l], 
            Line[Composition[w]/@q]]; 
		Show[graphics[bild, urbild]]; ]; 
    \)\)

ShowAbb[Dreh[π/4], Streck[.5]]

lösung

Aufgabe 1a)

Spieg[{a_, b_, 0}] := 
      1/(a^2 + b^2)
               {{-a^2 + b^2, -2 a b}, {-2 a b, 
                a^2 - b^2}}.#&;

Beispiel:

ShowAbb[Spieg[{1, 1, 0}]];

Aufgabe 1b),c)

Streck[r_, s_] := {{r, 0}, {0, s}}.#&;

\(Scher[v_, X] := Transpose[{{1, 0}, v}].#&; 

    Scher[v_, Y] := Transpose[{v, {0, 1}}].#&; \)

ShowAbb[Scher[{1, 1}, X]];

Beispiel 3

Dreh[φ_, x_?VectorQ] := 
      (x + Dreh[φ][# - x])&

ShowAbb[Dreh[π/4, {0.5, 0.5}]]

Spieg[x_] := 
      (x + {{-1, 0}, {0, -1}}.(# - x)&) /; Length[x] == 2;

ShowAbb[Spieg[{0.2, 0.2}]]

lösungen 2-3

Aufgabe 2a

Spieg[{a_, b_, c_}] := 
      (-c/(a^2 + b^2) {a, b} + 
            Spieg[{a, b, 0}][# + c/(a^2 + b^2) {a, b}])&;

ShowAbb[Spieg[{1, -1, 1}]]

Aufgaben 2b), c),d):

\(Streck[r_, x_?VectorQ] := \((x + \(Streck[r]\)[# - x])\)&; 

    Dreh[φ_, r_, x_?VectorQ] := 
      \((x + \(Dreh[φ, r]\)[# - x])\)&; 

    Transl[v_] := \((v + #)\)&; \)

Aufgabe 3

\(\(polygonabbilden[w__, x_List] := 	
      graphics[{
			Line[Composition[w]/@x], Dashing[{0.01, 0.01}], 
          Line[x]}]; \)\)

polygonabbilden[
        Dreh[π/2], {{1, 1}, {0.5, 0.5}, {0, 1}, {0, 0}, {1, 0.2}, {1, 1}}]
         // Show;

fixmengen

fixmengen

\(w[0] = Streck[0.5]; 
w[1] = Streck[0.5, {2, 0}]; 

    w[2] = Streck[0.5, {1, Sqrt[3]}]; \)

\(d[0] = {{0, 0}, {2, 0}, {1, Sqrt[3]}}; 

    d[n_] := Union[w[0]/@d[n - 1], w[1]/@d[n - 1], w[2]/@d[n - 1]]; \)

\(\(Show[Graphics[
		Prepend[\(Point[#]&\)/@d[6], PointSize[0.001]]]]; 
    \)\)

weitere fixmengen

\(w[0] = Streck[0.5]; 

    w[1] = Composition[Streck[0.5, {2, 0}], Dreh[π, {0.5, 0.5}]]; 

    w[2] = Composition[Streck[0.5, {1, 1.732}], 
        Dreh[\(-π\)/2, {0.5, 0.5}]]; \)

\(\(Fixmenge[w_List, n_] := 
      Block[{p, sd, h = Length[w]}, 
		p[0] = {0.5, 0.5}; 
		
        p[k_] := 
          \(p[k] = 
            \(w[[Random[Integer, {1, h}]
                  ]]\)[p[k - 1]]\); 
		
        sd = Table[Point[p[k]], {k, 0, n}]; 
		
        PrependTo[sd, PointSize[10\^\(-4\)]]; 
		Show[graphics[sd]]; ]; 
    \)\)

Fixmenge[{w[0], w[1], w[2]}, 3000]

lösungen 4-5

Aufgabe 4

\(Bauplan[w__] := 
      Block[{l, q}, 
		
        l = {{.1, .9}, {.1, .6}, {.3, .6}, {.3, .7}, {.2, .7}, {.2, .9}, {.1, .9}}; 
		q = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {0, 0}}; 
		
        urbild = Sequence[Dashing[{0.01, 0.01}], Line[l], Line[q]]; 
		
        bild = Table[

            				{
				Line[{w}[\([k]\)]/@l], Line[{w}[\([k]\)]/@q]}, 
            
				{k, Length[{w}]}]; 
		
        Show[graphics[Flatten[{bild, urbild}]]]; 
		]\)

\(w[0] = Composition[Streck[0.5], Dreh[π/2, {0.5, 0.5}]]; 

    w[1] = Composition[Streck[0.5, {1, 0}], Dreh[π, {0.5, 0.5}]]; 

    w[2] = Composition[Streck[0.5, {0.5, 1}], 
        Dreh[\(-π\)/2, {0.5, 0.5}]]; \)

Bauplan[w[0], w[1], w[2]]

Aufgabe 5

\(w[0] = Composition[Streck[0.5], Dreh[π/2, {0.5, 0.5}]]; 

    w[1] = Composition[Streck[0.5, {1, 0}], Dreh[π, {0.5, 0.5}]]; 

    w[2] = Composition[Streck[0.5, {0.5, 1}], 
        Dreh[\(-π\)/2, {0.5, 0.5}]]; \)

Fixmenge[{w[0], w[1], w[2]}, 5000]

beispiel: der Cantor-Irrgarten

\(w[0] = Composition[Streck[1/3, 1], Dreh[π/2, {0.5, 0.5}]]; 

    w[1] = Streck[1/3, {0.5, 1}]; 

    w[2] = Composition[Spieg[{1, 0, \(-0.5\)}], Streck[1/3, 1], 
        Dreh[π/2, {0.5, 0.5}]]; 
Bauplan[w[0], w[1], w[2]]\)

Fixmenge[{w[0], w[1], w[2]}, 5000]

\(\(Fixmenge[abb_List, wkeit_List, n_] := 
      Block[{p, sd}, 
		p[0] = {0.5, 0.5}; 
		
        p[k_] := 
          \(p[k] = 
            \(abb[[Random[wkeit] + 1]]\)[
              p[k - 1]]\); 
		sd = Table[Point[p[k]], {k, 0, n}]; 
		
        PrependTo[sd, PointSize[10\^\(-4\)]]; 
		Show[graphics[sd]]; ]; 
    \)\)

Fixmenge[{w[0], w[1], w[2]}, {3/7, 1/7, 3/7}, 5000]

lösung 6

Aufgabe 6

\(w[0] = Streck[0.25, {0.125, 0.375}]; 

    w[1] = Streck[0.25, {0.875, 0.375}]; 
w[2] = Streck[0.25, {0.5, 0.875}]; 
    
w[3] = Dreh[ArcTan[5/3.], Sqrt[34.]/8, {0.5, 0.5}]; \)

Fixmenge[{w[0], w[1], w[2], w[3]}, {4/46, 4/46, 4/46, 34/46}, 5000]

beispiel: der Barnsleyfarn

\(w[0] = 
      \(({0.075, 0.1830} + {{0.849, 0.037}, {\(-0.037\), 0.849}}.#)\)&; 

    w[1] = \(({0.400, 0.0490} + {{0.197, \(-0.226\)}, {0.226, 0.197}}.#)\)&; 
    
w[2] = \(({0.575, \(-0.0840\)} + {{\(-0.15\), 0.283}, {0.260, 0.237}}.#)
          \)&; 
w[3] = \(({0.500, 0} + {{0, 0}, {0, 0.16}}.#)\)&; \)

Fixmenge[{w[0], w[1], w[2], w[3]}, {1/2, 4/16, 3/16}, 12000]