Revisions to Is it possible to draw this figure using Mathematica?

misprint in first line (vvoronoi instead of voronoi)

Source Link

edited Jun 9, 2017 at 16:03

16k
2
33
73

vvoronoi[pts_]voronoi[pts_] := ListDensityPlot[Append[#, 0]&/@ pts, InterpolationOrder-> 0, 
                                                       Frame -> False]

pts = RandomReal[{0, 256}, {20, 2}];
cp = Cases[Normal@voronoi[pts],  Polygon[a_, ___] :> Polygon[a], ∞];
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

vvoronoi[pts_] := ListDensityPlot[Append[#, 0]&/@ pts, InterpolationOrder-> 0, 
                                                       Frame -> False]

pts = RandomReal[{0, 256}, {20, 2}];
cp = Cases[Normal@voronoi[pts],  Polygon[a_, ___] :> Polygon[a], ∞];
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

voronoi[pts_] := ListDensityPlot[Append[#, 0]&/@ pts, InterpolationOrder-> 0, 
                                                       Frame -> False]

pts = RandomReal[{0, 256}, {20, 2}];
cp = Cases[Normal@voronoi[pts],  Polygon[a_, ___] :> Polygon[a], ∞];
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

deleted 129 characters in body

Source Link

edited Mar 24, 2016 at 5:27

Dr. belisarius

116.1k
13
204
454

voronoi[pts_]vvoronoi[pts_] := ListDensityPlot[Append[#, 0] & 0]&/@ pts, InterpolationOrder -> 0, 
                  BoundaryStyle -> Black, Frame -> False, ColorFunction -> (White &)]

pts = RandomReal[{0, 256}, {20, 2}];
cp =  Cases[Normal@voronoi[pts], Polygon[__], ∞] /. HoldPattern[VertexColors -> ___] :> 
                                                          Frame -> False]

pts = RandomReal[{0, 256}, {20, 2}];
cp = Cases[Normal@voronoi[pts],  Polygon[a_, ___] Sequence:> @@Polygon[a], {};∞];
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

voronoi[pts_] := ListDensityPlot[Append[#, 0] & /@ pts, InterpolationOrder -> 0, 
                  BoundaryStyle -> Black, Frame -> False, ColorFunction -> (White &)]

pts = RandomReal[{0, 256}, {20, 2}];
cp =  Cases[Normal@voronoi[pts], Polygon[__], ∞] /. HoldPattern[VertexColors -> ___] :> 
                                                                       Sequence @@ {};
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

vvoronoi[pts_] := ListDensityPlot[Append[#, 0]&/@ pts, InterpolationOrder-> 0, 
                                                       Frame -> False]

pts = RandomReal[{0, 256}, {20, 2}];
cp = Cases[Normal@voronoi[pts],  Polygon[a_, ___] :> Polygon[a], ∞];
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

added 28 characters in body

Source Link

edited Mar 24, 2016 at 5:08

Dr. belisarius

116.1k
13
204
454

voronoi[pts_] := ListDensityPlot[Append[#, 0] & /@ pts, InterpolationOrder -> 0, 
                  BoundaryStyle -> Black, Frame -> False, ColorFunction -> (White &)]

pts = RandomReal[{0, 256}, {20, 2}];
cp =  Cases[Normal@voronoi[pts], Polygon[__], ∞] /. HoldPattern[VertexColors -> ___] :> 
                                                                       Sequence @@ {};
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[LineGraphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][ t]#2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                    a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

voronoi[pts_] := ListDensityPlot[Append[#, 0] & /@ pts, InterpolationOrder -> 0, 
                  BoundaryStyle -> Black, Frame -> False, ColorFunction -> (White &)]

pts = RandomReal[{0, 256}, {20, 2}];
cp =  Cases[Normal@voronoi[pts], Polygon[__], ∞] /. HoldPattern[VertexColors -> ___] :> 
                                                                       Sequence @@ {};
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[Line /@ Join @@@ (Transpose /@ (MapThread[
        Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][ t], 
              {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                    a_[t] :> a /@ Range[0, 1, .03]))]

Mathematica graphics

voronoi[pts_] := ListDensityPlot[Append[#, 0] & /@ pts, InterpolationOrder -> 0, 
                  BoundaryStyle -> Black, Frame -> False, ColorFunction -> (White &)]

pts = RandomReal[{0, 256}, {20, 2}];
cp =  Cases[Normal@voronoi[pts], Polygon[__], ∞] /. HoldPattern[VertexColors -> ___] :> 
                                                                       Sequence @@ {};
cp1 = cp /. Polygon[a___] :> a;
ms = Mean /@ cp1;

Graphics[{EdgeForm[Black], FaceForm[White], cp, 
         Line /@ Join @@@ (Transpose /@ (MapThread[
         Table[BSplineFunction[Join[Join[#1, #1][[i ;; i + 1]], #2]][t], 
               {i, 1, Length@#1}] &, {cp1, List /@ ms}, 1] /. 
                                                 a_[t] :> a /@ Range[0, 1, .03]))}]

Mathematica graphics

added 28 characters in body

Source Link

edited Mar 24, 2016 at 5:03

Dr. belisarius

116.1k
13
204
454

Loading

added 63 characters in body

Source Link

edited Mar 24, 2016 at 2:50

Dr. belisarius

116.1k
13
204
454

Loading

Source Link

created Mar 23, 2016 at 22:28

Dr. belisarius

116.1k
13
204
454

Loading

Stack Exchange Network

Return to Answer