13
$\begingroup$

How can one plot a distribution of planes in $\mathbb R^3$ in Mathematica?

For some point $p=(x,y,t)\in\mathbb R^3$, I want to attach a plane spanned by $X(p)=\left(1,0,\frac{y}{2}\right)$ and by $Y(p)=\left(0,1,-\frac{x}{2}\right)$, in order to obtain something like this:

some planes

(The above figure is taken from here.)

$\endgroup$
6
  • $\begingroup$ What about the code/source for the shown image? $\endgroup$
    – Yves Klett
    Dec 14 '15 at 10:14
  • 1
    $\begingroup$ The link is lukyanenko.net/gallery.php?page=3 $\endgroup$
    – Claretta
    Dec 14 '15 at 10:16
  • $\begingroup$ Suggestion: you can put the link into the question, where it will be permanently preserved. Also, it usually helps to show what you tried already. $\endgroup$
    – Yves Klett
    Dec 14 '15 at 10:35
  • $\begingroup$ I'm going to add the link in the question. But I don't know how to plot something like this. I'm an occasional Mathematica user, so I'm not expert at all. $\endgroup$
    – Claretta
    Dec 14 '15 at 10:40
  • $\begingroup$ I've edited the post, I hope now it is clearer. $\endgroup$
    – Claretta
    Dec 14 '15 at 10:55
20
$\begingroup$
a = .2;
base = Polygon[{{-a, -a, 0}, {-a, a, 0}, {a, a, 0}, {a, -a, 0}}/2];
r = 2 a;

Graphics3D[{

  GeometricTransformation[
   base,
   Flatten[
    Table[
         TranslationTransform[{x, y, 0}] @* RotationTransform[
            {{0, 0, 1}, Cross[{1, 0, .5 y}, {0, 1, -.5 x}]}],
     {x, - r, r, a}, {y, - r, r, a}
     ], 1]
   ],
  {  Thick
     ,
     Blue, (* normal to base*)
     Arrow[{#, # + {0, 0, .2}} ]
     ,
     Green, (* spanning vectors *)
     Arrow[{#, # + .2 {1, 0, .5 #[[2]]}} ], 
     Arrow[{#, # + .2 {0, 1, -.5 #[[1]]}} ]
     ,
     Red, (* normal to spanned plane*)
     Arrow[{#, # + .2 Cross[{1, 0, .5 #[[2]]}, {0, 1, -.5 #[[1]]}]  }]
  } &@{r, r, 0}
 }, 
  PlotRange -> All, Axes -> True]

enter image description here

and with J.M.'s suggestion about BoxRatios:

Graphics3D[{
  base,
  GeometricTransformation[
   base,
   Flatten[
    Table[
     TranslationTransform[{x, y, 0}]@*RotationTransform[
       {{0, 0, 1}, Normalize@Cross[{1, 0, .5 y}, {0, 1, -.5 x}]}],
     {x, -r, r, a}, {y, -r, r, a}
     ], 1]
   ]

  }, PlotRange -> All, Axes -> True, BoxRatios -> {1, 1, 0.4`}]

enter image description here

a = .1;
r = 5 a;

enter image description here

$\endgroup$
5
  • 1
    $\begingroup$ Note that the original picture seems to be using the BoxRatios setting of Plot3D[]... $\endgroup$
    – J. M.'s torpor
    Dec 14 '15 at 11:20
  • $\begingroup$ @J.M., you're right! $\endgroup$
    – Kuba
    Dec 14 '15 at 11:24
  • $\begingroup$ I know. ;) For completeness: Lighting -> "Classic". $\endgroup$
    – J. M.'s torpor
    Dec 14 '15 at 11:31
  • $\begingroup$ @J.M. I won't doubt again! $\endgroup$
    – Kuba
    Dec 14 '15 at 11:38
  • $\begingroup$ @Kuba: Thanks a lot! $\endgroup$
    – Claretta
    Dec 14 '15 at 12:36
6
$\begingroup$

Here's a very compact version, constructed through the magic of dot products:

With[{a = 1/5, r = 2/5}, 
     Graphics3D[Polygon[Flatten[Table[{x, y, 0} + # & /@
                                      (a {{1, 1}, {-1, 1}, {-1, -1}, {1, -1}} .
                                      {{1, 0, y/2}, {0, 1, -x/2}}/2),
                                      {x, -r, r, a}, {y, -r, r, a}], 1]],
                Axes -> True, BoxRatios -> {1, 1, 0.4}, 
                Lighting -> "Classic", PlotRange -> All]]

so, they're all just tilted like that?

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.