An isometry of the Euclidean plane is a distance-preserving transformation of the plane. There are four types: translations, rotations, reflections, and glide reflections. See http://en.wikipedia.org/wiki/Euclidean_plane_isometry#Classification_of_Euclidean_plane_isometries
Procedure AreIsometric checks two plane sets Set1 and Set2 and if there is an isometry of the plane mapping the first set to the second one, then the procedure returns true and false otherwise. Global variable T saves the type of isometry and all its parameters. For example, it returns the rotation center and rotation angle, etc.
Each of the sets Set1 and Set2 is the set (or list) consisting of the following objects in any combinations:
1) The points that are defined as a list of coordinates [х, y] .
2) Segments, which are defined as a set (or list) of two points {[x1, y1], [x2, y2]} or [[x1, y1], [x2, y2]] .
3) Curves, which should be defined as a list of points [[x1, y1], [x2, y2], ..., [xn, yn]].
Of course, if n = 2, then the curve is identical to the segment.
Code of the procedure:
AreIsometric:=proc(Set1::{set,list}, Set2::{set,list})
local n1, n2, n3, n4,s1, S, s, l1, l2, S11, f, x0, y0, phi, Sol, x, y, M1, M2, A1, A2, A3, A4, B1, B2, B3, B4, line1, line2, line3, line4, u, v, Sign, g, M, Line1, Line2, Line3, A, B, C, h, AB, CD, Eq, Eq1, T1, T2, i, S1, S2, T11;
global T;
uses combinat;
S1:={}; S2:={}; T1:={}; T2:={};
for i in Set1 do
if i[1]::realcons then S1:={op(S1),i} else
S1:={op(i), op(S1)}; T1:={op(T1), seq({i[k],i[k+1]}, k=1..nops(i)-1)} fi;
od;
for i in Set2 do
if i[1]::realcons then S2:={op(S2),i} else
S2:={op(i), op(S2)}; T2:={op(T2), seq({i[k],i[k+1]}, k=1..nops(i)-1)} fi;
od;
n1:=nops(S1); n2:=nops(S2); n3:=nops(T1); n4:=nops(T2);
if is(S1=S2) and is(T1=T2) then T:=identity; return true fi;
if n1<>n2 or n3<>n4 then return false fi;
if n1=1 then T:=[translation, <S2[1,1]-S1[1,1], S2[1,2]-S1[1,2]>]; return true fi;
f:=(x,y,phi)->[(x-x0)*cos(phi)-(y-y0)*sin(phi)+x0, (x-x0)*sin(phi)+(y-y0)*cos(phi)+y0]; g:=(x,y)->[(B^2*x-A^2*x-2*A*B*y-2*A*C)/(A^2+B^2), (A^2*y-B^2*y-2*A*B*x-2*B*C)/(A^2+B^2)];
_Envsignum0 := 1;
s1:=[S1[1], S1[2]]; S:=select(s->is((s1[2,1]-s1[1,1])^2+(s1[2,2]-s1[1,2])^2=(s[2,1]-s[1,1])^2+(s[2,2]-s[1,2])^2),permute(S2, 2));
for s in S do
# Checking for translation
l1:=s[1]-s1[1]; l2:=s[2]-s1[2];
if is(l1=l2) then S11:=map(x->x+l1, S1);
if n3<>0 then T11:={seq(map(x->x+l1, T1[i]), i=1..nops(T1))}; fi;
if n3=0 then if is(S11=S2) then T:=[translation, convert(l1, Vector)]; return true fi; else
if is(S11=S2) and is(T11=T2) then T:=[translation, convert(l1, Vector)]; return true fi; fi;
fi;
# Checking for rotation
x0:='x0'; y0:='y0'; phi:='phi'; u:='u'; v:='v'; Sign:='Sign';
if is(s1[1]-s[1]<>s1[2]-s[2]) then
M1:=[(s1[1,1]+s[1,1])/2, (s1[1,2]+s[1,2])/2]; M2:=[(s1[2,1]+s[2,1])/2, (s1[2,2]+s[2,2])/2]; A1:=s1[1,1]-s[1,1]; B1:=s1[1,2]-s[1,2]; A2:=s1[2,1]-s[2,1]; B2:=s1[2,2]-s[2,2]; line1:=A1*(x-M1[1])+B1*(y-M1[2])=0; line2:=A2*(x-M2[1])+B2*(y-M2[2])=0;
if is(A1*B2-A2*B1<>0) then Sol:=solve({line1, line2}); x0:=simplify(rhs(Sol[1])); y0:=simplify(rhs(Sol[2])); u:=[s1[1,1]-x0,s1[1,2]-y0]; v:=[s[1,1]-x0,s[1,2]-y0]; else
if is(s[2]-s1[1]=s[1]-s1[2]) then x0:=(s1[1,1]+s[1,1])/2; y0:=(s1[1,2]+s[1,2])/2;
if is([x0,y0]<>s1[1]) then u:=[s1[1,1]-x0,s1[1,2]-y0]; v:=[s[1,1]-x0,s[1,2]-y0]; else
u:=[s1[2,1]-x0,s1[2,2]-y0]; v:=[s[2,1]-x0,s[2,2]-y0]; fi;
else A3:=s1[2,1]-s1[1,1]; B3:=s1[2,2]-s1[1,2]; A4:=s[2,1]-s[1,1]; B4:=s[2,2]-s[1,2]; line3:=B3*(x-s1[1,1])-A3*(y-s1[1,2])=0; line4:=B4*(x-s[1,1])-A4*(y-s[1,2])=0;Sol:=solve({line3, line4}); x0:=simplify(rhs(Sol[1])); y0:=simplify(rhs(Sol[2]));
if is(s1[1]=s[1]) then u:=s1[2]-[x0,y0]; v:=s[2]-[x0,y0]; else
u:=s1[1]-[x0,y0]; v:=s[1]-[x0,y0]; fi; fi; fi;
Sign:=signum(u[1]*v[2]-u[2]*v[1]); phi:=Sign*arccos(expand(rationalize(simplify((u[1]*v[1]+u[2]*v[2])/sqrt(u[1]^2+u[2]^2)/sqrt(v[1]^2+v[2]^2))))); S11:=expand(rationalize(simplify(map(x->f(op(x), phi), S1))));
if n3<>0 then T11:={seq(expand(rationalize(simplify(map(x->f(op(x), phi), T1[i])))), i=1..nops(T1))}; fi;
if n3=0 then if is(S11=expand(rationalize(simplify(S2)))) then T:=[rotation, [x0,y0], phi]; return true fi; else
if is(S11=expand(rationalize(simplify(S2)))) and is(T11=expand(rationalize(simplify(T2)))) then
T:=[rotation, [x0,y0], phi]; return true fi; fi;
fi;
od;
# Checking for reflection or glide reflection
for s in S do
AB:=s1[2]-s1[1]; CD:=s[2]-s[1];
if is(AB[1]*CD[2]-AB[2]*CD[1]=0) then M:=(s1[2]+s[1])/2;
if is(AB[1]*CD[1]+ AB[2]*CD[2]>0) then A:=AB[2]; B:=-AB[1]; Line1:=A*(x-M[1])+B*(y-M[2])=0; else
A:=AB[1]; B:=AB[2]; Line2:=A*(x-M[1])+B*(y-M[2])=0; fi;
else u:=[AB[1]+CD[1], AB[2]+CD[2]]; A:=u[2]; B:=-u[1]; M:=[(s1[1,1]+s[1,1])/2, (s1[1,2]+s[1,2])/2]; Line3:=A*(x-M[1])+B*(y-M[2])=0; fi; C:=-A*M[1]-B*M[2]; h:= simplify(expand(rationalize(s[1]-g(op(s1[1]))))); S11:=expand(rationalize(simplify(map(x->g(op(x))+h, S1))));
if n3<>0 then T11:={seq(expand(rationalize(simplify(map(x->g(op(x))+h, T1[i])))), i=1..nops(T1))}; fi;
if n3=0 then if is(S11=expand(rationalize(S2))) then
Eq:=A*x+B*y+C=0; Eq1:=`if`(is(coeff(lhs(Eq), y)<>0), y=solve(Eq, y), x=solve(Eq, x));
if h=[0,0] then T:=[reflection, Eq1] else T:=[glide_reflection,Eq1,convert(h, Vector)] fi; return true fi; else
if is(S11=expand(rationalize(S2))) and is(T11=expand(rationalize(T2))) then
Eq:=A*x+B*y+C=0; Eq1:=`if`(is(coeff(lhs(Eq), y)<>0), y=solve(Eq, y), x=solve(Eq, x));
if h=[0,0] then T:=[reflection, Eq1] else
T:=[glide_reflection,Eq1,convert(h, Vector)] fi; return true fi; fi;
od;
T:='T'; false;
end proc:
Three simple examples:
AreIsometric({[4, 0], [7, 4], [14, 0]}, {[4, 14], [9, 14], [10, 6]}); T;
AreIsometric({[2, 0], [2, 2], [5, 0]}, {[3, 3], [3, 6], [5, 3]}); T;
S1 := {[[5, 5], [5, 20], [10, 15], [15, 20], [15, 5]]}:
S2 := {[[21, 11], [30, 23], [31, 16], [38, 17], [29, 5]]}:
S3 := {[[50, 23], [41, 11], [51, 16], [49, 5], [58, 17]]}:
AreIsometric(S1, S2); T; AreIsometric(S1, S3);
plots[display](plottools[curve](op(S1), thickness = 2, color = green), plottools[curve](op(S2), thickness = 2, color = green), plottools[curve](op(S3), thickness = 2, color = red), scaling = constrained, view = [-1 .. 60, -1 .. 25]); # Green sets are isometric, green and red sets aren't
Example with animation:
S1:={[0,0],[-1,2],[2,4],[4,2]}: S2:={[8,3],[6,6],[8,8],[10,4]}:
AreIsometric(S1, S2); T;
with(plots): with(plottools):
# For clarity, instead of points polygons depicted with vertices at these points
N:=50:
A:=seq(rotate(polygon([[0,0],[-1,2],[2,4],[4,2]], color=blue), (k*Pi)/(2*N), [3,7]), k=0..N): B:=polygon([[8,3],[6,6],[8,8],[10,4]], color=green): E:=line([3,7], [6,6], color=black, linestyle=2):
C:=seq(rotate(line([3,7], [2,4], color=black, linestyle=2), (k*Pi)/(2*N), [3,7]), k=0..N): L:=curve([[3,7],[2,4], [-1,2], [0,0],[4,2], [2,4]], color=black, linestyle=2): T:=textplot([3, 7.2, "Center of rotation"]):
Frames:=seq(display(A[k], B, E,T,L, C[k]), k=1..N+1):
display(seq(Frames[k],k=1..N+1), insequence=true, scaling=constrained);
Finding unique solutions to the problem of Queens (m chess queens on an n×n chessboard not attacking one another). Used the procedures Queens and QueenPic . See http://www.mapleprimes.com/posts/200049-Queens-Problem-And-Its-Visualization-With-Maple
Queens(8, 8); M := [ListTools[Categorize](AreIsometric, S)]:
nops(M);
seq(op(M[k])[1], k = 1 .. %); # 12 unique solutions from total 92 solutions
QueensPic([%], 4); # Visualization of obtained solutions
Finding unique solutions to the problem "Polygons of matches" (all polygons with specified perimeter and area). See http://www.mapleprimes.com/posts/142884-Polygons-Of-The-Matches
N := 12: S := 6: Polygons(N, S);
M := [ListTools[Categorize](AreIsometric, T)]:
n := nops(M);
seq([op(M[k][1])], k = 1 .. n); # 7 unique solutions from total 35 solutions with perimeter 12 and area 6
Visual([%], 4); # Visualization of obtained solutions
Isometry_of_plane_se.mw
