Scalare un albero con NestList (versione 3D)

Visualizzare un albero

Lo scopo di questo esercizio è quello di prendere confidenza con il fatto che è possibile elaborare i grafici tridimensinoali generati da Mathematica esattamente nello stesso modo di quelli bidimensionali, a patto ovviamente di utilizzare delle funzioni adeguate per costruire i vari componenti di un grafico e per visualizzarlo. A tal fine, l'esercitazione estende al caso tridimensionale il disegno di alberi visto nella lezione precedente. In questo caso, però, le varie diramazioni saranno visualizzate nello spazio anziché nel piano.

Definiamo la seguente funzione rotate3D, i cui parametri rappresentano, nell'ordine, una lista contenente le coordinate di un punto da ruotare e due valori numerici che specificano di quanto ruotare il punto nei piani XY e YZ; la funzione restituirà le coordinate del punto dopo che questo è stato ruotato:

rotate3D[vec_, thetaxy_, 
        thetayz_] := {{Cos[thetaxy], -Sin[thetaxy], 0}, {Sin[thetaxy], 
            Cos[thetaxy], 0}, {0, 0, 1}} . {{1, 0, 0}, {0, 
            Cos[thetayz], -Sin[thetayz]}, {0, Sin[thetayz], 
            Cos[thetayz]}} . vec

Fissiamo un valore per i due angoli di rotazione:

rotationxy = Pi/3;
rotationyz = Pi/9;

Consideriamo un generico punto (x, y, z) e visualizziamo le coordinate del corrispondente ruotato:

rotate3D[{x, y, z}, rotationxy, rotationyz]

Visualizziamo le coordinate approssimando le quantità numeriche che appaiono in esse:

rotate3D[{x, y, z}, rotationxy, rotationyz] // N

Che cosa succede se proviamo a visualizzare la lista restituita da rotate3D?

Graphics3D[Point[rotate3D[{x, y, z}, rotationxy, rotationyz]]] // 
      Show

Fissiamo un valore per le coordinate del punto da ruotare. Per evitare di "sporcare" le variabili x, y e z, introduciamo delle nuove variabili x0, y0 e z0, alle quali assegneremo un valore unitario. Ora risulta possibile visualizzare il grafico del punto ruotato:

{x0, y0, z0} = {1, 1, 1};
Graphics3D[Point[rotate3D[{x0, y0, z0}, rotationxy, rotationyz]]] // 
      Show

In alternativa è possibile sfruttare un'opportuna sostituzione:

Graphics3D[
        Point[rotate3D[{x, y, z}, rotationxy, rotationyz]] /. {x -> 1, 
            y -> 1, z -> 1}] // Show

Costruiamo una funzione mostraRotazione che accetta come input le coordinate di un punto e i due angoli di rotazione e visualizza in un unico grafico i punti originale e ruotato:

mostraRotazione[iniz_, txy_,  tyz_] := 
      Module[{fin}, 
fin = 
          rotate3D[iniz, txy, tyz]; 
Show[
          Graphics3D[{Point[iniz], 
              Point[fin]}]]
]

Visualizziamo la rotazione  utilizzando come punto iniziale e come angoli i valori precedentemente fissati:

mostraRotazione[{x0, y0, z0}, rotationxy, rotationyz]

Modifichiamo la funzione appena creata in modo da evidenziare meglio i due punti, ingrandendone il diametro e colorandoli in modo differente:

mostraRotazione[iniz_, txy_,  tyz_] := 
      Module[{fin}, 
fin = 
          rotate3D[iniz, txy, tyz]; 
Show[
          Graphics3D[{AbsolutePointSize[10], {RGBColor[1, 0, 0], 
                Point[iniz]}, {RGBColor[0, 0, 1], 
                Point[fin]}}]]
]

Visualizziamo la rotazione  utilizzando come punto iniziale e come angoli i valori precedentemente fissati:

mostraRotazione[{x0, y0, z0}, rotationxy, rotationyz]

Visualizzate la rotazione mantenendo invariato il punto iniziale e scegliendo altri valori per gli angoli (si consiglia di iniziare con valori relativamente piccoli):

mostraRotazione[{x0, y0, z0},  .1,  .1]

La funzione mostraRotazione fornisce dei grafici la cui forma può cambiare notevolmente quando variano i sueoi argomenti. Modifichiamola in modo che l'area visualizzata rimanga costante:

mostraRotazione[iniz_, txy_,  tyz_] := 
      Module[{fin}, 
fin = 
          rotate3D[iniz, txy, tyz]; 
Show[
          Graphics3D[{AbsolutePointSize[16], {RGBColor[1, 0, 0], 
                Point[iniz]}, {RGBColor[0, 0, 1], Point[fin]}}], 
          Axes -> True, 
          PlotRange -> {{-2, 2}, {-2, 2}, {-2, 
                2}}]
]

Come in precedenza, visualizzate la rotazione mantenendo invariato il punto iniziale e scegliendo altri valori per gli angoli (si consiglia di iniziare con valori relativamente piccoli):

mostraRotazione[{x0, y0, z0}, 1.4,  .4];

Approfittiamone per costruire un'animazione, sfruttando la funzione Animate che ha un comportamento analogo a Table. Valutando la cella seguente vengono prodotti venti fotogrammi in cui l'angolo di rotazione in un piano varia tra 0 e 2π, mentre l'altro angolo di rotazione rimane invariato. Selezionando tutti i fotogrammi, raggruppandoli (tramite la voce di menu Cell/Cell grouping/Group cells), contraendo il gruppo (eseguendo un doppio click sul delimitatore che raggruppa l'intero gruppo) e premendo ⌘+y oppure selezionando la voce di menu Cell/Animate selected graphics, i fotogrammi vengono visualizzati in successione:

Do[mostraRotazione[{x0, y0, z0}, i, 1], {i, 0, 2  Pi, 
        2  Pi/20}]

Create e visualizzate un'altra animazione in cui il primo angolo di rotazione rimane fisso mentre il secondo viene fatto variare.

Sfruttiamo ora quello che abbiamo imparato al fine di visualizzare un albero tridimensionale. Iniziamo definendo la variabile shrinkage che definisce come viene accorciata una ramificazione rispetto al ramo da cui si dirama, e ridefiniamo rotationxy e rotationyz (nel caso aveste dovuto rieseguire il kernel):

shrinkage = 0.8;
rotationxy = Pi/3;
rotationyz = Pi/9;

Definiamo poi la funzione twinLine che verrà applicata iterativamente; in questo caso da ogni linea si dirameranno quattro diramazioni (in che direzioni?):

twinLine[
        Line[{start_, 
            end_}]] := 
{
Line[{end, 
            end + shrinkage rotate3D[end - start, rotationxy, 
                  rotationyz]}
], 
Line[{end, 
            end + shrinkage rotate3D[end - start, 
                  rotationxy, -rotationyz]}
], 
Line[{end, 
            end + shrinkage rotate3D[end - start, -rotationxy, 
                  rotationyz]}
], 
Line[{end, 
            end + shrinkage rotate3D[
                  end - start, -rotationxy, -rotationyz]}
]
}

Che cosa succede se partiamo da un generico segmento, diciamo di estremi (0, 0, 0) e (0, 0, 1) e applichiamo una volta twinLine? Visualizziamo in uno stesso grafico sia il segmento di partenza che quelli prodotti dall'applicazione della funzione.

soluzione

Show[
        Graphics3D[{Line[{{0, 0, 0}, {0, 0, 1}}], 
            twinLine[Line[{{0, 0, 0}, {0, 0, 1}}]]}], 
        Axes -> True];

Definiamo ora una funzione che applica twinLine a tutti gli elementi di una lista e ritorna la lista contenente i valori ottenuti, e verifichiamo che si comporti in modo adeguato:

doTwins[lines_] := Flatten[Map[twinLine, lines]]

doTwins[{Line[{{0, 0, 0}, {0, 0, 1}}], 
        Line[{{0, 0, 2}, {1, 1, 1}}]}]

Utilizzando la funzione Nest siamo in grado di applicare ripetutamente doTwins a un oggetto iniziale. Visualizzando ad esempio gli oggetti grafici ottenuti partendo dal segmento di estremi (0, 0, 0) e (0, 0, 1) e applicando la funzione due volte, otteniamo il seguente risultato:

Show[
        Graphics3D[
          Nest[doTwins, {Line[{{0, 0, 0}, {0, 0, 1}}]}, 2]]];

Modifichiamo il codice contenuto nella cella precedente in modo che visualizzi l'intero "albero" e non solo gli ultimi "rami", usando la funzione NestList:

soluzione

Show[
        Graphics3D[
          NestList[doTwins, {Line[{{0, 0, 0}, {0, 0, 1}}]}, 
            2]]];

Rigeneriamo il grafico precedente modificando alcune opzioni di Show in modo da migliorare l'output grafico dell'"albero" (se non le conoscete, andate a leggerne la descrizione nella documentazione elettronica):

soluzione

Show[
        Graphics3D[NestList[doTwins, {Line[{{0, 0, 0}, {0, 0, 1}}]}, 2]], 
        BoxRatios -> Automatic, PlotRange -> All];

Provate ora a creare un albero un po' più "adulto", aumentando il numero di chiamate a doTwins (non troppe, il processo di crescita del numero totale di ramificazioni è esponenziale). Se tutto è andato bene, applicando la funzione sette volte dovreste ottenere il seguente risultato:

soluzione

Show[
        Graphics3D[NestList[doTwins, {Line[{{0, 0, 0}, {0, 0, 1}}]}, 5]], 
        BoxRatios -> Automatic, PlotRange -> All];

Rigeneriamo lo stesso albero usando come punto di partenza il segmento di estremi (0, 0, 0) e (1, 1, 1). Ripetete il procedimento scegliendo altri segmenti di partenza.

soluzione

Show[
        Graphics3D[NestList[doTwins, {Line[{{0, 0, 0}, {1, 1, 1}}]}, 5]], 
        AspectRatio -> Automatic, PlotRange -> All];

Sulla base del codice scritto fino ad ora, scriviamo una funzione tree che, partendo dal segmento di estremi (0, 0, 0) e (0, 0, 1), genera un albero sulla base di cinque argomenti che rappresentano rispettivamente il numero di iterazioni di doTwins, gli angoli di rotazione, la scala ed eventuali opzioni da passare a Show:

soluzione

tree[depth_, rotationxyP_, rotationyzP_, shrinkageP_, opts___] := 
      Block[{}, 
rotationxy = 
          rotationxyP; 
rotationyz = 
          rotationyzP; 
shrinkage = 
          shrinkageP; 
Show[
          Graphics3D[
            NestList[
doTwins, {Line[{{0, 0, 0}, {0, 0, 
                      1}}]}, depth]], 
opts, 
          AspectRatio -> Automatic, 
          PlotRange -> All]
]

Ecco alcuni risultati ottenibili:

tree[5, 0.2, 0.2, 0.5];

tree[5, 0.5, 1, 0.75];

tree[5, 0.5, 0.1, 1];

Visualizzare un albero più realistico I

Modificare lo spessore dei rami

Modificiamo tree in modo che le ramificazioni abbiano uno spessore, maggiore rispetto alle simulazioni precedenti , che tenda a diminuire man mano che aumenta il numero di chiamate a doTwins:

soluzione

thicknessShrinkage = 0.8;
originalThickness = 0.5;
twinLine[Thickness[th_]] := 
        Thickness[th thicknessShrinkage];

Clear[tree];
tree[depth_, rotationxyP_, rotationyzP_, shrinkageP_,  
        thicknessShrinkageP_, originalThicknessP_, opts___] := 
      Block[{}, 
rotationxy = 
          rotationxyP; 
rotationyz = 
          rotationyzP; 
shrinkage = 
          shrinkageP; 
thicknessShrinkage = 
          thicknessShrinkageP; 
originalThickness = 
          originalThicknessP; 
Show[
          Graphics3D[
            NestList[
doTwins, {Thickness[
                  originalThickness], Line[{{0, 0, 0}, {0, 0, 1}}]}, 
              depth
]], 
opts, 
          AspectRatio -> Automatic, 
          PlotRange -> All]
]

Ecco alcuni risultati ottenibili:

tree[2, 0.4, 0.2, 0.9, 0.75, 0.05];

albero = tree[6, 0.5, 0.5,  .9, 0.75, 0.05];

Modifichiamo il punto da cui viene osservato l'albero, utilizzando l'opzione ViewPoint della funzione Show. In particolare, è possibile selezionare il valore per questa opzione sfruttando un visualizzatore grafico accessibile tramite la voce di menu Input/3D ViewPoint Selector:

Show[albero, 
      ViewPoint -> {-2.170,  -2.558,  0.447}]

Provate a specificare altri valori per l'opzione ViewPoint, sia inserendoli manualmente che ricorrendo alla finestra sopra descritta.

Visualizzare un albero più realistico II

Non utilizzare valori fissi per i parametri delle trasformazioni

Modifichiamo le funzioni definite fino ad ora in modo da introdurre delle variazioni casuali nei parametri di volta in volta utilizzati per ruotare e/o scalare i rami dell'albero, in modo da ottenere un output più realistico. Di seguito è riportata una delle possibili soluzioni, in cui tutti i parametri che regolano la generazione degli alberi sono gestiti mediante il meccanismo delle opzioni:

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

Clear[twinLine];
twinLine[
        Line[{start_, 
            end_}]] := 
{
Line[{end, 
            end + shrinkage rotate3D[end - start, rotationxy, 
                  rotationyz]}
], 
Line[{end, 
            end + shrinkage rotate3D[end - start, 
                  rotationxy, -rotationyz]}
], 
Line[{end, 
            end + shrinkage rotate3D[end - start, -rotationxy, 
                  rotationyz]}
], 
Line[{end, 
            end + shrinkage rotate3D[
                  end - start, -rotationxy, -rotationyz]}
]
}

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

twinLine[
          RGBColor[r_, g_, b_]] := (branchColors = 
            RotateLeft[branchColors]; 
First[
            branchColors]
);

Clear[doTwins];
doTwins[lines_] := Flatten[Map[twinLine, lines]];

Options[beautifulTree] = {Generations -> 4, 
          BranchRotation -> 0.65, BranchShortening -> 0.75, 
          BranchThinning -> 0.7, OriginalThickness -> 0.07, 
          BranchColors -> {RGBColor[0, 0, 0]}, 
          ViewPoint -> {-2.170,  -2.558,  
              0.447}};

Clear[beautifulTree, filterOptions];
beautifulTree[opts___] := 
        Block[{generations, branchRotation, branchShortening, branchThinning, 
            originalThickness, branchColors, 
            vp}, 
{generations, branchRotation, 
              branchShortening, branchThinning, originalThickness, 
              branchColors, 
              vp} = {Generations, BranchRotation, BranchShortening, 
                  BranchThinning, OriginalThickness, BranchColors, 
                  ViewPoint} /. {opts} /. 
              Options[beautifulTree]; 
Show[
            Graphics3D[
              NestList[
doTwins, {First[branchColors], 
                  Thickness[originalThickness], 
                  Line[{{0, 0, 0}, {0, 0, 1}}]}, 
                generations]], 
filterOptions[Show, opts], 
            AspectRatio -> Automatic, PlotRange -> All, 
            ViewPoint -> 
              vp]
];
filterOptions[command_Symbol, opts___] := 
        Block[{keywords = 
              First  /@  Options[command]}, 
Sequence @@ 
            Select[{opts}, 
              MemberQ[keywords, 
                  First[#]] &]
];

Utilizzando le funzioni sopra definite si possono ottenere grafici come quelli che seguono. Va rimarcato il fatto che anche eseguendo lo stesso codice l'output sarà di volta in volta leggermente differente, a causa dell'introduzione di variazioni casuali nella generazione delle varie ramificazioni:

beautifulTree[
Generations -> 
          3, 
BranchRotation -> 
          0.65, 
BranchShortening -> 
          0.75, 
BranchThinning -> 
          0.7, 
OriginalThickness -> 
          0.07];

beautifulTree[];

beautifulTree[BranchRotation -> 2.2, 
        Generations -> 6];

Visualizzare un albero più realistico III

Aggiungere un tocco di colore

L'esempio riportato nel paragrafo precedente implementa anche l'opzione BranchColors, che permette di specificare una lista di colori da applicare ai vari livelli dei rami presenti in un albero:

beautifulTree[Generations -> 6, 
        BranchColors -> {
RGBColor[0.562, 0.236, 
              0.071], 
RGBColor[0.547, 0.229, 
              0.069], 
RGBColor[0.500, 0.210, 
              0.063], 
RGBColor[0.469, 0.196, 
              0.059], 
RGBColor[0.033, 0.281, 
              0.035], 
RGBColor[0.046, 0.395, 
              0.050], 
RGBColor[0.055, 0.469, 
              0.059], 
RGBColor[0.070, 0.602, 
              0.076], 
RGBColor[0.085, 0.727, 
              0.092], 
RGBColor[0.109, 0.937, 
              0.118], 
RGBColor[0.013, 0.750, 
              0.028], 
}];