Hot answers tagged

23

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


19

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} # & ...


16

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


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


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


14

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


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

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

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


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

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


13

The approach I would take is the following: Clear definitions, load a sample image, find corners in the image using the method you indicated in the OP: Clear[img, points, dm, cells, nerve, nervenucleus] img = ExampleData[{"TestImage", "Aerial2"}]; points = ImageCorners[img, MaxFeatures -> 200]; Generate a Delaunay mesh from those points: dm = ...


13

I discarded my previous approach to generate cubes, then fuse them together, since it seems to do a lot of wasted work. Instead, I propose here my version of a cartesian mesher. The approach is conceptually the same as the one delineated by Zviovich, but I wasn't entirely satisfied with his results, as it seems to me that his process still leads to ...


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

You could use ListContourPlot3D and DiscretizeGraphics: Quiet @ DiscretizeGraphics @ Normal @ ListContourPlot3D[arr, Contours -> {0}, Mesh -> None]


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

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


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

MeshPrimitives returns a list of Polygon objects; and it's not too tricky to just to count the number of points in each Polygon: colorvm = Map[{ColorData[97, First[Dimensions[First[#]]] - 2], #} &, MeshPrimitives[vm, {2, "Interior"}]]] Graphics[{EdgeForm[Black], colorvm}] Here's what it returns on the Voronoi diagram for a bunch of random points: ...



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