22
There are many ways to do this, modifying, improving my method or doing a completely different thing. My goal here is to show a very basic idea that should give you a start. LocatorPane and Manipulate give means of interactive addition/deletion and dragging of points in 2D plane. The problem is how to add an edge -- there has to be interaction between 2 ...
16
perhaps:
timg = ImageEffect[img, {"TornFrame"}];
tr[t_] := # + {5 10^-3 Cos[20 #[[2]] + 5 t], 5 10^-3 Sin[20 #[[1]] + 5 t]} &
frames = Table[ImageTransformation[timg, tr[t]], {t, Subdivide[0, 2 Pi, 40]}];
ListAnimate @ frames
15
There is an example of something similar in the PDEModel collection in the Acoustic Cloak Model. Here is a 3D version.
Some setup:
Needs["NDSolve`FEM`"]
xI = 200; yI = 200; zI = 20;
xM = xI*2; yM = yI*2; zM = zI*2;
We start by creating the inner mesh:
innerMesh =
ToElementMesh[Cuboid[{-xI/2, -yI/2, -zI/2}, {xI/2, yI/2, zI/2}],
"MeshOrder&...
13
You can try this:
polygon = Import["https://pastebin.com/raw/d3MRBb8K"];
pts = Union @@ polygon[[1]];
nf = Nearest[pts -> "Index"];
R = BoundaryMeshRegion[pts, Polygon[DeleteDuplicates@*Flatten /@ Map[nf, polygon[[1]], {2}]]];
f = RegionMember[R]
13
Update: New version of FEMAddOns v1.4.2 includes ExtrudeMesh
@user21 updated FEMAddOns and ExtrudeMesh is included. Now, you only need to call FEMAddOns and don't need to worry about namespace collisions with MeshTools. For completeness, here is the updated workflow to get the latest version of FEMAddOns and extend Alex's answer by two lines:
...
12
I wouldn't try to do this on a square (assuming you want at least some sort of systematic correspondence between edges on the sphere and their projections), at least if you don't want crossings on square sides.
As @Szabolcs stated, you can't really do this without extreme distortion. You may use map projections, though, picking your poison (for the mesh ...
12
We can play with numbers to get an ideal mesh. As a stating point you could use this one:
Needs["MeshTools`"](*Needs["FEMAddOns`"]*)
Lx = 100;
Ly = 50; r[t_] :=
Piecewise[{{Lx/Cos[t], 0 <= t <= ArcTan[Ly/Lx]}, {Ly/Sin[t],
ArcTan[Ly/Lx] < t <= Pi - ArcTan[Ly/Lx]}, {-Lx/Cos[t],
Pi - ArcTan[Ly/Lx] < t <= Pi + ...
12
This answer extends @user21's to include different mesh densities of the inclusion along the X, Y, and Z directions.
It is important to note that the current mesher (version 12.1.1) likes to produce an isotropic mesh. One can accomplish the different mesh densities by creating a parameterized (I, J, K) structured mesh that ranges between zero and the number ...
11
Add the option PlotMarkers -> None:
themes = "Base" /. Charting`$PlotThemes;
Grid @ Partition[ListLinePlot[points, Mesh -> 2,
PlotMarkers->None, PlotLabel -> #, PlotTheme ->#, ImageSize -> Medium]& /@ themes, 2]
We need to add this option for the three themes ("Business", "Marketing" and "Monochrome") because other themes do not use ...
11
Here is an alternative approach using SignedRegionDistance that seems pretty fast, but I have not compared it to @Henrik Schumacher's answer. It took about 5 seconds to test 100,000 points on my machine.
Needs["NDSolve`FEM`"]
points = Import["https://pastebin.com/raw/190HQui1"];
polygon = Import["https://pastebin.com/raw/d3MRBb8K"];
(* Convert into ...
11
This method seems to work quite well. Instead of changing the positions randomly, I rotate each vertex around in a small circle centered at each original vertex position. Every vertex starts at a randomly assigned phase so the polygons are not all in sync:
img = ExampleData[{"TestImage", "House"}];
mesh = TriangulateMesh[Rectangle[{0, 0}, ...
11
Use the OpenCascadeLink for this:
Needs["OpenCascadeLink`"]
s = OpenCascadeShape /@ (Ball /@ p);
shape = OpenCascadeShapeIntersection[s];
bmesh = OpenCascadeShapeSurfaceMeshToBoundaryMesh[shape];
Or, even simpler:
shape = OpenCascadeShape[ RegionIntersection @@ (Ball /@ p)];
bmesh = OpenCascadeShapeSurfaceMeshToBoundaryMesh[shape];
Or:
Needs[&...
11
Update 2: workflow to create perfectly cubical voxels
In update 1, I discovered that although MaxCellMeasurewill allow you to control the resolution of the base mesh, ToElementMesh makes some internal choices to refine the mesh. Unfortunately, this refinement makes it virtually impossible to guarantee that the voxels are perfect cubes. Therefore, I created ...
10
chm = ConvexHullMesh[{P0, P1, P2, P3}];
ClearAll[regFunc]
regFunc[{x, y, z}] := FullSimplify @ RegionMember[Rationalize @
MeshPrimitives[DiscretizeRegion[chm, MaxCellMeasure -> ∞], 3][[1]]] @ {x, y, z}
regFunc @ {x, y, z}
x + y + z <= 1 && z >= 0 && y >= 0 && x >= 0
Also
dm = DelaunayMesh[{P0, P1, P2, P3}];
...
10
The OP has asked a number of related questions involving the same FEM operators 226503, 226486, 222834. As I showed in my answer 222834 to an earlier question from the OP, this system would benefit from dimensional analysis and that an anisotropic structured quad mesh is probably the most robust solution to the problem.
Dimensional analysis would aid in ...
10
Manually derived implicit region:
Block[{a, b, c},
{a, b, c} = {2, 5, 10};
DiscretizeRegion[
ImplicitRegion[(25 c^2 (b^2 x^2 + a^2 y^2))/(
a^2 b^2 (c^2 - z^2) (6 - 5 Sqrt[1 - z^2/c^2])^2) ==
1, {{x, -a, a}, {y, -b, b}, {z, -c, c}}],
MaxCellMeasure -> "Length" -> 0.1]
]
Addendum: Alternative method.
reg = DiscretizeRegion[...
9
Maybe something like:
SeedRandom[123]
pts = RandomReal[{-1, 1}, {10, 2}];
mesh = VoronoiMesh[pts];
vc = mesh["Coordinates"];
ClearAll[pndsv]
pndsv = ParametricNDSolveValue[{x'[t] == t^2/2 y[t],
y'[t] == - x[t] t, x[0] == x0, y[0] == y0}, {x, y}, {t, 10}, {x0, y0}];
grph = Graph[mesh["Edges"], VertexCoordinates -> vc,
VertexSize -> Scaled[....
9
Mathematica uses Triangle as a 2D mesh generator. The interface to triangle is in TriangleLink. Triangle comes with source code and you can find that here. Triangle is also used as a basis for DelaunayMesh, if I am not mistaken.
If you want a book then "Delaunay Mesh Generation", by Cheng, Dey and Shewchuck (CRC Press) is a starting point.
Should you want ...
9
If you add the options MaxRecursion -> 0 (to prevent recursive subdivisions) and PlotPoints -> 10 (10 was a lucky guess:) to DensityPlot the mesh lines match the wireframe of bmesh.
Compare DensityPlot output with ColorFunction -> (White&) (middle plot) with bmesh["Wireframe"] (right plot):
Row[{dp1 = DensityPlot[sol[x, y], {x, y} ∈ bmesh,
...
9
Thanks to Henrik Schumacher I got this to work with NestWhileList and visualized the walk on spheres. The other outputs of nextPoint besides RandomPoint are for visualization and the termination of the NestWhileList when the radius is small enough:
mesh = ExampleData[{"Geometry3D", "Triceratops"}, "BoundaryMeshRegion"];
rnf = RegionNearest@RegionBoundary@...
9
Update
The real observation is that MeshRefinementFunction does not work for 1D with ToElementMesh. Yes, that's unfortunately the case but you can easily use
Needs["NDSolve`FEM`"];
f = Function[{vertices, area},
If[Mean[vertices] > 1, area > 0.1, area > 0.01]];
mr = DiscretizeRegion[Interval[{0, 2}], MeshRefinementFunction -> f];
...
9
You need DiscretizeRegion and RepairMesh:
r = Region[extrudeImage@img, Axes -> True, AxesLabel -> {"X", "Y", "Z"}];
r2 = TransformedRegion[r, TranslationTransform[-RegionCentroid@r]];
r3 = DiscretizeRegion@r2 // RepairMesh
rfinal = RegionUnion@
Table[TransformedRegion[r3, RotationTransform[i, {0, 1, 0}]],
{i, ...
9
Here is an alternate approach using a graded mesh.
Define some helper functions for a graded mesh
Here are some functions that I've used to create 1d to 3D anisotropic meshes. Not all functions are used.
(*Import required FEM package*)
Needs["NDSolve`FEM`"];
(* Define Some Helper Functions For Structured Meshes*)
pointsToMesh[data_] :=
MeshRegion[...
9
DiscretizeRegion before RegionIntersection.
p = {{0, 0, -(Sqrt[(3/2)]/2)}, {1/Sqrt[3], 0,
1/(2 Sqrt[6])}, {-(1/(2 Sqrt[3])), 1/2,
1/(2 Sqrt[6])}, {-(1/(2 Sqrt[3])), -(1/2), 1/(2 Sqrt[6])}};
reg = DiscretizeRegion /@ Ball /@ p
RegionIntersection[reg, ViewPoint -> {-1.14137, 0.973908, 0.865322},
ViewProjection -> "Orthographic"]
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, ...
8
I think your main issue is that the FEM mesh is second order and the plotting mesh is first order. You could change the element order of your FEM mesh to first order, but that will affect accuracy.
You can see that the FEM mesh has 6 coordinates per triangle by the following:
<< NDSolve`FEM`
region = RegionDifference[Rectangle[{0, 0}, {100, 100}],
...
8
A few additions to kglr's and Tim's answers.
First, I'd like to point out that the way you generate the mesh is not optimal. Consider your setup:
<< NDSolve`FEM`
region = RegionDifference[Rectangle[{0, 0}, {100, 100}],
Disk[{50, 50}, 10]];
bmesh = ToBoundaryMesh[region];
mesh = ToElementMesh[bmesh];
(*mesh["Wireframe"]*)
Now, we compute the ...
8
One can use DiscretizeRegion to obtain a mesh:
slice = DiscretizeRegion[
RegionIntersection[
Ball[],
InfinitePlane[{0, 0, 0}, {{1, 0, 0}, {0, 1, 0}}]
],
MeshCellStyle -> {1 -> Black}
]
Or SliceDensityPlot3D to get a visual:
SliceDensityPlot3D[1, {"ZStackedPlanes", 10}, {x, y, z} ∈ Ball[], Axes -> False, Boxed -> False]
3D ...
8
One way to periodically tile a Voronoi diagram is to translate your seeds in all directions you'd like to tile, find the Voronoi diagram of this set, then take the cells that correspond to the original data.
Here, I'll tile it in the cardinal directions.
Initial data:
SeedRandom[1];
pts = RandomReal[{-1, 1}, {20, 2}];
Now we augment this data and find a ...
8
I don't think there's anything particularly special in the mesh info tab. All of it can be found with various functions which I've encapsulated below:
meshinfo[mesh_] := {{"Embedding Dimension", RegionEmbeddingDimension[#]},
{"Geometric Dimension", RegionDimension[#]},
{"Vertex Cells" , MeshPrimitives[#, 0] // Length},
...
Only top voted, non community-wiki answers of a minimum length are eligible
