2
$\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$
  • $\begingroup$ FindCurvePath? $\endgroup$ – corey979 Jan 15 '17 at 7:17
3
$\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$
  • $\begingroup$ Where is wrong in my code? $\endgroup$ – minhthien_2016 Jan 15 '17 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 '17 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 '17 at 17:14
  • $\begingroup$ @MichaelE2 Thank you very much. I want a general code in every cases. $\endgroup$ – minhthien_2016 Jan 16 '17 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$
  • $\begingroup$ You might want to check your formatting. Some stray clicks have created errors in your code. $\endgroup$ – Michael E2 Jan 16 '17 at 13:44

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.