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