1
$\begingroup$

With my special function I was expecting to generate a Point directly perpendicular to the MidPoint of the line chosen by the two points x & y. However, my linear algebra and 3D vector geometry skills don't seem to be up to the challenge, and no matter how many points I send through the function the resulting point doesn't seem to be directly below the line & parallel. The code is much improved since I first encountered the problem - rebuilding the section several times - but the drifting remains an issue to doing further geometric manipulation on the resulting vector. I'm not sure if I would make more progress if I adopted a RotationMatrix approach or if the problem has something to do with the machine precision of the notebook? I know it's not very optimal code yet but any feedback is appricated. Thanks.

special[{x_,y_}]:= Module[
{rotation,line,vec,axisvec,pts,mid,text,view,offset,cross,inverse},
vec = y-x;
mid = midPoint[{x,y}];
rotation = Normal@Rotate[Point@vec,Pi/2,{0,0,1},{0,0,0}];
axisvec = Normal@Translate[Point@{rotation[[1,1]],rotation[[1,2]],0} ,mid];
cross = (({0,0,0} - midPoint[{{0,0,0},y-x}]) \[Cross](axisvec[[1]] - midPoint[{{0,0,0},y-x}])) / 100000;
offset = Normal@Translate[Point@cross,mid];
line = Graphics3D[{Thick,Line@{x,y}}];
pts = Graphics3D[{
{AbsolutePointSize[7], Point /@ {mid,x,y}},
{AbsolutePointSize[9], Orange, offset}
}]]

for example:

{x,y} = {{110,403,-352},{45518,2895,7668}}

enter image description here

enter image description here

$\endgroup$
  • $\begingroup$ Can you clarify what your objective is? Correct me, if I misunderstand your problem: you want to generate a point $z$ for which $z-m$ ($m$ for mid point) is perpendicular to $x-y$? If that is your objective, try generating a random vector $r$ (for example with RandomReal) and compute $r' = r - (r \cdot n)n$, where $n = (x-y)/||x-y||$. Then, $z = m+r'$ is such a point since it fulfills the plane equation $n \cdot (m-z) = 0$. $\endgroup$ – Mauricio Fernández Jul 16 '18 at 7:02
  • $\begingroup$ From the comments it sounds like I was understood. It will take me sometime to run in the code and try it but thanks for the feedback. $\endgroup$ – BBirdsell Jul 16 '18 at 15:10
1
$\begingroup$

Define a function, special, that returns a point on the plane perpendicular to a line from x to y at its midpoint. Solve using the equation n . (x - x0) = 0, where n is a vector normal a plane and at the point x0 and x is a point on the plane.

special[p1_, p2_] := Module[{d, r, n},
  d = EuclideanDistance[p1, p2];
  r = First[RandomReal[{-d/2, d/2}, {1, 3}]];
  n = (p2 - p1)/d;
  (p1 + (p2 - p1)/2) + r - (r.n) n
]

The random vector, r, is arbitrarily chosen so that the return value is nearby the midpoint. Compute ||x - y|| as EuclideanDistance[x, y]. The midpoint is computed as (p1 + (p2 - p1) / 2).

Using the point (x,y), choose a point at random:

{x, y} = {{110, 403, -352}, {45518, 2895, 7668}};
SeedRandom[5]
p = special[x, y];

Two vectors are orthogonal if their dot product is zero. Check:

mid = x + (y - x)/2;
(y - x).(p - mid)
(* 5.96046*10^-8 *)

For a visual check on the answer, use Hyperplane to define a plane at the midpoint and perpendicular the line from x to y.

plane = Hyperplane[y - x, mid];

RegionMember shows that the point p is on the plane.

RegionMember[plane, p]
(* True *)

The graph shows the line from x to y, its midpoint, and the selected point that's on the perpendicular plane at the midpoint.

Graphics3D[{Thick, Blue, Line[{x, y}], PointSize[Large], Point[x], 
  Point[mid], Point[y], Orange, Arrow[{mid, p}], Point[p], 
  Opacity[.1], Hyperplane[x - y, mid]}, Axes -> True]

solution

$\endgroup$
  • $\begingroup$ Could also use RandomPoint[Hyperplane[y - x, mid]]. $\endgroup$ – Carl Woll Jul 20 '18 at 18:35
  • $\begingroup$ I've been playing around with this suggestion but haven't been able to find the perpendicular vector which is pointing down directly below the line. I can't seem to reconfigure the random point which instead of being random points down. I tried something like this First@FindInstance[n.({a,b,0}-mid)==0,{a,b}] but to no avail. $\endgroup$ – BBirdsell Jul 22 '18 at 16:16
  • $\begingroup$ What do you mean by "down?" Try r = {0, 0, -RandomReal[{d/2, d}]}; or simply r = {0, 0, -d/2}; to select a point "below" the line. Again the vector is arbitrary and chosen to return a point nearby the midpoint. Look at the 3D graph to see if that's what you want. $\endgroup$ – creidhne Jul 22 '18 at 22:38
  • $\begingroup$ Unfortunately I ran out of time last night when trying to run through your suggestions but initially it doesn’t look good. (I had planned to cut new images and update the post.) With your suggestions added the point I still not laying underneath the curve as expected. (It still looks like fig. 2 above.) The reason for spending so much time coordinating the z-axis is because eventually this geometry will be used for engineering purposes where everything needs to lie neatly within the plane above/below the beam line which makes the static calculations easier/traditional $\endgroup$ – BBirdsell Jul 23 '18 at 17:28
  • $\begingroup$ If r = {0, 0, -d/2}; in the special function, and {x, y} = {{110, 403, -352}, {45518, 2895, 7668}};, this is the 3D graph. $\endgroup$ – creidhne Jul 23 '18 at 20:09
1
$\begingroup$

It is a matter of elementary geometry that if the perpendicular from a point to a segment bisects the segment then the distances from the point to the endpoints of the segment are equal. Say that the endpoints of the segment are a and b and the external point is p, then the equation to "solve" is

Norm[a - p] == Norm[b - p]

Of course, that equation does not have a unique solution but any point in the plane that bisects the segment and is perpedicular to the segment will satisfy it. So, you could try to solve it in terms of parameters. However, since you want to use Mathematica to find a single point, FindInstance might be your best bet.

In the code below, an additional constraint was imposed: Norm[a - p] < Norm[a - b]. That prevents the points from being so far away that the segment becomes too small.

special[a_, b_] := 
 Module[{p = {x, y, z}, q}, 
  q = {x, y, z} /. 
    FindInstance[
     Norm[a - p] == Norm[b - p] && Norm[a - p] < Norm[a - b], {x, y, 
      z}, Reals, 1000]; 
  Graphics3D[{Blue, Line[{a, b}], Red, Point[q]}]];

special[{1, -3, 0}, {0, 7, 1}]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks so much for your input. I will run through the code tomorrow. I've learned to love normal but am not sure what the documentation says Norm does in this example. $\endgroup$ – BBirdsell Jul 20 '18 at 18:11
  • $\begingroup$ @BBirdsell Norm[{x,y,z}] computes Sqrt[x^2+y^2+z^2]. The documentation is here. $\endgroup$ – Hector Jul 20 '18 at 18:14

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.