50

Edit: added Gradient -> grad[vars] option. Without this small option the code was several orders of magnitude slower. Yes, it can! Unfortunately, not automatically. There are different algorithms to do it (see special literature, e.g. Dziuk, Gerhard, and John E. Hutchinson. A finite element method for the computation of parametric minimal surfaces. ...


41

Version 11 has both symbolic and numeric eigensolvers, see here for an overview Here is a slightly different way to do it. We write a function that converts any PDE (1D/2D/3D) into discretized system matices: Needs["NDSolve`FEM`"] PDEtoMatrix[{pde_, Γ___}, u_, r__, o : OptionsPattern[NDSolve`ProcessEquations]] := Module[{ndstate, feData, sd, bcData, ...


41

We need quite a bit of preparation. In the first place we need methods to compute cell adjacency matrices from here. I copied the code for completeness. CellAdjacencyMatrix[R_MeshRegion, d_, 0] := If[MeshCellCount[R, d] > 0, Unitize[R["ConnectivityMatrix"[d, 0]]], {} ]; CellAdjacencyMatrix[R_MeshRegion, 0, d_] := If[MeshCellCount[R, d] > 0, ...


40

I guess the first step would always be to find an ordered list of points along the middle of the curve. That I can help with: First binarize and thin the image of the curve, so you get a 1-pixel wide white line: img = Import["http://i.stack.imgur.com/fEf1i.jpg"]; bin = Thinning@ColorNegate[Binarize[img]] Finding the white pixels in this image is easy: ...


34

Geodesics in Heat Algorithm At the suggestion of @user21 I am splitting up my answers to help make the code(s) for calculating geodesics distances easier to find for other people interested in these sorts of algorithms. The Geodesics in Heat algorithm is a fast approximate algorithm for estimating geodesic distances on discrete meshes (but also a variety ...


33

There is now a built-in version of an algorithm in v10.1: WordCloud. I wonder whether any of your nice algorithms introduced here had any influence on the built-in function... Individual words can be styled, annotated, rotated, etc., so I must assume that there is a polygon-intersection checking algorithm running under the hood. Would be useful to know more ...


33

Here is a method that utilizes $H^1$-gradient flows. This is far quicker than the $L^2$-gradient flow (a.k.a. mean curvature flow) or using FindMinimum and friends, in particular when dealing with finely discretized surfaces. Background For those who are interested: A major reason for numerical slowness of $L^2$-gradient flow is the Courant–Friedrichs ...


32

Well, you can use the undocumented RegionDistance which does exactly this as follows: (This answer, as written, only works for V9 as noted by Oska, for V10 see update below) here is a triangle in 3D region = Polygon[{{0, 0, 0}, {1, 0, 0}, {0, 1, 1}}]; Graphics3D[region] Now suppose you want to find the shortest distance from the point {1, 1, 1} in 3D to ...


32

Note added 1/29/2020: the routines here have a bug where the mean curvature is sometimes computed with the opposite sign. I still need to work on how to fix this. I guess I should not have been surprised that there are actually many ways to estimate the Gaussian and mean curvature of a triangular mesh. I shall present here a slightly compacted ...


28

Fixed (see below) Here's an approach: r1 = Exp[-x^3 - y] - 1 == z; r2 = y == z; We create ImplicitRegions: reg1 = ImplicitRegion[r1, {x, y, z}]; reg2 = ImplicitRegion[r2, {x, y, z}]; The intersection of these regions is the line you seek: reg = RegionIntersection[reg1, reg2]; And here is the length (note the inclusion of the range of values in ...


23

This passed all test cases, I think: anglecalc[vec1_, vec2_] := Mod[(ArcTan @@ vec2) - (ArcTan @@ vec1), 2 π]


22

Here is a solution I can think of. Idea is to take the FullPolygon of a given country and then triangulate the region. Once that is done take the underlying Graph and do a FindShortestPath. Result will not be too bad. fullPoly = CountryData["Vietnam", "FullPolygon"]; pts = Flatten[fullPoly[[1, 1]], 1]; line = Polygon[Range[##]] & @@@ Partition[{1}~Join~ ...


22

Nothing really new from my side. But since I really like the heat method and because the authors of the Geodesics-in-Heat paper are good friends of mine (Max Wardetzky is even my doctor father), here a slightly more performant implementation of the heat method. solveHeat2[R_, a_, i_] := Module[{delta, u, g, h, phi, n, sol, mass}, sol = a[["HeatSolver"]]; ...


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


21

[Edit: I found this method a rather pleasing application of analytic geometry, so I rewrote the explanation hopefully to do it justice. In fact, it can be applied in any dimension, and I've updated the code to be general] Here's my way: faces[simplex_] := Partition[simplex, Length@simplex - 1, 1, 1]; (* outward-oriented unit normals to each of faces[a,b,...


21

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


21

I'm going to take this as a general question, referring to all atomic objects, not just DelaunayMesh. By design, atomic objects like DelaunayMesh, SparseArray, Graph, etc. or even Association and Rational are not meant to be accessed directly as a Mathematica expression. There are various reasons why an object was made atomic, typically related to ...


21

DeleteDuplicates[lines, RegionWithin] {InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]} Also DeleteDuplicates[lines, MemberQ[{##}, RegionIntersection @ ##]&] {InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}


21

It took me a while, but the suggestion of @Michael E2 was quite helpful, and especially the post (Optimize inner loops). For those of you (like me) who are new to this style of programming in Mathematica there are a few things that helped in my particular example. In my slow version I was looping over all vertices in the mesh list. For example in ...


20

I propose "deintersection" algorithm. Let we have $n$ random points. n = 10; p = RandomReal[1.0, {n, 2}]; We want change the order of this points to get rid of the intersections. Line segments $(p_1,p_2)$ and $(p_3,p_4)$ intersect if and only if the signs of areas of triangles $p_1p_2p_3$ and $p_1p_2p_4$ are different and the signs of areas of triangles $...


20

You can use Mod to create a periodic distance function, with a period of, say, d0 (in each coordinate direction). This approach could be altered to have different periods in different directions. Then Nearest will create a NearestFunction that will return the nearest points modulo the period. In the animation below, the square on the left shows the points ...


20

There is also a currently undocumented internal function that may be useful. Region`Mesh`MeshMemberCellIndex[mr] generates a function which can be applied to list of points, giving for each pt the index of the (first encountered) highest-dimensional cell of mr containing pt. For example, Region`Mesh`MeshMemberCellIndex[vor][pts] (* {{2, 2}, {2, 4}, {2, 5},...


20

There is a neat (and widely known) trick to produce n approximately evenly distributed points in a disk, or on any surface of revolution. Points are placed on a spiral, each time turning by the "golden angle". The reference is: Vogel, H (1979). "A better way to construct the sunflower head". Mathematical Biosciences. 44 (44): 179–189.4. We can adapt the ...


19

This slightly modified function Needs["NDSolve`FEM`"]; helmholzSolve3D[g_, numEigenToCompute_Integer, opts : OptionsPattern[]] := Module[{u, x, y, z, t, pde, dirichletCondition, mesh, boundaryMesh, nr, state, femdata, initBCs, methodData, initCoeffs, vd, sd, discretePDE, discreteBCs, load, stiffness, damping, pos, nDiri, ...


19

One way is to compute the solid angle subtended by the cow viewed at the point by summing signed solid angles corresponding to the cow's polygonal faces. If the total is 4 pi, the point is inside the cow; if 0, outside. Background Quoting Wikipedia, "Solid angle is the two-dimensional angle in three-dimensional space that an object subtends at a point." ...


19

A natural and simple way to approach this problem, assuming that your SiPyramid function has been defined, is as follows: g = SiPyramid[1, {1, 1, 1}]; vertices = Union[g /. Tetrahedron[{vv__}] -> vv]; edges = Flatten[g /. Tetrahedron[vv_] :> UndirectedEdge @@@ Subsets[vv, {2}]]; Graph3D[vertices, edges, VertexCoordinates -> vertices] ...


19

Edit - forgot to add a necessary link Coincidentally I had a little personal project trying to make a good dice roller in Mathematica a while back. Here's some of my code (note: this was before I learned a lot of efficiency techniques so it's not quick but it does make a fairly decent animation). No apologies for the awful colour scheme though... ...


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