# Select four points in a plane to make a parallelogram

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.

• FindCurvePath? – corey979 Jan 15 '17 at 7:17

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]


• Where is wrong in my code? – minhthien_2016 Jan 15 '17 at 9:24
• 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. – m_goldberg Jan 15 '17 at 9:40
• @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.) – Michael E2 Jan 15 '17 at 17:14
• @MichaelE2 Thank you very much. I want a general code in every cases. – minhthien_2016 Jan 16 '17 at 8:21

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 herey, 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]

• You might want to check your formatting. Some stray clicks have created errors in your code. – Michael E2 Jan 16 '17 at 13:44