Hot answers tagged

13

A quick hack, essentially interpolating a point travelling at constant speed on polygon edge and averaging the position over a time interval: With[{coords = Append[#, #[[1]]] &@RandomPolygon[{"Convex", 8}][[1]]}, With[{ip = Interpolation[ Transpose@{Rescale@Accumulate@ Prepend[EuclideanDistance @@@ Partition[coords, 2, 1], 0], ...


10

Not an anwser, yet. This is how the curve shorthening flow would act on the cells: As you can see, the cells lose contact. So this is probably not what you are looking for, right? Something similar can be obtained by just subdividing the polygons a little (cutting off the corners) and then using BSplineCurve: polys = MeshPrimitives[mesh, 2][[All, 1]]; f[...


9

This is a deliberate change in version 12.1. To recover the old behavior, do this: StreamPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, y} ∈ Rectangle[{-3, -3}, {3, 3}]], RegionBoundaryStyle -> None, RegionFillingStyle -> None] As another example, compare the following three figures (picture omitted, so that you can try it out and see for yourself):...


8

To verify that the graph can be drawn in the plane without edge crossings, use PlanarGraphQ. But note that you could have a mesh on a toroidal surface and that is not planar. This check is not really necessary. To verify that all faces of the graph form a polygon, check that it is biconnected: KVertexConnectedGraphQ[graph, 2] To check that it is connected, ...


7

This is possible already in version 12, but just undocumented. grouped = GatherBy[points, Region`Mesh`MeshNearestCellIndex[randMesh]]; Apparently, this can find only top-dimensional cells. This is a good example where the syntax of undocumented code was changed in the final version.


7

Here is an approach that is very similar to Henrik's second one. The idea is to use bezier curves, which have (as you might know from Illustrator or Inkscape) fixed points and "handles" that adjust the direction and curvature. We use the midpoints between two vertices of a cell as the fixed point and the handles point in the direction of vertices. When you ...


6

Using OpenCascadeLink from version 12.1 makes this easier and better quality: Needs["NDSolve`FEM`"] rr = RegionIntersection[Cylinder[{{0, 0, -2}, {0, 0, 2}}], Cylinder[{{0, -2, 0}, {0, 2, 0}}], Cylinder[{{-2, 0, 0}, {2, 0, 0}}]]; bmesh = ToBoundaryMesh[rr, "BoundaryMeshGenerator" -> {"OpenCascade", "ShapeSurfaceMeshOptions" -> {"...


4

f1 = ## & @@@ ## & @@@ MeshPrimitives[#, 1] &; f1 @ CantorMesh[3] {{0., 0.037037}, {0.0740741, 0.111111}, {0.222222, 0.259259}, {0.296296, 0.333333}, {0.666667, 0.703704}, {0.740741, 0.777778}, {0.888889, 0.925926}, {0.962963, 1.}} Also f2 = Map[Flatten @* First] @ MeshPrimitives[#, 1] &; and f3 = Cases[Normal@Show[#], Line[x_] :&...


4

A quick, but partially undocumented way to extract the edge coordinates. R = CantorMesh[3]; edges = MeshCells[R, 1, "Multicells" -> True][[1, 1]]; pairs = Partition[Flatten[MeshCoordinates[R][[Flatten[edges]]]], 2] {{0., 0.037037}, {0.0740741, 0.111111}, {0.222222, 0.259259}, {0.296296, 0.333333}, {0.666667, 0.703704}, {0.740741, 0.777778}, {...


4

Use MeshPrimitives. MeshPrimitives[ CantorMesh[3], 1 ] (* {Line[{{0.}, {0.037037}}], Line[{{0.0740741}, {0.111111}}], Line[{{0.222222}, {0.259259}}], Line[{{0.296296}, {0.333333}}], Line[{{0.666667}, {0.703704}}], Line[{{0.740741}, {0.777778}}], Line[{{0.888889}, {0.925926}}], Line[{{0.962963}, {1.}}]} *) There are no guarantees about the ordering ...


4

How about MeshCoordinates@CantorMesh[3] // Partition[#, 2] & // Map[Flatten] (* {{0., 0.037037}, {0.0740741, 0.111111}, {0.222222, 0.259259}, {0.296296, 0.333333}, {0.666667, 0.703704}, {0.740741, 0.777778}, {0.888889, 0.925926}, {0.962963, 1.}} *)


4

In version 12.1 you can use NearestMeshCells with GatherBy as follows: grouped = GatherBy[points, NearestMeshCells[{randMesh, 2}, #] &]; Show[randMesh, ListPlot[grouped, BaseStyle -> PointSize[Large], PlotLegends -> ("group-" <> ToString[#] & /@ Range[Length @ grouped])]]


4

Fiddling around...not an answer, other than that some obvious attempts don't work. Try two half annuluses (annuli?) S7 = ImplicitRegion[(1/10 <= x^2 + y^2 <= 1 && (x >= 0 )), {x, y}]; S8 = ImplicitRegion[(1/10 <= x^2 + y^2 <= 1 && (x <= 0 )), {x, y}]; GraphicsGrid[{{RegionPlot[S8 ], RegionPlot[S7]}}] Use ...


3

One possible workaround is to add a thin gap on the annulus: r = TransformedRegion[ Annulus[{0, 0}, {Sqrt[1/10], 1}, {-Pi + 0.001, Pi}], {(#1^2 + #2^2)^0.5, ArcTan[#, #2]} &]; RegionPlot[r, AspectRatio -> Automatic]


3

o1 = {And @@ Table[fi @@ v == 0, {fi, f}], tr@Prepend[tr@reg, v]}; Graphics3D[{Red, MeshPrimitives[DiscretizeRegion[ImplicitRegion @@ o1], 1]}] Alternatively, you can define o1 as: o1 = {And @@ Table[fi @@ v == 0, {fi, f}], MapThread[Flatten[{##}] &, {v, reg}]};


3

With the new in version 12.1 OpenCascadeLink you get very crisp corners: Needs["OpenCascadeLink`"] Needs["NDSolve`FEM`"] (*Corpo Principal*) orig = {0, 0, 0}; diam1 = 50; r1 = diam1/2; comp = 200; (*Furo*) diam2 = 15; r2 = diam2/2; (*Rasgo*) altRasgo = 30; largRasgo = 15; reg = {Cylinder[{orig, {comp, 0, 0}}, r1], Cylinder[{{altRasgo/2, 0, -r1}, {...


3

Here is a way to get an improved boundary, for this you will need version 12.1 and make use of the new OpenCascadeLink: Needs["OpenCascadeLink`"] Needs["NDSolve`FEM`"] reg1 = Cylinder[{{-2, 0, 0}, {2, 0, 0}}, 1]; reg2 = Cuboid[{-1, -1, 0}, {1, 1, 1}]; reg = RegionDifference[reg1, reg2]; ocr = OpenCascadeShapeBooleanRegion[reg]; bmeshOC = ...


2

The new in 12.1 OpenCascadeLink is doing much better at this: Needs["OpenCascadeLink`"] Needs["NDSolve`FEM`"] iShell = Table[ SphericalShell[{0, 0, 0}, {(i - 1) 0.1, i 0.1}], {i, 50}]; regInt = Table[ RegionIntersection[iShell[[i]], Cuboid[{-1, -4, -1}, {1, 4, 1}]], {i, Length[iShell]}]; We choose one of them: ocr = OpenCascadeShape[regInt[[29]]...


2

With the new in version 12.1 OpenCascadeLink you can do boolean operations without first discretizing the sub-regions: pts1 = {{1.7276, 1.47295, -0.01}, {1.7276, 10.77705, -0.01}, {20.2724, 10.77705, -0.01}, {20.2724, 1.47295, -0.01}, {1.7276, 1.47295, 0.6}, {1.7276, 10.77705, 0.6}, {20.2724, 10.77705, 0.6}, {20.2724, 1.47295, 0.6}}; pts2 = {...


2

This is my solution abf = Function[l, Module[{x1, y1, x2, y2}, x1 = l[[1, 1, 1]]; y1 = l[[1, 1, 2]]; x2 = l[[1, 2, 1]]; y2 = l[[1, 2, 2]]; Solve[as x1 + bs y1 == 1 && as x2 + bs y2 == 1, {as, bs}] ]]; n = MeshPrimitives[mesh, 2] // Length; shre0 = Complement[MeshPrimitives[mesh, 1], MeshPrimitives[BoundaryMesh[mesh], 1]];...


1

Here you can use the fourth variant shown in ?RegionResize: meshr = RegionResize[mesh, {{0, 1}, {0, 1}}]; BoundingRegion[meshr] Cuboid[{0., 0.}, {1., 1.}]


1

In the meantime, I have figured out an answer. The code Complement[MeshPrimitives[mesh, 1], MeshPrimitives[BoundaryMesh[mesh], 1]] // Graphics yields which is what I want. Any comments/improvements are welcome.


1

Here is an idea using RegionPlot: Show@MapThread[ RegionPlot[#1, {x, -7, 7}, {y, -4, 4}, PlotStyle -> Directive[#2, Opacity[0.1]], BoundaryStyle -> #2 ]&, { {x^2 + 9 y^2 + 3/2 x y <= 19, x^2 + 4 y^2 + x y <= 35, x^2 + 16 y^2 + x y <= 26}, {Red, Darker@Green, Blue} } ] As a note, at first I thought I could just ...


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