Hot answers tagged

22

You are combining the images in the form Show[Graphics[simplePrimitives], complicatedRegionPlot] The options in the resulting figure are inherited from the first term, namely Graphics[simplePrimitives]. This does not include the "TransparentPolygonMesh" -> True generated by RegionPlot. You see the mesh as a result. If you combine things as follows: ...


18

Here's a possible approach. First use TetGen to tetrahedralize the data: Needs["TetGenLink`"] {pts, tetrahedra} = TetGenDelaunay[data3D]; Next define a function to compute the radius of the circumsphere of a tetrahedron (formula from Wikipedia) csr[{aa_, bb_, cc_, dd_}] := With[{a = aa - dd, b = bb - dd, c = cc - dd}, Norm[a.a Cross[b, c] + b.b ...


18

It seems to me that the logo has three semitransparent layers of triangle meshes. One can start with discretized sphere reg = DiscretizeGraphics[Sphere[], MaxCellMeasure -> {"Length" -> 0.8}] Or with Simon's Geodesate. Then the function for disks in 3D is helpful disk[pos_, {nx_, ny_, nz_}, r_, n_: 16] := With[{θ = ArcTan[Sqrt[nx^2 + ny^2], nz], ...


16

First, you can generate your random points like so: SeedRandom[1]; pts = RandomReal[{0, 12}, {100, 2}]; The DelaunayTriangulation command returns an adjacency list representation of the triangulation. Needs["ComputationalGeometry`"]; dt = DelaunayTriangulation[pts]; dt // Column This says that the first point should be connected to the 2nd, the 24th, ...


16

Update: With the function top defined in the original post you can replicate all the cool things you see in rm-rf's answer in the linked Q/A. For example, with a slight modification of gr1, i.e., Graphics3D[hexTile[20, 20] /. Polygon[l_] :> {Directive[Orange, Opacity[0.8], Specularity[White, 30]], Polygon[l], Polygon[{Pi/5, 0} + {-1, 1} # & ...


15

It might be easier to use TriangularSurfacePlot3D to find the Delaunay triangulation of the points. For example, Needs["ComputationalGeometry`"]; triangles[points_] := Module[{pl}, pl = TriangularSurfacePlot[ArrayPad[points, {{0, 0}, {0, 1}}]]; Cases[pl, Polygon[a_] :> Flatten[(Position[points, #[[{1, 2}]]] & /@ a)], Infinity]] ...


15

Here's my go at it. This tells you if two line segments intersect (unless they lie on the same line, in which case it fails horribly): ClearAll[segmentsIntersect]; segmentsIntersect[{a_, b_}, {p_, q_}] := Module[{s, t, soln}, soln = NSolve[a + t (b - a) == p + s (q - p), {s, t}]; If[Length@soln == 0, False, (0 <= s <= 1 && 0 <= t ...


14

Table[drawtriangulation[mesh @@ example, First@example, AspectRatio -> Automatic], {example, {circle, circle34, ellipseeye}}] // GraphicsRow Calculating specifications for these examples: (* distance function, bounding box, fixed points, number of initial points, max iterations, min triangle quality *) circle = {Sqrt[#1^2 + #2^2] - 1. &, ...


14

first part..i had lying around.. poly = Random[Real, {1, 2}] {Cos[#], Sin[#]} & /@ Sort[Table[Random[Real, {0, 2 Pi}], {5}]] isLeft[P2_, {P0_, P1_}] := -Sign@Det@{P2 - P0, P1 - P0}; pinpoly[p_, poly_] := Module[{ed},(*winding rule*) ed = Partition[Append[poly, poly[[1]]], {2}, 1]; Count[ed,pr_ /; (pr[[1, 2]] <= p[[2]] < pr[[2, 2]] ...


14

The mesh seems to be fine and you can see that it is by doing: region = ImplicitRegion[! (Norm[{x, y, z}] < 1), {{x, -5, 5}, {y, -5, 5}, {z, 0, 5}}]; m = DiscretizeRegion[region, {{-2, 2}, {-2, 2}, {0, 1}}] To view as wireframe you can do: Needs["NDSolve`FEM`"] mesh = ToElementMesh[m] // Quiet; Then: Show[mesh["Wireframe"]] If you want to ...


14

The blue line occurs at the edge of the function, where ϕ wraps from 2π to 0. We can get rid of it by adding BoundaryStyle -> None: SphericalPlot3D[ Abs[.5 + Sin[2 ϕ]/2] Sin[θ] + Abs[.5 + Sin[2 (ϕ + π/2)]/2] Sin[θ], {θ, 0, π}, {ϕ, 0, 2 π}, PlotStyle -> {Opacity[0.3], Yellow}, BoxRatios -> {1, 1, 1/2}, MeshFunctions -> {#3 &}, ...


13

Not sure about the creation of a "smooth" surface. But from Mma help, you may create a convex hull in 3D by using TetGenConvexHull Needs["TetGenLink`"] data3D = RandomReal[{0, 1}, {100, 3}]; Graphics3D[Point[data3D]]; surface = TetGenConvexHull[data3D]; (* TetGenConvexHull was changed sometime between 8.0.0 and 8.0.4. Uncomment the following line only if ...


13

You could use the (undocumented) option Method -> {"TransparentPolygonMesh" -> True} for this, e.g. Show[Graphics[Point[{p1, p2}]], RegionPlot[{d[{x, y}, p1, M1] < d[{x, y}, p2, M2], d[{x, y}, p1, M1] > d[{x, y}, p2, M2]}, {x, -4, 4}, {y, -4, 4}], Method -> {"TransparentPolygonMesh" -> True}] which produce


13

RegionPlot[{d[{x, y}, p1, M1] < d[{x, y}, p2, M2], d[{x, y}, p1, M1] > d[{x, y}, p2, M2]}, {x, -4, 4}, {y, -4, 4}, Epilog -> Point[{p1, p2}]] seems to do what you want:


13

You have to create your own mesh and you have to convert your u and v to mesh interpolations. (In the example in the documentation, NDSolveValue does this itself in constructing uif, vif.) Example: Needs["NDSolve`FEM`"] mesh = ToElementMesh[FullRegion[2], {{0, 5}, {0, 1}}]; u = Function[{x, y}, x (y - 0.5)/25]; v = Function[{x, y}, -x^2/50]; uif = ...


12

This is my implementation using Graphics primitives and rules. Here's the final result; the implementation details and edge cases follow. 1. General approach First, we start with a single square and build up a test grid: square = Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}}]; grid = Graphics[{EdgeForm[Black], FaceForm[None], Table[Transpose@First@square ...


12

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 -> ...


12

Here are a few additions to @RunnyKine suggestions. If you are ever in doubt about the quality of a mesh (an ElementMesh to be exact) you can query the mesh. Needs["NDSolve`FEM`"] region = ImplicitRegion[! (Norm[{x, y, z}] < 1), {{x, -5, 5}, {y, -5, 5}, {z, 0, 5}}]; mesh = ToElementMesh[region]; Min[mesh["Quality"]] 0.004439742441262357` So the ...


12

regplt = RegionPlot[\[CapitalOmega], AspectRatio -> Automatic]; ContourPlot[{2 x^2 + 3 y^2 + 2 x y - 2, x^2 + y^2 - .1}, {x, -1.25, 1.25}, {y, -1.25, 1.25}, Contours -> {{0}}, BaseStyle -> Thick, GridLines -> {xg, yg}, Method -> {"GridLinesInFront" -> True}, MeshFunctions -> {#1 &, #2 &}, Mesh -> {xg, yg}, MeshStyle -> ...


12

Quite long since there are arcs not lines, here is the code for them: An efficient circular arc primitive for Graphics3D disk = Scale[Sphere[{0, 0, 1.02}, .05], {1, 1, .2}]; Composition[ Graphics3D[{#, Opacity@.2, Sphere[{0, 0, 0}, 1]}, ImageSize -> 500, Lighting -> "Neutral"] & , { Green, GeometricTransformation[disk, ...


12

As of version 10.2, NMinimize does not work with ElementMesh (which is not RegionQ) directly. Perhaps it could, but for now I would suggest converting the element mesh to a region: NMinimize[x^2 + y^2, {x, y} \[Element] MeshRegion[disk]] The above will work in Mathematica 10.0.2 and later. Update In version 10.3, ElementMesh can be used directly in ...


12

Very inefficient but short: I assumed that DiscretizeRegion of a Sphere gives us a mesh that have 5 or 6 triangles at each vertex. ms = DiscretizeRegion[Sphere[], MaxCellMeasure -> .01]; (*groups of polygons with one common vertex*) data = Sow[#, #[[1]]] & /@ MeshCells[ms, 2] // Reap // #[[-1, All, All, 1]] &; data0 = MeshCoordinates[ms]; ...


12

ParametricPlot[ v {Cos[u], Sin[u]}, {u, 0, 2 Pi}, {v, 1, 3}, Mesh -> {15, 3}, Epilog -> { PointSize @ .02, Red, Point @ Catenate @ Array[ Function[{u, v}, v {Cos[u], Sin[u]}], {15 + 2, 3 + 2}, {{0, 2 Pi}, {1, 3}} ] }] As pointed by Shutao TANG, Catenate is new so one can ...


11

You can add the mesh specific to the x and y coordinates of your data with Mesh -> {First /@ bData, #[[2]] & /@ bData}: p1 = ListPointPlot3D[bData, PlotStyle -> PointSize[Large]] p2 = ListPlot3D[bData, MeshStyle -> Red, PlotStyle -> None, Mesh -> {First /@ bData, #[[2]] & /@ bData}, InterpolationOrder -> ...


11

I just followed examples in TetGenLink documentation: Needs["TetGenLink`"] data3D = N@Flatten[Table[{r Cos[phi], r Sin[phi], z}, {phi, 0, 2 Pi, .5}, {z, -4, 4, .5}, {r, .2, 1, .4}], 2]; in = TetGenCreate[]; TetGenSetPoints[in, data3D]; out = TetGenTetrahedralize[in, ""]; coords = TetGenGetPoints[out]; meshElements = TetGenGetElements[out]; ...


10

As pointed out in the comments, there's really no mathematical definition of a concave hull. Of course, just because there's no mathematical definition does not preclude coming up with something that sort of works. I can think of two ways to do this: Easy Way, Not General Your data roughly has axial symmetry parallel to the x-axis. Moreover, all of your ...


10

If you don't mind using undocumented functions, you can do it like this: Graphics`Mesh`MeshInit[]; mesh = DensityPlot[4 Sin[2 Pi x] Cos[1.5 Pi y] (1 - x^2) (1 - y) y, {x, -1, 1}, {y, 0, 1}, Method -> {"ReturnMeshObject" -> True}]; Graph[mesh["Edges"], VertexCoordinates -> mesh["Coordinates"], VertexShapeFunction -> (Point[#] &)]


10

It seems you are asking for the Delaunay triangulation. There's a function for this in the Computational Geometry package, which Mark described. Another, usually much faster option is using ListDensityPlot: ldp = ListDensityPlot[ArrayPad[p0, {0, {0, 1}}], Mesh -> All, ColorFunction -> (White &)] You can extract the polygons from this ...


10

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, ...



Only top voted, non community-wiki answers of a minimum length are eligible