Message Boards

WOLFRAM COMMUNITY

5428 Views

2 Replies

1 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Mathematics Wolfram Language

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

Ani Petreska

Posted 10 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]

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

Sort By:

W. Craig Carter

W. Craig Carter, MIT

Posted 10 years ago

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]]

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

Ani Petreska

Posted 10 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]

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

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback