Message Boards Message Boards

0
|
4868 Views
|
2 Replies
|
1 Total Likes
View groups...
Share
Share this post:

How to initialize a linear transformation of R^3 in wolfram mathematica?

Posted 9 years ago

Hello guys,

I've been trying to solve a linear transformation of R^3 in wolfram mathematica, but i find it difficult to initialize the transformation. Here is the code that i've been trying but it doesn't work. Any suggestions?

Off[General::spell1]
$TextStyle = {FontFamily -> "Courier-Bold", FontSize -> 18};

ThreeDLinearTransform[M_] := ThreeDLinearTransform[M, {{-2.2, 2.2}, {-2.2, 2.2}, {-2.2, 2.2}}]
ThreeDLinearTransform[M_, plotrange_] := Module[{hpairs, vpairs, dpairs, hlines, vlines, dlines, Mhlines,Mvlines, Mdlines, k, n, domain, range}, 
  hpairs = Table[{{0.`, k, n}, {1.`, k, n}}, {k, 0, 1, 0.1`}, {n, 0,1, 0.1`}];
  vpairs = Table[{{k, 0.`, n}, {k, 1.`, n}}, {k, 0, 1, 0.1`}, {n, 0, 1, 0.1`}];
  dpairs = Table[{{k, n, 0.`}, {k, n, 1.`}}, {k, 0, 1, 0.1`}, {n, 0, 1, 0.1`}];
  hlines = {RGBColor[0, 0, 1], Thickness[0.006`], Line /@ hpairs};
  vlines = {RGBColor[1, 0, 0], Thickness[0.006`], Line /@ vpairs};
  dlines = {RGBColor[0, 1, 0], Thickness[0.006`], Line /@ dpairs}; 
  domain = Show[Graphics[hlines], Graphics[vlines], Graphics[dlines], AspectRatio -> Automatic, PlotRange -> plotrange, Axes -> True, 
    Ticks -> {Range[Ceiling[plotrange[[1, 1]]],Floor[plotrange[[1, 2]]]], Range[Ceiling[plotrange[[2, 1]]], Floor[plotrange[[2, 2]]]]},DisplayFunction -> Identity]; 
  Mhlines = {RGBColor[0, 0, 1], Thickness[0.006`], Line /@ ({M.#1[[1]], M.#1[[2]]} &) /@ hpairs};
  Mvlines = {RGBColor[1, 0, 0], Thickness[0.006`], Line /@ ({M.#1[[1]], M.#1[[2]]} &) /@ vpairs};
  Mdlines = {RGBColor[0, 1, 0], Thickness[0.006`],Line /@ ({M.#1[[1]], M.#1[[2]]} &) /@ dpairs};
  range = Show[Graphics[Mhlines], Graphics[Mvlines], AspectRatio -> Automatic, PlotRange -> plotrange, Axes -> True,
Ticks -> {Range[Ceiling[plotrange[[1, 1]]], Floor[plotrange[[1, 2]]]], Range[Ceiling[plotrange[[2, 1]]], Floor[plotrange[[2, 2]]]]}, DisplayFunction -> Identity]; 
  Show[GraphicsRow[{domain, range}], DisplayFunction -> $DisplayFunction, ImageSize -> {640, 480}]]

and here is the rotation of 45 degrees that I'm trying to do:

A = (1/2) {{Sqrt[2], -Sqrt[2], Sqrt[2] }, {Sqrt[2], -Sqrt[2], Sqrt[2]}, {Sqrt[2], -Sqrt[2], Sqrt[2]}};
MatrixForm[A]

ThreeDLinearTransform[A]
POSTED BY: Ani Petreska
2 Replies

I recommend a different line of attack. Perhaps it will be helpful to extend this example.

lines and points

originalPoints = Accumulate[RandomReal[{-1, 1}, {20, 3}]]
lines = Transpose[
  {
   RandomColor[Length[originalPoints] - 1], 
   Table[Line[{i, i + 1}], {i, 1, Length@originalPoints - 1}]
   }
  ]

graphics

Graphics3D[GraphicsComplex[originalPoints, lines]]

graphics with linear transformation

rotMat = RotationMatrix[Pi/3, {1, 1, 1}]
Graphics3D[
 GraphicsComplex[originalPoints /. {x_, y_, z_} :> rotMat.{x, y, z}, 
  lines]]

dynamic

Manipulate[
 Show[
  Graphics3D[GraphicsComplex[originalPoints, lines]],
  With[{rotMat = RotationMatrix[angle Degree, {1, 1, 1}]}, 
   Graphics3D[
    GraphicsComplex[
     originalPoints /. {x_, y_, z_} :> rotMat.{x, y, z}, lines]]
   ]
  ],
 {angle, 0, 360}
 ]

your transformation

A = (1/2) {{Sqrt[2], -Sqrt[2], Sqrt[2]}, {Sqrt[2], -Sqrt[2], 
     Sqrt[2]}, {Sqrt[2], -Sqrt[2], Sqrt[2]}};

Graphics3D[
 GraphicsComplex[originalPoints /. {x_, y_, z_} :> A.{x, y, z}, 
  lines]]
POSTED BY: W. Craig Carter
Posted 9 years ago

Thank you very much. I've been trying a different approach, so here is what i got by now. I have 3D cube and I need to do linear transformation on it: rotation by 45 degrees, Reflection in the x2-axis, A Contraction, A Dilation, A Vertical Expansion, A Shear.

vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};(*VertexTextureCoordinates*)

kocka = {{{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}}, {{0, 0, 0}, {1,
      0, 0}, {1, 0, 1}, {0, 0, 1}}, {{1, 0, 0}, {1, 1, 0}, {1, 1, 
     1}, {1, 0, 1}}, {{1, 1, 0}, {0, 1, 0}, {0, 1, 1}, {1, 1, 
     1}}, {{0, 1, 0}, {0, 0, 0}, {0, 0, 1}, {0, 1, 1}}, {{0, 0, 
     1}, {1, 0, 1}, {1, 1, 1}, {0, 1, 1}}};

MatrixForm[kocka]
Graphics3D[
 Table[{Texture[mat[k]], 
   Polygon[kocka[[k]], VertexTextureCoordinates -> vtc]}, {k, 1, 6}], 
 Axes -> True, AxesLabel -> {x, y, z}, PlotRange -> 1]
POSTED BY: Ani Petreska
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract