Voronoi - Diagramm

by Andreas Kriegl, 2012.12.19

Initialization

tb=5;
rb=6;
lb=-rb;
bb=-tb; (* bounding box boundaries *)

Standard Voronoi-Diagramm

Parabel mit Brennpunkt und horizontale Leitlinie

normal[x_]:={-x[[2]],x[[1]]}; (* left-turned normal *)
parabel[q_,s_]:= Which[ 
s+0.05<q[[2]],
Append[Table[{q[[1]]+x^3,(x^6+q[[2]]^2-s^2)/(2(q[[2]]-s))},{x,-(rb-lb)^(1/3),(rb-lb)^(1/3),0.05}],
{q[[1]]-(rb-lb),((rb-lb)^2+q[[2]]^2-s^2)/(2(q[[2]]-s))}],
s<=q[[2]],
{q,{q[[1]],tb}},
s>q[[2]],{}
] (* parabola with focus q and directrix y=s *)

Clear[t]
Solve[{ (x-px)^2== 2(py-t)*(y-(py+t)/2),x==(px+qx)/2+λ(py-qy),y==(py+qy)/2+λ(qx-px)},{x,y,λ}]//FullSimplify
(* Intersection of two such parabolas *)

Beruehrkreis

BeruehrKreis[p1_,p2_,t_]:=Module[{px,py,qx,qy,λ,m,G,r},
px=p1[[1]];
py=p1[[2]];
qx=p2[[1]];
qy=p2[[2]];
If[py≠qy && t< py && t <qy,
m:={(px+qx)/2+λ(py-qy),(py+qy)/2+λ(qx-px)};
r:=Norm[m-p1];
λ=((-(px-qx) (py+qy-2 t)+2 (Sqrt[((((px-qx))^2)+(((py-qy))^2)) (py-t) (qy-t)]))/(2 (((py-qy))^2)));

G={Circle[m,r],Point[m],Line[{m,m-{0,r}}],Point[m-{0,r}]};
λ=((-(px-qx) (py+qy-2 t)-2 (Sqrt[((((px-qx))^2)+(((py-qy))^2)) (py-t) (qy-t)]))/(2 (((py-qy))^2)));
G=Append[G,{Circle[m,r],Point[m],Line[{m,m-{0,r}}],Point[m-{0,r}]}]
,
{}
]
] (* circle through p1 and p2 tangent to sweepline y=t *)

Streckensymmetrale zu zwei Punkte

symmetrale[q1_,q2_]:=
If[q1≠ q2,
Line[{ (q1+q2)/2+(rb+tb)*normal[q2-q1]/Norm[q2-q1],(q1+q2)/2-(rb+tb)*normal[q2-q1]/Norm[q2-q1]}],
{}
]

Kante des Voronoi-Diagramms

segment[p1_,p2_,rest_]:=Block[
{top,bot,i,det,λ,n,p3},
top=80;
bot=-80;
n=normal[p2-p1];
For[i=1,i≤Length[rest],i++,
p3=rest[[i]];
det=n.(p3-p1);
If[det ≠ 0,
λ=(p2-p3).(p1-p3)/(2*det);
If[det>0,top=Min[top,λ],bot=Max[bot,λ]],
(* kolinear *)
If[Norm[p3-(p1+p2)/2]<Norm[(p2-p1)/2],bot=top]
]
];
If[top>bot,
{(p1+p2)/2+ bot*n,(p1+p2)/2+top*n},{}
]
] (* edge of Voronoi-diagram between cells V(p1) and V(p2), rest are the remaining sites *)

Kante des Anti-Voronoi-Diagramms

antisegment[p1_,p2_,rest_]:=Block[
{top,bot,i,det,λ,n,p3},
top=80;
bot=-80;
n=normal[p2-p1];
For[i=1,i≤Length[rest],i++,
p3=rest[[i]];
det=n.(p3-p1);
If[det ≠ 0,
λ=(p2-p3).(p1-p3)/(2*det);
If[det<0,top=Min[top,λ],bot=Max[bot,λ]],
(* kolinear *)
If[Norm[p3-(p1+p2)/2]<Norm[(p2-p1)/2],bot=top]
]
];
If[top>bot,
{(p1+p2)/2+ bot*n,(p1+p2)/2+top*n},{}
]
] (* edge of Voronoi-diagram between cells V(p1) and V(p2), rest are the remaining sites *)

Kreis-Event

Clear[c]
c[p1_,p2_,p3_,rest_]:=Module[{i,det,λ,n,r,m},
n=normal[p2-p1];
det=n.(p3-p1);
λ=(p2-p3).(p1-p3)/(2*det);
m=(p1+p2)/2+ λ*n;
r=Norm[p1-m];
i=1;
While[i≤Length[rest] && r≤Norm[rest[[i]]-m],i++];
If[i≤Length[rest],{},{Circle[m,r],Line[{m,m-{0,r}}],Point[m],Point[m-{0,r}]}]
] (* circle through p1, p2, p3 containing no other sites of rest *)

c[{-1,0},{0,1},{1,0},{{0,0}}]
c[{-1,0},{0,1},{1,0},{{1,1}}]

Plane-Sweep (Animation)

Add Points using Ctrl - Alt - Click

t=tb; pts={{0.3,1.3},{0.1,-2},{3.3,-0.6},{-2.5,0.4},{-5,0.7},{-4,-1.5},{1.1,2.9},{-2.2,3.0}} (* 7 punktig *)

t=tb;
Dynamic[pts] (* show current value of pts *)
Manipulate[
Module[{i,j},
Graphics[{
GrayLevel[0.8],
RGBColor[0.5,0.8,1],
Opacity[0.5],
Table[Polygon[parabel[pts[[i]],t]],{i,1,Length[pts]}], (* Area above Parabolas *)
GrayLevel[0],
Opacity[1],
Table[Line[parabel[pts[[i]],t]],{i,1,Length[pts]}], (* Parabolas *)
RGBColor[1,0.5,1],
GrayLevel[0.7],
If[MitSymmetralen,
Table[symmetrale[pts[[i]],pts[[j]]],{i,1,Length[pts]},{j,i+1,Length[pts]}],
{}
], (* Streckensymmetralen *)
Thickness[0.005],
GrayLevel[0],
If[MitVoronoi,
Table[
Line[segment[pts[[i]],pts[[j]],Drop[Drop[pts,{j}],{i}]]],
{i,1,Length[pts]},{j,i+1,Length[pts]}
],
{}
],
RGBColor[1,0,0],
Thickness[0.001],
If[MitKreisEvent,
Table[
c[pts[[i]],pts[[j]],pts[[k]],Drop[Drop[Drop[pts,{k}],{j}],{i}]],
{i,1,Length[pts]},{j,i+1,Length[pts]},{k,j+1,Length[pts]}
],
{}
],
Thickness[0.005],
Line[{{lb,t},{rb,t}}] (* Sweepline *)
},PlotRange->{{lb,rb},{bb,tb}},ImageSize->600]],
{{pts,{{0,0}}},Locator,LocatorAutoCreate->True},
{{MitSymmetralen,True},{False,True},ControllType->Setter,ControlPlacement->Top},
{MitVoronoi,{False,True},ControllType->Setter,ControlPlacement->Top},
{MitKreisEvent,{False,True},ControllType->Setter,ControlPlacement->Top},
{{t,tb},bb,tb,ControlType->VerticalSlider,ControlPlacement->Left, SaveDefinitions->True},LocalizeVariables->False
]

Plane-Sweep with first 3 sites colored and tangent circle (Animation)

t=0; pts0={{-2,0},{0,2},{1,1}};

e[1]={0.9,0.2,0}; (* Red site *)
e[2]={0,0.8,0}; (* Green site *)
e[3]={0,0.2,1}; (* Blue site *)
e[n_]:={0.5,0.5,0.5}/; n≥4; (* Gray remaining sites *)
Dynamic[pts0] (* shows current value of pts0 *)
Manipulate[
Module[{λ,μ},
(* l:=Min[3, Length[pts0]]; *)
l:=Length[pts0];
Graphics[{
RGBColor[0.7,0.9,1],
Opacity[0.5],
Table[Polygon[parabel[pts0[[i]],t]],{i,1,Length[pts0]}], (* Area above Parabolas *)
Opacity[1],
If[MitSymmetralen,
Table[{Apply[RGBColor,2*(e[i]+e[j])/3],symmetrale[pts0[[i]],pts0[[j]]]},{i,1,l},{j,i+1,l}],
{}
], (* Streckensymmetralen *)
Thickness[0.005],
GrayLevel[0],
If[MitVoronoi,
Table[
Line[segment[pts0[[i]],pts0[[j]],Drop[Drop[pts0,{j}],{i}]]],
{i,1,Length[pts0]},{j,i+1,Length[pts0]}
],
{}
], (* Segments of Voronoi-Diagram *)
PointSize[0.02],
Thickness[0.005],
Table[{Apply[RGBColor,e[i]],Point[pts0[[i]]],
Line[parabel[pts0[[i]],t]]},{i,1,Length[pts0]}], (* Parabolas *)
RGBColor[1,0.5,0.5],
Thickness[0.001],
PointSize[0.02],
If[MitKreisEvent,
Table[
c[pts0[[i]],pts0[[j]],pts0[[k]],Drop[Drop[Drop[pts0,{k}],{j}],{i}]],
{i,1,Length[pts0]},{j,i+1,l},{k,j+1,l}
],
{}
], (* All potential circle events *)
GrayLevel[0.5],
If[MitBeruehrKreis,
If[l≥2,BeruehrKreis[pts0[[1]],pts0[[2]],t],{}],
{}
], (* circle through first two points tangent to sweep line *)
RGBColor[1,0,0.5,0.5],
Thickness[0.005],
Line[{{lb,t},{rb,t}}] (* sweep line *)
},PlotRange->{{lb,rb},{bb,tb}},ImageSize->600]],
{{pts0,{{0,0}}},Locator,LocatorAutoCreate->True}, 
{{MitSymmetralen,True},{False,True},ControlPlacement->Top},
{MitVoronoi,{False,True},ControlPlacement->Top},
{MitKreisEvent,{False,True},ControlPlacement->Top},
{MitBeruehrKreis,{False,True},ControlPlacement->Top},
{{t,tb},bb,tb,ControlType->VerticalSlider,ControlPlacement->Left} ,
LocalizeVariables->False,SaveDefinitions->True
]

t=tb; pts0=2*{{-1,0},{0,1},{1,0},{-0.5,-0.5}} ;(* geschlucktes Kreisevent *)

t=tb; pts0=2*{{-1,0},{0,1},{1,0},{-0.74,-0.93}} ;(* nicht geschlucktes Kreisevent *)

t=tb; pts0={{0,-1},{1,0},{0,1}}; (* tiefster und zwei weitere am Kreis *)

t=tb; ψ=-2π/7;pts0=Table[4*{-Cos[ψ+2π i/6],Sin[ψ+2π i/6]},{i,0,2}]//N; (* 3 Punkte auf Kreis im Urzeigersinn *)

t=tb; ψ=-2π/7;pts0=Table[4*{Cos[ψ+2π i/6],Sin[ψ+2π i/6]},{i,0,2}]//N; (* 3 Punkte auf Kreis gegen Urzeigersinn *)

t=tb; pts0={{-1,1},{0,3},{0.6,1}}; 
(* unbeschraenkte Kanten *)

t=tb; pts0=Table[2{Sin[6-2i],-Cos[6-2i]},{i,1,3}]; (* Standort unterhalb Knickpunkt *)

Anti-Voronoi-Diagramm

t=tb; pts0={{-1,0},{1,0},{0,Sqrt[2]}}

e[1]={0.9,0.2,0}; (* Red site *)
e[2]={0,0.8,0}; (* Green site *)
e[3]={0,0.2,1}; (* Blue site *)
e[n_]:={0.5,0.5,0.5}/; n≥4; (* Gray remaining sites *)
Dynamic[pts0] (* shows current value of pts0 *)
Manipulate[
Module[{λ,μ},
(* l:=Min[3, Length[pts0]]; *)
l:=Length[pts0];
Graphics[{
RGBColor[0.7,0.9,1],
Opacity[0.5],
Table[Polygon[parabel[pts0[[i]],t]],{i,1,Length[pts0]}], (* Area above Parabolas *)
Opacity[1],
If[MitSymmetralen,
Table[{Apply[RGBColor,2*(e[i]+e[j])/3],symmetrale[pts0[[i]],pts0[[j]]]},{i,1,l},{j,i+1,l}],
{}
], (* Streckensymmetralen *)
Thickness[0.005],
GrayLevel[0],
If[MitVoronoi,
Table[
Line[segment[pts0[[i]],pts0[[j]],Drop[Drop[pts0,{j}],{i}]]],
{i,1,Length[pts0]},{j,i+1,Length[pts0]}
],
{}
], (* Segments of Voronoi-Diagram *)
RGBColor[0,0,0.8],
If[MitAntiVoronoi,
Table[
Line[antisegment[pts0[[i]],pts0[[j]],Drop[Drop[pts0,{j}],{i}]]],
{i,1,Length[pts0]},{j,i+1,Length[pts0]}
],
{}
], (* Segments of Voronoi-Diagram *)
GrayLevel[0],
PointSize[0.02],
Thickness[0.005],
Table[{Apply[RGBColor,e[i]],Point[pts0[[i]]],
Line[parabel[pts0[[i]],t]]},{i,1,Length[pts0]}], (* Parabolas *)
RGBColor[1,0.5,0.5],
Thickness[0.001],
PointSize[0.02],
If[MitKreisEvent,
Table[
c[pts0[[i]],pts0[[j]],pts0[[k]],Drop[Drop[Drop[pts0,{k}],{j}],{i}]],
{i,1,Length[pts0]},{j,i+1,l},{k,j+1,l}
],
{}
], (* All potential circle events *)
GrayLevel[0.5],
If[MitBeruehrKreis,
If[l≥2,BeruehrKreis[pts0[[1]],pts0[[2]],t],{}],
{}
], (* circle through first two points tangent to sweep line *)
RGBColor[1,0,0.5,0.5],
Thickness[0.005],
Line[{{lb,t},{rb,t}}] (* sweep line *)
},PlotRange->{{lb,rb},{bb,tb}},ImageSize->600]],
{{pts0,{{0,0}}},Locator,LocatorAutoCreate->True}, 
{{MitSymmetralen,True},{False,True},ControlPlacement->Top},
{MitVoronoi,{False,True},ControlPlacement->Top},
{MitAntiVoronoi,{False,True},ControlPlacement->Top},
{MitKreisEvent,{False,True},ControlPlacement->Top},
{MitBeruehrKreis,{False,True},ControlPlacement->Top},
{{t,tb},bb,tb,ControlType->VerticalSlider,ControlPlacement->Left} ,
LocalizeVariables->False,SaveDefinitions->True
]