Square Dissection

Author

Eric W. Weisstein
January 22, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Dissections/SquareDissection.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/SquareDissection.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Solution

v5.0

soln=ToRules[Reduce[{
x1^2+y1^2==1&&
x2^2==x1^2+(1-y1)^2&&
2(x3-1)^2==(1-x2)^2&&
(x3-x2)^2+(x3-1)^2==(x2-x1)^2+(1-y1)^2&&
Sequence@@(0<#<1&/@{x1,x2,x3,y1})
},
{x1,y1,x2,x3},ReplaceValues->True]]

soln={x1->Root[-527+64 #1+7616 ((#1)^2)-9984 ((#1)^3)-24800 ((#1)^4)+63232 ((#1)^5)-22240 ((#1)^6)-72704 ((#1)^7)+111872 ((#1)^8)-73728 ((#1)^9)+25088 ((#1)^10)-4096 ((#1)^11)+256 ((#1)^12)&,5],y1->Root[-3087+18816 #1-45920 ((#1)^2)+55952 ((#1)^3)-27776 ((#1)^4)-28544 ((#1)^5)+93024 ((#1)^6)-130048 ((#1)^7)+108032 ((#1)^8)-52992 ((#1)^9)+14336 ((#1)^10)-2048 ((#1)^11)+256 ((#1)^12)&,3],x2->Root[4-32 #1+80 ((#1)^2)-32 ((#1)^3)-168 ((#1)^4)+288 ((#1)^5)-164 ((#1)^6)-16 ((#1)^7)+60 ((#1)^8)-16 ((#1)^9)-4 ((#1)^10)+((#1)^12)&,5],x3->Root[49-88 #1-1188 ((#1)^2)+6480 ((#1)^3)-14772 ((#1)^4)+17152 ((#1)^5)-6720 ((#1)^6)-8576 ((#1)^7)+14832 ((#1)^8)-10368 ((#1)^9)+3904 ((#1)^10)-768 ((#1)^11)+64 ((#1)^12)&,4]};

N[soln,20]

Check

FullSimplify[x1^2+y1^2-1/.soln]

FullSimplify[Subtract@@{x1^2+(1-y1)^2,x2^2}/.soln]

FullSimplify[Subtract@@{(x1-x2)^2+(y1-1)^2,(x3-x2)^2+(x3-1)^2}/.soln]

FullSimplify[Subtract@@{(x2-1)^2,2(x3-1)^2}/.soln]

Figure

tris={
{{0,0},{x1,y1},{0,1}},
{{0,0},{x1,y1},{y1,x1}},
{{0,0},{y1,x1},{1,0}},
{{0,1},{x2,1},{x1,y1}},
{{x1,y1},{x2,1},{x3,x3}},
{{x2,1},{1,1},{x3,x3}},
{{x3,x3},{1,x2},{y1,x1}},
{{x3,x3},{1,1},{1,x2}},
{{x1,y1},{x3,x3},{y1,x1}},
{{1,0},{y1,x1},{1,x2}}
}/.soln;

?Join

colors={Green,Purple,Green,Red,Blue,Yellow,Blue,Red,SkyBlue,Yellow};
Show[Graphics[
{
Transpose[{colors,Polygon/@tris}],
Line[Append[#,First[#]]]&/@tris,
PointSize[.03],Point/@Union[Flatten[tris,1]]
},AspectRatio->Automatic]]