Cylindrical Algebraic Decomposition

Author

Eric W. Weisstein
April 18, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Algebra/CylindricalAlgebraicDecomposition.nb.

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

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

Initialization

<<Graphics`InequalityGraphics`
<<Calculus`Integration`
<<DiscreteMath`Combinatorica`

Circle

circle=CylindricalDecomposition[x^2+y^2<1,{x,y}]

Integrate[1,{x,-1,1},{y,-Sqrt[1-x^2],Sqrt[1-x^2]}]

v5

Integrate[Boole[x^2+y^2<1],{y,-∞,∞},{x,-∞,∞}]

v6

Integrate[Boole[x^2+y^2<1],{y,-∞,∞},{x,-∞,∞}]

Hemisphere

CylindricalDecomposition[{x^2+y^2+z^2<1,z>0},{x,y,z}]

Integrate[1,{x,-1,1},{y,-(Sqrt[1-(x^2)]),(Sqrt[1-(x^2)])},{z,0,(Sqrt[1-(x^2)-(y^2)])}]

v5

Integrate[Boole[x^2+y^2+z^2<1∧z>0],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

v6

Integrate[Boole[x^2+y^2+z^2<1∧z>0],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Lens

Special Position

v5

p={{0,0},{1,0}};

ineqs=And@@(Function[v,v.v][{x,y}-#]<1&/@p)

<<Graphics`InequalityGraphics`

<<Graphics`InequalityGraphics`

Show[Graphics[{
InequalityPlot[ineqs,{x,-2,2},{y,-2,2},DisplayFunction->Identity,Ticks->None][[1]],
Circle[#,1]&/@p,
PointSize[.04],Point/@p
},
AspectRatio->Automatic]]

Integrate[Boole[(x^2)+(y^2)<1&&(((-1+x))^2)+(y^2)<1],{x,-∞,∞},{y,-∞,∞}]

v6

Integrate[Boole[(x^2)+(y^2)<1&&(((-1+x))^2)+(y^2)<1],{x,-∞,∞},{y,-∞,∞}]

Arbitrary Position

v5

cad=CylindricalDecomposition[{x^2+y^2<1,(x-x1)^2+(y-y1)^2<r^2},{x,y}]

cad=CylindricalDecomposition[{x^2+y^2<1,x^2+(y-y0)^2<r^2},{x,y,y0,r}]

Integrate[Boole[%],{x,-∞,∞},{y,-∞,∞}]

v6

Integrate[Boole[x^2+y^2<1&&(x-x1)^2+(y-y1)^2<r^2],{x,-∞,∞},{y,-∞,∞}]

Quadrifolium

p=Table[{Cos[#],Sin[#]}&[2Pi n/4],{n,0,3}]

ineqs=(Function[v,v.v][{x,y}-#]<1&/@p)

<<DiscreteMath`Combinatorica`

Or@@And@@@KSubsets[ineqs,2]

InequalityPlot[Or@@And@@@KSubsets[ineqs,2],{x,-2,2},{y,-2,2}]

Show[GraphicsArray[{
Graphics[{
InequalityPlot[#,{x,-2,2},{y,-2,2},DisplayFunction->Identity][[1]]&/@KSubsets[ineqs,2],
Circle[#,1]&/@p},
Ticks->None,PlotRange->All,DisplayFunction->$DisplayFunction,AspectRatio->Automatic],
Show[InequalityPlot[#,{x,-2,2},{y,-2,2},DisplayFunction->Identity]&/@KSubsets[ineqs,2],PlotRange->All,Ticks->None]
}]]

cad=CylindricalDecomposition[Take[ineqs,2],{x,y}]

4Integrate[Boole[cad],{x,-∞,∞},{y,-∞,∞}]

v6

Integrate[Boole[Or@@And@@@KSubsets[ineqs,2]],{x,-∞,∞},{y,-∞,∞}]

ReuleauxTriangle

p={0,1/(2Sqrt[3])}+#&/@Table[{Cos[#],Sin[#]}&[2Pi(n-1/4)/3]/Sqrt[3],{n,0,2}]

Simplify[(#[[1]]-#[[2]]).(#[[1]]-#[[2]])&/@KSubsets[p,2]]

Show[Graphics[{PointSize[.08],Point/@p},AspectRatio->Automatic],PlotRange->All]

ineqs=And@@(Function[v,v.v][{x,y}-#]<1&/@p)

Show[Graphics[{
InequalityPlot[ineqs,{x,-2,2},{y,-2,2},Ticks->None,DisplayFunction->Identity][[1]],
Circle[#,1]&/@p},
AspectRatio->Automatic],DisplayFunction->$DisplayFunction]

v5

cad=CylindricalDecomposition[ineqs,{x,y}]

Integrate[Boole[cad],{y,-∞,∞},{x,-∞,∞}]

N[%]

r1=-Root[1-56 (y^2)+16 (y^4)-8 ((#1)^2)+32 (y^2) ((#1)^2)+16 ((#1)^4)&,2];
r2=Root[1-56 (y^2)+16 (y^4)-8 ((#1)^2)+32 (y^2) ((#1)^2)+16 ((#1)^4)&,3];

NIntegrate[#,{y,(1/2) (-2+(Sqrt[3])),0}]&/@{r1,r2}

NIntegrate[2r1,{y,(1/2) (-2+(Sqrt[3])),0}]

ToRadicals[r1]

Roots[1-56 (y^2)+16 (y^4)-8 (x^2)+32 (y^2) (x^2)+16 (x^4)==0,x]

i2=2Integrate[(1/2) (Sqrt[1+4 (Sqrt[3]) y-4 (y^2)]),{y,(1/2) (-2+(Sqrt[3])),0}]

Simplify[-((Sqrt[3])/4)+(π/3)+i2]

as=Simplify[1/2(#-Sin[#])&[Pi/3]]

at =1/4 Sqrt[3]

Together[3as+at]

N[%,20]

v6

Integrate[Boole[ineqs],{x,-∞,∞},{y,-∞,∞}]

Sphere

CylindricalDecomposition[x^2 + y^2+z^2 < 1,{x,y,z}]

Integrate[1,{x,-1,1},{y,-(Sqrt[1-(x^2)]),(Sqrt[1-(x^2)])},{z,-(Sqrt[1-(x^2)-(y^2)]),(Sqrt[1-(x^2)-(y^2)])}]

v5

Integrate[Boole[x^2+y^2+z^2<1],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

v6

Integrate[Boole[x^2+y^2+z^2<1],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Steinmetz 2-Solid

Steinmetz2=CylindricalDecomposition[x^2+y^2<1&&-2<z<2&&y^2+z^2<1&&-2<x<2,{x,y,z}]

Integrate[1,{x,-1,1},{y,-Sqrt[1-x^2],Sqrt[1-x^2]},
{z,-Sqrt[1-y^2],Sqrt[1-y^2]}]

v5

Integrate[1 Boole[x^2+y^2<1&&y^2+z^2<1],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

v6

Integrate[1 Boole[x^2+y^2<1&&y^2+z^2<1],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Steinmetz 2-Solid, radii a and b

CylindricalDecomposition[x^2+y^2<a^2∧y^2+z^2<b^2,{x,y,z,a,b}]

Integrate[1 Boole[x^2+y^2<a^2&&y^2+z^2<a^2],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Integrate[1 Boole[x^2+y^2<a^2&&y^2+z^2<b^2],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Steinmetz 3-Solid

Steinmetz3=FullSimplify[CylindricalDecomposition[x^2+y^2<1&&-2<z<2&&
y^2+z^2<1&&-2<x<2&&
x^2+z^2<1&&-2<y<2,
{x,y,z}]]

v5

Integrate[1 Boole[x^2+y^2<1&&y^2+z^2<1&&x^2+z^2<1],
{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

v6

Integrate[1 Boole[x^2+y^2<1&&y^2+z^2<1&&x^2+z^2<1],
{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]

Steinmetz 4-Solid

12(2Sqrt[2]-Sqrt[6])

Trifolium

p=Table[{Cos[#],Sin[#]}&[2Pi(n-1/4)/3],{n,0,2}]

<<DiscreteMath`Combinatorica`

ineqs=Or@@And@@@KSubsets[Function[v,v.v][{x,y}-#]<1&/@p,2]

InequalityPlot[ineqs,{x,-2,2},{y,-2,2},PlotRange->All,Ticks->None]

Show[GraphicsArray[{
Graphics[{
InequalityPlot[#,{x,-2,2},{y,-2,2},DisplayFunction->Identity][[1]]&/@KSubsets[ineqs,2],
Circle[#,1]&/@p},
Ticks->None,PlotRange->All,DisplayFunction->$DisplayFunction,AspectRatio->Automatic],
Show[InequalityPlot[#,{x,-2,2},{y,-2,2},DisplayFunction->Identity]&/@KSubsets[ineqs,2],PlotRange->All,Ticks->None]
}]]

v5

Integrate[Boole[ineqs],{x,-∞,∞},{y,-∞,∞}]

FullSimplify[%24]

v6

Integrate[Boole[ineqs],{x,-∞,∞},{y,-∞,∞}]

...crash...