3
$\begingroup$

I want to select four points in a plane make a parallelogram. Tried

L = {x, y, z} /. 
   Solve[{2 x + 2 y +  z - 5 == 0, -7 <= x <= 7, -7 <= y <= 7, -7 <= 
      z <= 7, x y z != 0, (x - y) (y - z) (z - x) != 0}, {x, y, z}, 
    Integers];
Length[L]
ss = Subsets[L, {4}];
t = Select[
  ss, (12 == Length[Union[#[[1]], #[[2]], #[[3]], #[[4]]]] ) && 
    Norm[Cross[#[[2]] - #[[1]], #[[3]] - #[[1]]]] !=  
     0 && #[[2]] - #[[1]] == #[[4]] - #[[3]] &]
Length[t]

I got

{{{-7, 7, 5}, {-3, 6, -1}, {-2, 4, 1}, {2, 3, -5}}, 
 {{-7, 7, 5}, {-2, 6, -3}, {-1, 2, 3}, {4, 1, -5}}, 
 {{-6, 7, 3}, {-3, 5, 1}, {-1, 6, -5}, {2, 4, -7}}, 
 {{-5, 4, 7}, {-2, 6, -3}, {2, -1, 3}, {5, 1, -7}}, 
 {{-5, 6, 3}, {-2, 1, 7}, {2, 4, -7}, {5, -1, -3}}, 
 {{-4, 7, -1}, {-2, 6, -3}, {3, 2, -5}, {5, 1, -7}}, 
 {{-3, 3, 5}, {1, -2, 7}, {2, 4, -7}, {6, -1, -5}}, 
 {{-2, 1, 7}, {-1, 6, -5}, {3, -3, 5}, {4, 2, -7}}, 
 {{-1, 2, 3}, {1, 5, -7}, {4, -5, 7}, {6, -2, -3}}, 
 {{-1, 5, -3}, {1, -2, 7}, {4, 2, -7}, {6, -5, 3}}, 
 {{1, 4, -5}, {2, -1, 3}, {6, -2, -3}, {7, -7, 5}}, 
 {{1, 5, -7}, {2, 3, -5}, {6, -2, -3}, {7, -4, -1}}, 
 {{3, 2, -5}, {4, -2,1}, {6, -3, -1}, {7, -7, 5}}, 
 {{4, 2, -7}, {5, -3, 1}, {6, -1, -5}, {7, -6, 3}}}

The order (from left to right) of the four points

{{-3, 3, 5}, {1, -2, 7}, {2, 4, -7}, {6, -1, -5}}

doesn't make a parallelogram.

How can I arrange the order of vertices from left to right to always get a parallelogram.

$\endgroup$
1
  • $\begingroup$ FindCurvePath? $\endgroup$
    – corey979
    Jan 15, 2017 at 7:17

2 Answers 2

4
$\begingroup$

You just have to interchange the 3rd and 4th points.

data =
  {{{-7, 7, 5}, {-3, 6, -1}, {-2, 4, 1}, {2, 3, -5}}, 
   {{-7, 7, 5}, {-2, 6, -3}, {-1, 2, 3}, {4, 1, -5}}, 
   {{-6, 7, 3}, {-3, 5, 1}, {-1, 6, -5}, {2, 4, -7}}, 
   {{-5, 4, 7}, {-2, 6, -3}, {2, -1, 3}, {5, 1, -7}}, 
   {{-5, 6, 3}, {-2, 1, 7}, {2, 4, -7}, {5, -1, -3}}, 
   {{-4, 7, -1}, {-2, 6, -3}, {3, 2, -5}, {5, 1, -7}}, 
   {{-3, 3, 5}, {1, -2, 7}, {2, 4, -7}, {6, -1, -5}}, 
   {{-2, 1, 7}, {-1, 6, -5}, {3, -3, 5}, {4, 2, -7}}, 
   {{-1, 2, 3}, {1, 5, -7}, {4, -5, 7}, {6, -2, -3}}, 
   {{-1, 5, -3}, {1, -2, 7}, {4, 2, -7}, {6, -5, 3}}, 
   {{1, 4, -5}, {2, -1, 3}, {6, -2, -3}, {7, -7, 5}}, 
   {{1, 5, -7}, {2, 3, -5}, {6, -2, -3}, {7, -4, -1}}, 
   {{3, 2, -5}, {4, -2,1}, {6, -3, -1}, {7, -7, 5}}, 
   {{4, 2, -7}, {5, -3, 1}, {6, -1, -5}, {7, -6, 3}}};

twiddle[{a_, b_, c_, d_}] := {a, b, d, c}

 parallelograms = twiddle /@ data
{{{-7, 7, 5}, {-3, 6, -1}, {2, 3, -5}, {-2, 4, 1}},
 {{-7, 7, 5}, {-2, 6, -3}, {4, 1, -5}, {-1, 2, 3}},
 {{-6, 7, 3}, {-3, 5, 1}, {2, 4, -7}, {-1, 6, -5}},
 {{-5, 4, 7}, {-2, 6, -3}, {5, 1, -7}, {2, -1, 3}},
 {{-5, 6, 3}, {-2, 1, 7}, {5, -1, -3}, {2, 4, -7}},
 {{-4, 7, -1}, {-2, 6, -3}, {5, 1, -7}, {3, 2, -5}},
 {{-3, 3, 5}, {1, -2, 7}, {6, -1, -5}, {2, 4, -7}},
 {{-2, 1, 7}, {-1, 6, -5}, {4, 2, -7}, {3, -3, 5}},
 {{-1, 2, 3}, {1, 5, -7}, {6, -2, -3}, {4, -5, 7}},
 {{-1, 5, -3}, {1, -2, 7}, {6, -5, 3}, {4, 2, -7}},
 {{1, 4, -5}, {2, -1, 3}, {7, -7, 5}, {6, -2, -3}},
 {{1, 5, -7}, {2, 3, -5}, {7, -4, -1}, {6, -2, -3}},
 {{3, 2, -5}, {4, -2, 1}, {7, -7, 5}, {6, -3, -1}},
 {{4, 2, -7}, {5, -3, 1}, {7, -6, 3}, {6, -1, -5}}}
Multicolumn[
  Graphics3D[{Hue[RandomReal[]], Polygon[#]}, 
    Boxed -> False, Lighting -> "Neutral"] & /@ parallelograms,
  2]

grid

$\endgroup$
4
  • $\begingroup$ Where is wrong in my code? $\endgroup$ Jan 15, 2017 at 9:24
  • $\begingroup$ Nothing, so far as I can tell. Your points are getting sorted by some operation along the line, so you just have to reorder them at end. $\endgroup$
    – m_goldberg
    Jan 15, 2017 at 9:40
  • 1
    $\begingroup$ @toandhsp The points come out Sort-ed from Subsets, I believe. But I wonder if a different twiddle might be needed in some case. (I wouldn't be surprised if twiddle always works. It should work generically, and it works in all the edge-cases I can imagine. But can I imagine them all? I don't have time to sort it out, right now.) $\endgroup$
    – Michael E2
    Jan 15, 2017 at 17:14
  • $\begingroup$ @MichaelE2 Thank you very much. I want a general code in every cases. $\endgroup$ Jan 16, 2017 at 8:21
0
$\begingroup$

strong text

For[a = 3, a < 8, a++, 
 L = {x, y, z} /. 
   Solve[{2 x + 2 y + z - 5 == 0, -a <= x <= a, -a <= y <= a, -a <= 
      z <= a, x y z != 0, (x - y) (y - z) (z - x) != 0}, {x, `enter code here`y, z}, 
    Integers];
 ss = Subsets[L, {4}];
 t = Select[ss,
   (Norm[#[[1]] - #[[2]]] == Norm[#[[3]] - #[[4]]] && 
       Norm[#[[1]] - #[[4]]] == Norm[#[[2]] - #[[3]]]) \[Or]
     (Norm[#[[1]] - #[[2]]] == Norm[#[[3]] - #[[4]]] && 
       Norm[#[[1]] - #[[3]]] == Norm[#[[2]] - #[[4]]]) \[Or]
     (Norm[#[[1]] - #[[3]]] == Norm[#[[2]] - #[[4]]] && 
       Norm[#[[1]] - #[[4]]] == Norm[#[[2]] - #[[3]]])
    &];
 Print["(", Length[L], ", " , Length[t], ")"]`enter code here`]
$\endgroup$
1
  • $\begingroup$ You might want to check your formatting. Some stray clicks have created errors in your code. $\endgroup$
    – Michael E2
    Jan 16, 2017 at 13:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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