Square

Author

Eric W. Weisstein
August 27, 2010

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polygons/Square.nb.

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

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

Graphic

Show[Graphics[RegularPolygon[4],AspectRatio->Automatic]]

Graphics[{
Text[Style["a",Italic],#]&/@{{1.07,.5},{.47,-.07}},
White,EdgeForm[Black],Polygon[{{0,0},{1,0},{1,1},{0,1}}]
}]

Diagonals

square=Quadrilateral@@RegularPolygon[4,1,Pi/4];

Show[Graphics[{
{
Red,
d=Diagonals[square],
PerpSquare[d,.05,1],
EqualSideTicksAboutMidpoint[#,1,.03,0]&/@d
},
{
Blue,
EqualAngleDivisionTicks[#,2,1,.1,.03,0]&/@Partition[square[[1]],3,1,1]
},
square
}],AspectRatio->Automatic]

Properties

TableForm[RegularPolygonInformation[4]//Simplify,TableDepth->2]

Properties

ineq[x_,y_]:=Max[Abs[x],Abs[y]]≤a/2

Centroid

Assuming[a>0,Centroid[ineq,{x,y}]]

Assuming[a>0,RegionCentroid[Rectangle[{-1,-1}a/2,{1,1}a/2]]]

Area

area=Assuming[a>0,Area[ineq,{x,y}]]

Assuming[a>0,Simplify@Integrate[1,{x,y}∈Rectangle[{-1,-1}a/2,{1,1}a/2]]]

InertiaTensor

Assuming[a>0,AreaInertiaTensor[ineq,{x,y}]]

RadiiOfGyration

Assuming[a>0,FullSimplify[RadiiOfGyration[ineq[x,y],{x,y}]]]

GeneralizedDiameter

ineqs=And@@ineq@@@{{x1,y1},{x2,y2}}/.a->1

Maximize[{(x1-x2)^2+(y1-y2)^2,ineqs},{x1,x2,y1,y2}]//Timing

...takes forever...

ineq[x_,y_]:=-a/2<=x<=a/2&&-a/2≤y≤a/2

ineqs=And@@ineq@@@{{x1,y1},{x2,y2}}/.a->1

Maximize[{(x1-x2)^2+(y1-y2)^2,ineqs},{x1,x2,y1,y2}]//Timing

Inequality

<<Graphics`InequalityGraphics`
<<Utilities`Typesetting`

InequalityPlot[Abs[x]+Abs[y]<1,{x},{y}]

#[{Sqrt[x^2+y^2],Abs[x]+Abs[y]==1},{x,y}]&/@{Maximize,Minimize}

InequalityPlot[Max[Abs[x],Abs[y]]<1,{x},{y}]

#[{Sqrt[x^2+y^2],Max[Abs[x],Abs[y]]==1},{x,y}]&/@{Maximize,Minimize}

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
InequalityPlot[#<1,{x},{y},Ticks->None,
PlotLabel->TraditionalForm[#<1]]&/@{Abs[x]+Abs[y],Max[Abs[x],Abs[y]]}
]]]

ContourPlot[Max[Abs[x],Abs[y]]==1/2,{x,-.6,.6},{y,-.6,.6}]

Inscribed Square

v=Sqrt[2]Through[{Sin,Cos}[Pi(#+1/2)/2]]&/@Range[4];
v2=First[#]-.3Subtract@@#&/@Partition[v,2,1,1];
lines=Transpose[{RotateRight[v],v2}];
ineqs=Det[{{x,y,1},Append[First[#],1],Append[Last[#],1]}]<0&/@lines;

<<Graphics`InequalityGraphics`
<<Graphics`Colors`

Show[GraphicsArray[{
Graphics[{
ClosedLine[v],
InequalityPlot[And@@ineqs,{x},{y},DisplayFunction->Identity,Fills->Yellow][[1]],
Line/@lines
},AspectRatio->Automatic],
Graphics[{
ClosedLine[v],
Line/@lines
},AspectRatio->Automatic]}
]]