Tag Info

New answers tagged

6

Of course it's not good that Mathematica forget initial points for Voronoi mesh. May be it is a bug. However one can easily recover all generating points directly from the mesh. It's interesting from theoretical point of view. Let's consider one point of the Voronoi mesh There are three pairs of equal angles $\alpha,\beta,\gamma$ around this point. ...


9

Here's a direct implementation of Rahul Narain's algorithm using Version 10 functions (no attempt has been made to optimize): SeedRandom[80] pts = RandomReal[5, {50, 2}]; vor = VoronoiMesh[pts, {{0, 5}, {0, 5}}]; Let's pick a point to draw it's largest circle: poi = pts[[9]]; The point in red is our point of interest: ...


5

While I await other answers, here is the RegionMember approach I mentioned: cellSite[p_, reg_] := With[{rm = RegionMember[reg]}, {Point@Flatten@Pick[p, rm[p]], reg}] Then: cs = cellSite[pts, #] & /@ MeshPrimitives[vor, 2]; Visualize: GraphicsGrid[ Partition[Graphics[{GraphicsComplex[MeshCoordinates[vor], {Thick, Blue, MeshCells[vor, 1], ...


3

You can fit your data to a plane surface and use ComponentMeasurements to detect the bumps on the surface. data3Ds = Round[data3D, 0.02] // DeleteDuplicates; plane = LinearModelFit[data3D, {x, y}, {x, y}] data3Dp = ParallelMap[{#[[1]], #[[2]], #[[3]] - plane[#[[1]], #[[2]]]} &, data3Ds]; projection = Rasterize[ ...


1

This will not work on version 9... Because there are too much points (about 300295) my laptop can not handle the whole data. The main idea is to use Delaunay triangulation DelaunayMesh in Mathematica. dat = data3D[[1 ;; 3000, All]]; mesh = DelaunayMesh[dat]; HighlightMesh[mesh, {Style[0, Directive[PointSize[Medium], Black]], Style[2, Opacity[0.1]]}] ...


0

I found half an answer that works well except for the orientation part. As several of you have hinted at the FindCurvePath function is on the right track, but it only works in two dimensions. My options are thus projecting/rotating any polygon to some canonical plane, or, more easily, using the FindShortestTour function which solves the "traveling salesman ...


4

In version 10, you can use MeshCoordinates[ConvexHullMesh[...]] as in RunnyKine's answer, but you need to re-order them using MeshCells: pentagon=N@Table[{Cos[2 Pi k /5], Sin[2 Pi k /5]}, {k, 5}] points = N@RandomSample[Join[pentagon, {{0, 0}}]] chm=ConvexHullMesh[points]; ordering=MeshCells[chm,2][[1,1]] out=MeshCoordinates[chm][[ordering]] ...


1

The following works in your special case but can't be generalized. l = {"+", "m", "π", "[]", "2"}; SeedRandom@0; rl = RandomSample[l, 5]; g = With[{cg = CycleGraph[5]}, Graph[UndirectedEdge @@@ Thread@{rl, RotateLeft@rl}, VertexCoordinates -> (Rule @@@ Thread@{rl, VertexCoordinates /. AbsoluteOptions[cg, VertexCoordinates]}), ...


3

If you have Version 10, you could use ConvexHullMesh. pts = RandomReal[{-10, 10}, {6, 2}]; You can then order them by doing: chull = ConvexHullMesh[pts]; And here are the points: MeshCoordinates[chull] Note: This does not always order the points but one can use MeshCells which will give the ordering correctly. See @kguler's answer.


2

Could use ConvexHull in the ComputationalGeometry standard add-on package. Needs["ComputationalGeometry`"] We'll create a simple example. pts = RandomReal[{-10, 10}, {6, 2}]; ListPlot[Append[pts, First[pts]], Joined -> True] Now find and plot the (ordered) outer points. hullindices = ConvexHull[pts]; hullpts = pts[[hullindices]]; ...


2

This has been confirmed by Wolfram Technology Group as a bug.


7

In Version 10, we can use RegionMember to select points that are within a region; whether we're dealing with points in a 3D polygon or a 2D polygon embedded in 3D. Let's take a look at the latter case which is what the OP asks: We create a triangle embedded in 3D, discretize it and collect points we know for sure are in the triangle: tri = Triangle[{{0, 0, ...


5

Version 10 approach: d = 0.04; points = Table[{x, y, z}, {x, -1, 1, d}, {y, -1, 1, d}, {z, -1, 1, d}] ~Flatten~ 2; region = BoundaryDiscretizeGraphics @ PolyhedronData["PentagonalDipyramid"]; rm = RegionMember[region]; Select points in the region: pin = Pick[points, rm @ points, True]; Visualize: Graphics3D[{Sphere[pin, d/2]}, Boxed -> False]


7

In Version 10, we can do this nicely even for 3D point sets: pointsToGraph[pts_, graph : (Graph | Graph3D)] := Module[{del = DelaunayMesh[pts], edges}, edges = UndirectedEdge @@@ MeshCells[del, 1][[All, 1]]; graph[Range@Length@pts, edges, VertexLabels -> "Name", VertexCoordinates -> pts] ] SeedRandom[2]; pts2d = RandomReal[10, {10, 2}]; ...


4

In Version 10 you can now create ImplicitRegions and Integrate over them: region = ImplicitRegion[And @@ {0 <= x, x <= 1 - y, -1 <= y, x + 2 y <= 2}, {x, y}] Now Integrate[x + y, {x, y} ∈ region] 2/3


5

Update: From your intuitive code Step 1 I deleted color of polygon in your code like this. triang1 = {{0, 0, 1}, {1, 0, 1 + Sqrt[3]}, {-1, 0, 1 + Sqrt[3]}}; triang2 = RotationTransform[2 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1]; triang3 = RotationTransform[4 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1]; pic1 = Graphics3D[{Polygon[triang1]}]; pic2 = ...


9

Update 2: A function to generate tori: toroidalF[n_, h_: (1/4), w_: (1/2), opts : OptionsPattern[]] := Module[{top, bottom, verts, outer = {Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/n], faceverts = Flatten[#[[{1, 2, 4, 3}]] & /@ # & /@ (Join @@@ Subsets[#, {2}] & /@ ...


5

Here is a straightforward alternative in Version 10 that works for your purpose, since you just want to extract the polygons on the surface. The approach is to discretize the graphics object and collect the Polygons: data = Table[x^2 + y^2 + z^2 + RandomReal[0.1], {x, -2, 2, 0.2}, {y, -2, 2, 0.2}, {z, -2, 2, 0.2}]; gr = ...


0

One compact way to get $n$ points on a circle would be CirclePoints[center_,radius_,n_] := (center+radius #&) /@ Transpose @ Through[{Re,Im}[Exp[2\[Pi] I Range[n]/n]]]


2

Here is a quick and dirty (read approximate) way to achieve this using Version 10 capabilities: circ[ctr_, r_, n_] := MeshCoordinates @ DiscretizeRegion[Circle[ctr, r], MaxCellMeasure -> {"Length" -> 2 Pi r /(n - 1.5)}] Here ctr is the center, r, the radius and n number of points. Visualize (for $n = 5$): ...


10

In Version 10, this can be elegantly done in one line. First we create some text (stealing from @kguler) as follows: img = Image[Graphics[Text[Style["'., ab cgixyz,...", Green, FontFamily -> "Times", FontSize -> 72]]], ImageSize -> {600, 100}]; Then: cvx = ConvexHullMesh @ ImageValuePositions[EdgeDetect[img, 3], White]; ...


3

In Mathematica 10, you can use DelaunayMesh on a set of points. This returns a MeshRegion. You can use MeshCoordinates to return a list of coordinates of the points (should be the same as the initial set of points) and then MeshCells to return the triangles. See Interactive Computational Geometry for more details.


6

There are some new functions in Mathematica 10 that make this very easy: r = {{-6, 6}, {-6, 6}}; pts = RandomSample[Permutations[Range[-5, 5], {2}], 10]; Grid[{ {"The sites", "Delaunay trianguation", "Voronoi diagram"}, { Graphics[{Red, Point[pts]}, PlotRange -> r], Show[dm = DelaunayMesh[ pts], Graphics[{Red, Point[pts]}], PlotRange -> ...


2

First, I should say that I could find no examples of using RegionPlot3D with regions in the documentation. It works on some regions, not on others, and in this case runs longer than one wants to wait. It runs nonstop because Reduce[Exists[{u, v}, x - Cos[u] == 0 && y - Cos[v] - Sin[u] == 0 && z - Sin[v] == 0 && 0 <= u ...


4

ImplicitRegion (and ParametricRegion) represent a region. They are not for plotting. Thus RegionPlot is not even remotely an alternative. You can do many operations on regions that you can look up in the documentation centre. Just a few examples: you can compute their size, decide if a point is within, compute the distance between them, find their ...


1

First step is turning the GraphicsComplex in surface into standard Polygon-s: polys = surface // Normal // Flatten; I'll be using Resolve further on which doesn't like inaccurate numbers, so I Rationalize the coordinates. There are many coordinates that are terribly close to each other, leading to degenerated polygons. I'll remove these: polysClean = ...


4

Here is a way to do it: g1 = RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi}, PlotPoints -> 2]; surface = GraphicsComplex[g1[[1, 1]], {Opacity[0.7], g1[[1, 2, 1, 1, 5, 1]]}]; triangles = {Polygon[{{0, 0, 0}, {0, 2, 2}, {0, -1, 2}}], Polygon[{{2, 0, 0}, {2, 2, 2}, {2, -1, 2}}], Polygon[{{-3, 0, -3}, {3, 2, 2}, {-3, -1, 2}}], ...


2

This isn't a bug, it happened already in recent MMA versions. In such cases you can increase the value for option PlotRangePadding Sorry, I can't test it, because I have actually MMA7. Probably setting SphericalRegion->True or ImagePadding will help also


8

In Version 10, this can be done elegantly in one line: SeedRandom[400] pts = RandomReal[5, {400, 3}]; Then: surftri = RegionBoundary @ TriangulateMesh @ DelaunayMesh @ pts We can look inside to see that only the surface triangulation remains: HighlightMesh[surftri, {Style[0, Directive[PointSize[0.015], Blue]], Style[1, Thin, Black], Style[2, ...


5

Well, another solution using V10 functionality: data = {{4.4, 14}, {6.7, 15.25}, {6.9, 12.8}, {2.1, 11.1}, {9.5, 14.9}, {13.2, 11.9}, {10.3, 12.3}, {6.8, 9.5}, {3.3, 7.7}, {0.6, 5.1}, {5.3, 2.4}, {8.45, 4.7}, {11.5, 9.6}, {13.8, 7.3}, {12.9, 3.1}, {11, 1.1}}; The Voronoi diagram: vor = VoronoiMesh[data] We get the Polygons that make ...


7

It's been over a year but since v10 introduced some nice functionalities to do this elegantly, let's revisit this question: SeedRandom[0] We generate some points and get their voronoi diagram using VoronoiMesh pts = RandomReal[4, {20, 2}]; vor = VoronoiMesh[pts, {{0, 4}, {0, 4}}]; (* bounded Voronoi diagram *) We can visualize it: HighlightMesh[vor, ...


6

Well, you have to first convert it to a MeshRegion. Let's take the space shuttle for example: shuttle = ExampleData[{"Geometry3D", "SpaceShuttle"}] Now, we discretize it, since it's a Graphics3D object, we use DiscretizeGraphics: ds = DiscretizeGraphics[shuttle] Now, we can find the Area easily: Area[ds] 177.301907 Similarly for the horse: ...


5

Edit: Wolfram Technical Support has confirmed this as a bug The only workaround I know is to turn the MeshRegion into a BoundaryMeshRegion and triangulate the resulting mesh object: dr = DiscretizeRegion[reg, MaxCellMeasure -> {"Area" -> 0.05}]; Then: TriangulateMesh[BoundaryMeshRegion[MeshCoordinates[dr], MeshCells[dr, 2]], ...



Top 50 recent answers are included