Group Abstract

Message Boards

WOLFRAM COMMUNITY

5.8K Views

2 Replies

1 Total Like

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 11 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 11 years ago

POSTED BY: W. Craig Carter

Ani Petreska

Posted 11 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

Feedback