Diamond

Author

Eric W. Weisstein
July 31, 2014

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Laminae/Diamond.nb.

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

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

Definitions

ineq=Abs[x]/a+Abs[y]/b≤1;

implreg=ImplicitRegion[ineq,{x,y}];

reg=Polygon[{{-a,0},{0,-b},{a,0},{0,b}}];

reg2=Parallelogram[{-a,0},{{a,b},{a,-b}}];

assum=a>0&&b>0;

Plots

Diagram

LaminaData["FilledDiamond","Diagram"]

DiscretizeRegion

Block[{a=1,b=.7},Show[DiscretizeRegion[reg],ImageSize->Small,Axes->True]]

Block[{a=1,b=.7},Show[DiscretizeRegion[reg2],ImageSize->Small,Axes->True]]

Block[{a=1,b=.7},Show[DiscretizeRegion[implreg],ImageSize->Small]]

RegionPlot

Block[{a=1,b=.7},RegionPlot[ineq,{x,-a,a},{y,-b,b},Frame->False,ImageSize->Small,AspectRatio->Automatic]]

SemialgebraicRegionPlot

Block[{a=1,b=.7},Region`SemialgebraicRegionPlot[implreg,{{-a,a},{-b,b}},Frame->False,ImageSize->Small]]

Plots

PlaneCurve

V5

<<Graphics`ImplicitPlot`

Internal`DeactivateMessages[ImplicitPlot[Abs[x]+Abs[y]==1,{x,-1,1},PlotStyle->Red,AxesLabel->TraditionalForm/@{x,y},PlotLabel->TraditionalForm[Abs[x]+Abs[y]==1]]
]

Shaded Curve

r2=1;
dr=.02;
r1=dr;
Show[GraphicsArray[{
Graphics[
{Red,
Line[{{0,r},{r,0},{0,-r},{-r,0},{0,r}}/.r->1]
},
AspectRatio->Automatic,Axes->True,Ticks->None
],
Graphics[{
Thickness[.015],
Table[
{Hue[(r-r1)/(r2-r1)],Line[{{0,r},{r,0},{0,-r},{-r,0},{0,r}}]},{r,r1,r2,dr}]
},
PlotRange->All,
AspectRatio->Automatic,Axes->True,Ticks->None
]
}]]

ContourPlot

V6

ContourPlot[eqn[##][x,y]==0,{x,-1,1},{y,-1,1},AspectRatio->Automatic]&@@@{{1,1},{1,.5},{.5,1}}

Counts

ad={x,y}/.Table[{ToRules@Reduce[Abs[x]+Abs[y]<=n,{x,y},Integers]},{n,0,10}];

Length/@ad

Table[2n(n+1)+1,{n,0,10}]

Figure

square[{x_,y_}]:=Line[({x,y}-1/2+#)&/@{{0,0},{1,0},{1,1},{0,1},{0,0}}]

Show[GraphicsArray[Table[Graphics[square/@ad[[n]],AspectRatio->Automatic],{n,5}]],ImageSize->500]

Equation

Abs[x]/a+Abs[y]/b==1

y^2/b^2=(1-Abs[x]/a)^2=1-2Abs[x]/a^2+x^2/a^2

y^2/b^2-x^2/a^2-1==-2Abs[x]/a

(y^2/b^2-x^2/a^2-1)^2==4x^2/a^2//TraditionalForm

AlgebraicDegree[(y^2/b^2-x^2/a^2-1)^2-4x^2/a^2,{x,y}]

MakeBoxes[label[a_,b_],TraditionalForm]:=RowBox[{RowBox[{"a","==",a}],","," ",RowBox[{"b","==",b}]}]

GraphicsGrid[{Function[{a,b},ContourPlot[(y^2/b^2-x^2/a^2-1)^2-4x^2/a^2==0,{x,-3,3},{y,-3,3},ContourStyle->Red,PlotLabel->label[a,b]]]@@@{{1,1},{2,1},{1,2}}},ImageSize->400]

Block[{a=1,b=2},ContourPlot[(y^2/b^2-x^2/a^2-1)^2-4x^2/a^2==0,{x,-3,3},{y,-3,3}]]

Properties

ArcLength

Norm[{a,0}-{0,b}]

Area

Area V10.0.0

Area[reg]

Assuming[assum,Simplify@Area[reg2]]

Assuming[assum,Simplify@Area[implreg]]

Area V10.0.1

$Version

Area[reg]

Assuming[assum,Simplify@Area[reg2]]

Assuming[assum,Simplify@Area[implreg]]

Integrate

Assuming[assum,Integrate[Boole[ineq],{x,-∞,∞},{y,-∞,∞}]]

Assuming[assum,Area[Abs[x]/a+Abs[y]/b<1,{x,y}]]

RegionMeasure V10.0.0

Assuming[assum,RegionMeasure[reg]]

Assuming[assum,Simplify@RegionMeasure[reg2]]

Assuming[assum,Simplify@RegionMeasure[implreg]]

RegionMeasure V10.0.1

Assuming[assum,RegionMeasure[reg]]

Assuming[assum,Simplify@RegionMeasure[reg2]]

Assuming[assum,Simplify@RegionMeasure[implreg]]

AreaInertiaTensor

Assuming[a>0&&b>0,AreaInertiaTensor[Abs[x]/a+Abs[y]/b<1,{x,y}]]

Eigenvalues[{{((a (b^3))/3),0},{0,(((a^3) b)/3)}}]

Centroid

Integrate

Assuming[a>0&&b>0,Centroid[Abs[x]/a+Abs[y]/b<1,{x,y}]]

RegionCentroid

Assuming[assum,RegionCentroid[reg]]

Assuming[assum,Simplify@RegionCentroid[reg2]]

Assuming[assum,RegionCentroid[implreg]]

Convex

ConvexRegionQ[reg/.{a->1,b->2}]

ConvexRegionQ[reg]

TimeConstrained[ConvexRegionQ[implreg],600]//Timing

Curvature

FullSimplify[Curvature[eqn[a,b][x,y]/.Abs[c_]:>Sqrt[c^2],{x,y}],(x|y)∈Reals]

Incircle

y-0==((b-0)/(0-a))(x-a)

Simplify[Minimize[{x^2+y^2,y==-((b (-a+x))/a)},{x,y}],a>0&&b>0]

FullSimplify[((p q)/(2(Sqrt[(p^2)+(q^2)])))/.{p->2a,q->2b},a>0&&b>0]

Manipulate[Show[{ContourPlot[(y^2/b^2-x^2/a^2-1)^2-4x^2/a^2==0,{x,-3,3},{y,-3,3}],
Graphics[{PointSize[.02],Point[{((a (b^2))/((a^2)+(b^2))),(((a^2) b)/((a^2)+(b^2)))}],Line[{{0,0},{((a (b^2))/((a^2)+(b^2))),(((a^2) b)/((a^2)+(b^2)))}}],
Circle[{0,0},((a b)/(Sqrt[(a^2)+(b^2)]))]
}],
Plot[-((b (-a+x))/a),{x,0,a},PlotStyle->Red]}],{{a,1},0,2},{{b,.5},0,2}]

RadiiOfGyration

Assuming[a>0&&b>0,FullSimplify[RadiiOfGyration[Abs[x]/a+Abs[y]/b<1,{x,y}]]]

Singular Points

SingularPoints[Abs[x]/a+Abs[y]/b-1/.Abs[x_]:>Sqrt[x^2],{x,y}]

D[Abs[x]/a+Abs[y]/b-1/.Abs[x_]:>Sqrt[x^2],#]&/@{x,y}

Abs[x]/a+Abs[y]/b-1/.Abs[x_]:>Sqrt[x^2]

Simplify[(x/(a (Sqrt[(x^2)])))==(y/(b (Sqrt[(y^2)])))==-1+((Sqrt[(x^2)])/a)+((Sqrt[(y^2)])/b),(x|y)∈Reals]

Solve[(x/(a Abs[x]))==(y/(b Abs[y]))==-1+((Abs[x])/a)+((Abs[y])/b)==0,{x,y}]