Bäume * Des arbres

Entwicklung * Développement

Remove["Global`*"]

Show[Graphics[Line[{{0, 0}, {1, 1}}]], 
        AspectRatio -> Automatic];

Show[
        Graphics[
          Table[
Line[{{Random[], Random[]}, {Random[], 
                  Random[]}}], 
{20}
]
], AspectRatio -> Automatic];

Show[
        Graphics[
          Line[
Table[{Random[], 
                Random[]}, 
{20}]
]
], AspectRatio -> Automatic];

<< Geometry`Rotations`;
rotation = 0.3;
shrink = 0.8;
?Rotate2D

Rotate2D[{1, 0}, 45 Degree,  {0, 0}]

gabel[
          Line[{start_, 
              end_}]] := 
{
Line[{
end, 
              end + shrink * 
                  Rotate2D[(end - start), 
                    rotation,  {0, 
                      0}]
}], 
Line[{
end, 
              end + shrink * 
                  Rotate2D[(end - start), -rotation,  {0, 
                      0}]
}]
};
gabel[Line[{{0, 0}, {1, 1}}]]

Show[
        Graphics[{
Line[{{0, 0}, {1, 
                  1}}], 
gabel[
              Line[{{0, 0}, {1, 1}}]]
}], 
        AspectRatio -> Automatic];

Show[
        Graphics[{
li1 = 
              Line[{{0, 0}, {1, 1}}], 
gabel[
              li1]
}], 
        AspectRatio -> Automatic];

zweiGabel[lines_] := 
        Map[gabel, lines] //  Flatten;
zweiGabel[{Line[{{0, 0}, {1, 1}}], 
        Line[{{0, 0}, {-1, 1}}]}]

zweiGabel[{Line[{{0, 0}, {1, 1}}]}]

Nest[zweiGabel, {Line[{{0, 0}, {1, 1}}]}, 1]

Nest[zweiGabel, {Line[{{0, 0}, {1, 1}}]}, 2]

ne[k_] := Nest[zweiGabel, {Line[{{0, 0}, {0, 1}}]}, k];

Show[Graphics[
ne[0]
], 
        AspectRatio -> Automatic];

Show[Graphics[
ne[1]
], 
        AspectRatio -> Automatic];

Show[Graphics[
ne[2]
], 
        AspectRatio -> Automatic];

neList[k_] := 
        NestList[zweiGabel, {Line[{{0, 0}, {0, 1}}]}, k];

Show[Graphics[
neList[3]
], 
        AspectRatio -> Automatic];

<< Geometry`Rotations`;
baum[p1_, p2_, tiefe_, rotationInDeg_,  shrinkIn_, 
          options___] := 
Module[{rotation, shrink, gabel, 
            start, end, zweiGabel, lines, neList, 
            k}, 
rotation = 
            rotationInDeg; 
shrink = 
            shrinkIn; 
gabel[
              Line[{start_, 
                  end_}]] := 
{Line[{
end, 
                  end + shrink * 
                      Rotate2D[(end - start), 
                        rotation Degree,  {0, 
                          0}]}], 
Line[{end, 
                  end + shrink * 
                      Rotate2D[(end - 
                            start), -rotation Degree,  {0, 
                          0}]}]
}; 
zweiGabel[lines_] := 
            Map[gabel, lines] //  Flatten; 
neList[k_] := 
            NestList[zweiGabel, {Line[{p1, p2}]}, k]; 
Show[
            Graphics[
neList[tiefe]
], 
            AspectRatio -> Automatic, PlotRange -> All, 
            options];];

baum[{0, 0}, {0, 1}, 5, 30, 0.8];

baum[{0, 0}, {0, 1}, 7, 20, 0.8];

baum[{0, 0}, {0, 1}, 8, 30, 1];

baum[{0, 0}, {0, 1}, 12, 30, 1];

Table[baum[{0, 0}, {0, 1}, k, 30, 1], {k, 3, 16}]

Verbesserung * Amélioration

<< Geometry`Rotations`;
baumVar[p1_, p2_, tiefe_, rotationInDeg_,  shrinkIn_, 
          thickShrinkIn_, firstThickIn_, 
          options___] := 
Module[{rotation, shrink, gabel, 
            start, end, zweiGabel, lines, neList, 
            k}, 
rotation = 
            rotationInDeg; 
shrink = 
            shrinkIn; 

thickShrink = 
            thickShrinkIn; 
firstThick = 
            firstThickIn; 

gabel[
              Line[{start_, 
                  end_}]] := 
{Line[{
end, 
                  end + shrink * 
                      Rotate2D[(end - start), 
                        rotation Degree,  {0, 
                          0}]}], 
Line[{end, 
                  end + shrink * 
                      Rotate2D[(end - 
                            start), -rotation Degree,  {0, 
                          0}]}]
}; 

gabel[Thickness[thick_]] := 
            Thickness[
              thick * 
                thickShrink] ; 

zweiGabel[lines_] := 
            Map[gabel, lines] //  Flatten; 
neList[k_] := 
            NestList[
              zweiGabel, 

{Thickness[
                  firstThick], Line[{p1, p2}]}, 
              k]; 

Show[
            Graphics[
neList[
                tiefe]

], 
            AspectRatio -> Automatic, PlotRange -> All, 
            options];];

baumVar[{0, 0}, {0, 1}, 7, 
        20, 0.8, 0.7, 0.5];

baumVar[{0, 0}, {0, 1}, 7, 20, 0.8, 0.7, 
        0.05];

baumVar[{0, 0}, {0, 1}, 7, 30, 1, 0.7, 
        0.05];

Do[baumVar[{0, 0}, {0, 1}, 7, r 360/(2  Pi), 0.5 + r, 0.7, 
        0.05 + 0.07  r, PlotRange -> {{-6, 6}, {0, 8}}], {r, 0, 0.5, 
        0.02}]

Weitere Verbesserung * Encore une amélioration

Remove["Global`*"]

Off[ ];
Off[General::spell];
Off[General::spell1];

<< Geometry`Rotations`;

Options[
          newTreeWork] = {
Generations -> 
            10, 
BranchRotation -> 
            0.65, 
BranchShortening -> 
            0.75, 
BranchThinning -> 
            0.7, 
OriginalThickness -> 
            0.07, 
BranchColors -> {RGBColor[0, 0, 
                0]}
};

{generations, branchRotation, branchShortening, branchThinning, 
          originalThickness, 
          branchColors} = 
{Generations, BranchRotation, 
            BranchShortening, BranchThinning, OriginalThickness, 
            BranchColors} /. Options[newTreeWork];

rotateLine[Line[{start_, end_}], 
          angle_] := 
Line[{
end, 
end + 
              branchShortening*
                Rotate2D[end - start, 
                  angle Random[
                      Real, {0.5, 
                        1.5}]]
}];

twinLine[
          Line[points_]] := 
{rotateLine[Line[points], 
            branchRotation], 
          rotateLine[
            Line[points], -branchRotation]
};

twinLine[Thickness[th_]] := 
Thickness[
          th branchThinning];

twinLine[
          RGBColor[r_, g_, b_]] := 
{branchColors = 
            RotateLeft[branchColors]; 
First[
            branchColors]
};

doTwins[lines_] := 
        Flatten[Map[twinLine, lines]];
doTwins[{{0, 0}, {1, 1}}]

?FilterOptions

FilterOptions[ command_Symbol, 
          opts___] := 
Block[{keywords = 
              First  /@  Options[command]}, 
          Sequence  @@  
            Select[{opts}, 
              MemberQ[keywords,  
                  First[#]] &]
];

?FilterOptions

newTreeWork[options___] := 
        Module[
{generations, branchRotation, 
            branchShortening, branchThinning, originalThickness, 
            branchColors}, 

{generations, branchRotation, 
              branchShortening, branchThinning, originalThickness, 
              branchColors} = 
{Generations, 
                  BranchRotation, BranchShortening, BranchThinning, 
                  OriginalThickness, BranchColors} /. {options} /. 
              Options[newTreeWork]; 

Show[
            Graphics[
              NestList[
doTwins, 
{First[
                    branchColors], Thickness[originalThickness], 
                  Line[{{0, 0}, {0, 
                        1}}]}, 
generations]], 

FilterOptions[Show, options]  , 
            AspectRatio -> Automatic, 
            PlotRange -> All]
];

newTreeWork[];

newTreeWork[BranchRotation -> 0.2];

Weitere Verbesserung 2 * Encore une amélioration

Remove["Global`*"];
<< Geometry`Rotations`;
Off[ ];
Off[General::spell];
Off[General::spell1]; 
    newTreeWork[options___] := 
      Module[
{generations, branchRotation, 
          branchShortening, branchThinning, originalThickness, branchColors, 
          rotateLine, twinLine, doTwins, 
          FilterOptions}, 

{generations, 
            branchRotation, branchShortening, branchThinning, 
            originalThickness, 
            branchColors} = 
{Generations, 
                BranchRotation, BranchShortening, BranchThinning, 
                OriginalThickness, BranchColors} /. {options} /. 
            Options[newTreeWork]; 
FilterOptions[ 
            command_Symbol, 
            opts___] := 
Block[{keywords = 
                First  /@  Options[command]}, 
            Sequence  @@  
              Select[{opts}, 
                MemberQ[keywords,  
                    First[#]] &]
]; 
rotateLine[Line[{start_, end_}], 
            angle_] := 
Line[{
end, 
end + 
                branchShortening*
                  Rotate2D[end - start, 
                    angle Random[
                        Real, {0.5, 
                          1.5}]]
}]; 
twinLine[
            Line[points_]] := 
{rotateLine[Line[points], 
              branchRotation], 
            rotateLine[
              Line[points], -branchRotation]
}; 
twinLine[Thickness[th_]] := 
Thickness[
            th branchThinning]; 
twinLine[
            RGBColor[r_, g_, b_]] := 
{branchColors = 
              RotateLeft[branchColors]; 
First[
              branchColors]
}; 
doTwins[
            lines_] := 
          Flatten[Map[twinLine, 
              lines]]; 

Show[
          Graphics[
            NestList[
doTwins, 
{First[
                  branchColors], Thickness[originalThickness], 
                Line[{{0, 0}, {0, 
                      1}}]}, 
generations]], 

FilterOptions[Show, options]  , 
          AspectRatio -> Automatic, 
          PlotRange -> All]
];

Options[
        newTreeWork] = {
Generations -> 
          10, 
BranchRotation -> 
          0.65, 
BranchShortening -> 
          0.75, 
BranchThinning -> 
          0.7, 
OriginalThickness -> 
          0.07, 
BranchColors -> {RGBColor[0.8, 0.7, 
              0.6]}
}; newTreeWork[];

newTreeWork[BranchRotation -> 0.2];

newTreeWork[BranchRotation -> 0.6];

newTreeWork[
        Generations -> 12, 
BranchRotation -> 
          0.8, 
BranchShortening -> 
          6, 
BranchThinning -> 
          0.6, 
OriginalThickness -> 
          0.07, 
BranchColors -> {RGBColor[0.7, 0, 0], 
            RGBColor[0, 0.5, 0], RGBColor[0, 0, 0.3]}];

newTreeWork[
        Generations -> 12, 
BranchRotation -> 
          0.8, 
BranchShortening -> 
          0.6, 
BranchThinning -> 
          0.6, 
OriginalThickness -> 
          0.07, 
BranchColors -> {RGBColor[0.7, 0, 0], 
            RGBColor[0, 0.5, 0], RGBColor[0, 0, 0.3]}];

li = 
      Table[RGBColor[Random[], Random[], Random[]], {n, 3*12}]

newTreeWork[
        Generations -> 12, 
BranchRotation -> 
          0.4, 
BranchShortening -> 
          0.8, 
BranchThinning -> 
          0.7, 
OriginalThickness -> 
          0.07, 
BranchColors -> li];

Animate!

Table[
        newTreeWork[
          Generations -> 12, 
BranchRotation -> 
            0.4, 
BranchShortening -> 
            0.8, 
BranchThinning -> 
            0.7, 
OriginalThickness -> 
            0.07, 
BranchColors -> 
            Table[RGBColor[Random[], Random[], Random[]], {n, 3*12}]], {n, 1, 
          20}];