Deformazione affine

v. 1.04  2/10/2002     ©  Amabile Tatone, Università dell'Aquila

Inizializzazione

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

Deformazione

oshift = {0, 0};
scoo = 1;

scoo = If[scoo < 0, -scoo, scoo]

extrashift = {0, 0}*scoo;

newcoo[mycoo_] := scoo*mycoo + oshift

xAo = newcoo[{0, 0}]

xBo = newcoo[{4, 0}]

xDo = newcoo[{0, 4}]

xA = newcoo[{3,  (1/2)}] + extrashift

xB = newcoo[{11,  (1/2)}] + extrashift

xD = newcoo[{6,  (13/2)}] + extrashift

xCo := xBo + (xDo - xAo)

xC := xB + (xD - xA)

xCo

xC

Gradiente della deformazione

normalizza[v_] := (v/(Sqrt[v . v]))

mF = 
        Transpose[{xB - xA, xD - xA}] . 
          Inverse[Transpose[{xBo - xAo, xDo - xAo}]];

MatrixForm[mF]

N[mF] // MatrixForm

N[Det[mF]]

Figure

Definizioni

(xA - xB) + mF . (xBo - xAo)

(xA - xD) + mF . (xDo - xAo)

e1 = {1, 0}; e2 = {0, 1};

x[ζ1_, ζ2_] := 
      xA  +  mF . ( ζ1 e1 +  ζ2 e2  -  
              xAo)

xU[ζ1_, ζ2_] := 
      xAo  +  mU . ( ζ1 e1 +  ζ2 e2  -  
              xAo)

xRU[ζ1_, ζ2_] := 
      xAo  +  mF . ( ζ1 e1 +  ζ2 e2  -  
              xAo)

latoAB[h_] := xAo + h (xBo - xAo);
latoBC[h_] := xBo + h (xCo - xBo);
latoDC[h_] := xDo + h (xCo - xDo);
latoAD[h_] := xAo + h (xDo - xAo);
diagBD[h_] := xBo + h (xDo - xBo);

quadrato := {latoAB[h], latoBC[h], latoDC[h], latoAD[h], 
        diagBD[h]}

L = (Sqrt[(xBo - xAo) . (xBo - xAo)])

ϕ[p_] := 
      x[p[[1]], 
        p[[2]]]

ϕU[p_] := 
      xU[p[[1]], 
        p[[2]]]

ϕRU[p_] := 
      xRU[p[[1]], 
        p[[2]]]

Map[ϕ, quadrato]

cerchio := {Cos[2 π h], Sin[2 π h]} L

ϕ[cerchio]

Griglia

\(\(xmax = 
        Map[#\_\(\([[\)\(1\)\(]]\)\)\  &, {xAo, xBo, xCo, xDo, xA, xB, xC, xD}] // Max;\)\)
\(\(xmin = 
        Map[#\_\(\([[\)\(1\)\(]]\)\)\  &, {xAo, xBo, xCo, xDo, xA, xB, xC, xD}] // Min;\)\)
\(\(ymax = 
        Map[#\_\(\([[\)\(2\)\(]]\)\)\  &, {xAo, xBo, xCo, xDo, xA, xB, xC, xD}] // Max;\)\)
\(\(ymin = 
        Map[#\_\(\([[\)\(2\)\(]]\)\)\  &, {xAo, xBo, xCo, xDo, xA, xB, xC, xD}] // Min;\)\)

\(dx = 
      Apply[GCD, 
        Map[#\_\(\([[\)\(1\)\(]]\)\)\  &, Join[{xAo, xBo, xCo, xDo, xA, xB, xC, xD}, {xAo, xBo, xCo, xDo, xA, xB, 
              xC, xD}]]]\)

\(dy = 
      Apply[GCD, 
        Map[#\_\(\([[\)\(2\)\(]]\)\)\  &, Join[{xAo, xBo, xCo, xDo, xA, xB, xC, xD}, {xAo, xBo, xCo, xDo, xA, xB, 
              xC, xD}]]]\)

dxy = GCD[dx, dy]

grlx = Join[{0}, Table[n, {n, xmin, xmax, dxy}]] // Flatten // 
          Union // Sort

grly = Join[{0}, Table[n, {n, ymin, ymax, dxy}]] // Flatten // 
          Union // Sort

Visualizzazione

dots = 
        Graphics[{{RGBColor[0, 0, 1], Circle[xAo, 0.2]}, {RGBColor[0, 0, 1], 
              Circle[xA, 0.2]}}];

fig = 
        ParametricPlot[
          Evaluate[Join[quadrato, Map[ϕ, quadrato]]], {h, 0, 
            1}, 
AspectRatio -> Automatic,  
          Axes -> False, GridLines -> {grlx, grly}, 
          PlotStyle -> {AbsoluteThickness[3]}];

Show[fig, dots];

ParametricPlot[
        Evaluate[{{Cos[2 π h], Sin[2 π h]}, 
            mF . {Cos[2 π h], Sin[2 π h]}}], {h, 0, 1}, 
        AspectRatio -> Automatic];

ParametricPlot[Evaluate[{cerchio, ϕ[cerchio]}], {h, 0, 1}, 
        AspectRatio -> Automatic,  Axes -> False];

Tensore di Cauchy-Green

Matrice del tensore di Cauchy-Green

mC = Expand[Factor[Transpose[mF] . mF]];

MatrixForm[mC]

N[mC] // MatrixForm

Dilatazioni e direzioni principali

eig = Eigenvalues[mC]

N[eig]

N[(Sqrt[eig])]

mP1 = 
        N[((mC - eig[[2]] IdentityMatrix[2])/(eig[[1]] - eig[[2]]))];

mP2 = IdentityMatrix[2] - mP1;

MatrixForm[mP1]

MatrixForm[mP2]

N[eig[[1]] mP1 + 
          eig[[2]] mP2] // 
      MatrixForm

N[mC] // MatrixForm

normalizza[Transpose[
          mP1][[1]]]

normalizza[Transpose[
          mP2][[1]]]

Dilatazioni e direzioni principali (in alternativa)

{eigv, eigvec} = Eigensystem[mC]

N[(Sqrt[eigv])]

mA = Transpose[Map[normalizza, eigvec]] // Simplify;

mA . mA // Simplify

MatrixForm[mA // N]

mA . DiagonalMatrix[eigv] . Transpose[mA] // Simplify

mC

Notare

normalizza[mP1 . e1]

normalizza[mP2 . e1]

Scorrimento

mC[[1, 2]]/(Sqrt[mC[[1, 1]] mC[[2, 2]]]) // N

ArcCos[
          mC[[1, 2]]/(Sqrt[mC[[1, 1]] mC[[2, 2]]])] (180/π) // N

ArcCos[
            mC[[1, 2]]/(Sqrt[mC[[1, 1]] mC[[2, 2]]])] (180/π) - 90 // N

Dilatazione U

mU = 
        N[(Sqrt[eig])[[1]] mP1 + (Sqrt[eig])[[2]] mP2];

MatrixForm[mU]

ParametricPlot[
        Evaluate[{normalizza[mP1 . {1, 1}] h, 
            normalizza[mP2 . {1, 1}] h}], {h, 0, 1}, 
        AspectRatio -> Automatic];

mA . DiagonalMatrix[(Sqrt[eigv])] . Transpose[mA] // Simplify // N // 
      MatrixForm

Rotazione R

mR = 
        N[mF . ((mP1/(Sqrt[eig]))[[1]] + 
                (mP2/(Sqrt[eig]))[[2]])];

MatrixForm[mR]

mF . mA . DiagonalMatrix[((Sqrt[(eigv^(-1))]))] . Transpose[mA] // 
        N // MatrixForm

ArcTan[mR[[1, 1]], mR[[2, 1]]]/π // N

ArcTan[mR[[1, 1]], 
              mR[[2, 1]]]/π 180 // 
      N

Visualizzazione della deformazione

ParametricPlot[
        Evaluate[{cerchio, ϕU[cerchio], ϕRU[cerchio]}], {h, 0, 1}, 
        AspectRatio -> Automatic,  Axes -> False];

ParametricPlot[
        Evaluate[
          Join[quadrato, Map[ϕU, quadrato], 
            Map[ϕRU, quadrato]]], {h, 0, 1}, 
        AspectRatio -> Automatic,  Axes -> False];

raggio1[h_] := h L e1

raggio2[h_] := h L e2

raggioAut1[h_] := -h L normalizza[mP1 . e1]

raggioAut2[h_] := h L normalizza[mP2 .  e2]

cerchioC := {Evaluate[cerchio], raggio1[h], raggio2[h]}

ParametricPlot[
        Evaluate[
          Join[cerchioC, Map[ϕU, cerchioC], 
            Map[ϕRU, cerchioC]]], {h, 0, 1}, 
        AspectRatio -> Automatic,  Axes -> False];

cerchioCAut := {Evaluate[cerchio], raggioAut1[h], 
        raggioAut2[h]}

ParametricPlot[
        Evaluate[
          Join[cerchioCAut, Map[ϕU, cerchioCAut], 
            Map[ϕRU, cerchioCAut]]], {h, 0, 1}, 
        AspectRatio -> Automatic,  Axes -> False];

figC1 = 
        ParametricPlot[Evaluate[cerchioCAut], {h, 0, 1}, 
          AspectRatio -> Automatic,  Axes -> False, 
          PlotStyle -> {Hue[1]}, 
          DisplayFunction -> Identity];

figC2 = 
        ParametricPlot[Evaluate[Map[ϕU, cerchioCAut]], {h, 0, 1}, 
          AspectRatio -> Automatic,  Axes -> False, 
          PlotStyle -> {Hue[1.3]}, 
          DisplayFunction -> Identity];

figC3 = 
        ParametricPlot[Evaluate[Map[ϕRU, cerchioCAut]], {h, 0, 1}, 
          AspectRatio -> Automatic,  Axes -> False, 
          PlotStyle -> {Hue[1.8]}, 
          DisplayFunction -> Identity];

figC = 
        Show[figC1, figC2, figC3, DisplayFunction -> $DisplayFunction, 
          AspectRatio -> Automatic];

figQ1 = 
        ParametricPlot[Evaluate[quadrato], {h, 0, 1}, 
          AspectRatio -> Automatic,  Axes -> False, 
          PlotStyle -> {Hue[1]}, 
          DisplayFunction -> Identity];

figQ2 = 
        ParametricPlot[Evaluate[Map[ϕU, quadrato]], {h, 0, 1}, 
          AspectRatio -> Automatic,  Axes -> False, 
          PlotStyle -> {Hue[1.3]}, 
          DisplayFunction -> Identity];

figQ3 = 
        ParametricPlot[Evaluate[Map[ϕRU, quadrato]], {h, 0, 1}, 
          AspectRatio -> Automatic,  Axes -> False, 
          PlotStyle -> {Hue[1.8]}, 
          DisplayFunction -> Identity];

figQ = 
        Show[figQ1, figQ2, figQ3, DisplayFunction -> $DisplayFunction, 
          AspectRatio -> Automatic];

Salvataggio figure

Directory[]

\(SetDirectory["/wrk/Corsi/Scost/Class/esercizi/2-def-affini/outmath"]\)

Display["fig.eps", fig, "Eps"]

Display["figC.eps", figC, "Eps"]

Display["figQ.eps", figQ, "Eps"]