Hot answers tagged

107

Here's what I came up with How I did it First we need a list of words. Here, I've taken the original list ordered by size. tally = Tally@ Cases[StringSplit[ExampleData[{"Text", "AliceInWonderland"}], Except@LetterCharacter], _?(StringLength@# > 4 \[And] # =!= "Alice" &)]; tally = Cases[tally, _?(Last@# > 10 &)]; tally = ...


83

A preview Before I show any code, here's a preview of what is possible with some tweaking: First try Here's a go at implementing Wordle's layout algorithm, described at cormullion's link. First, let's generate the word data (this is pretty arbitrary): punctuation = ",/.<>?;':\"()-_!&" (* boring words: *) common = {"the", "of", "and", "to",...


82

This answer evolved over time and got quite long in the process. I've created a cleaned-up, restructured version as an answer to a very similar question on dsp.stackexchange. Here's my quick&dirty solution. It's a bit similar to @azdahak's answer, but it uses an approximate mapping instead of cylindrical coordinates. On the other hand, there are no ...


67

The undocumented Graphics`PolygonUtils`PointWindingNumber (if you're on versions < 10, use Graphics`Mesh`PointWindingNumber) does exactly this — it gives you the winding number of a point. A point lies inside the polygon if and only if its winding number is non-zero. Using this, you can create a Boolean function to test if a point is inside the polygon ...


52

I dug up some simple analog circuit design definitions that I sometimes use to make diagrams for classes or problem sets. Mathematica is obviously very useful when you have to create iterative copies of circuit elements, as in this example (a chain of resistor-capacitor elements): Since this is for teaching purposes and not professional, you may forgive ...


43

Using the function winding from Heike's answer to a related question winding[poly_, pt_] := Round[(Total@ Mod[(# - RotateRight[#]) &@(ArcTan @@ (pt - #) & /@ poly), 2 Pi, -Pi]/2/Pi)] to modify the test function in this Wolfram Demonstration by R. Nowak to testpoint[poly_, pt_] := Round[(Total@ Mod[(# - RotateRight[#]) &@(ArcTan @@ (pt ...


42

======= Update ========= Great question! It inspired this Wolfram Blog article and includes most of the code below plus some apps and fractal layouts like this: I think it make sense to keep the older code blow for archival and historic purposes. ======= Older implementation ========= Excellent motivating creativity question. This is a bit big for a ...


38

Now that two of our resident Mathematica geniuses (genii?) have produced such awesome examples, there's not much room left for anyone else... :) But that didn't stop me - and I'm here to make you guys look good. I had an idea... I decided not to make a cloud, but a tale - or rather, a tail. I've pinched Szabolcs's code to get the words and frequencies: ...


36

The first step is to rasterize the points, so let's just start there as an example: n = 512; g = Image[Map[Boole[# > 0.001] &, RandomReal[{0, 1}, {n, n}], {2}]] The trick is to exploit the distance image. Almost all the work is done here (and it's fast): i = DistanceTransform[g] // ImageAdjust // ImageData; We need a little more precomputation ...


33

I'm coming to the party a bit late, but here's my approach. It should work for any two polygons, including non-convex and self-intersecting ones. winding[poly_, pt_] := Round[(Total@ Mod[(# - RotateRight[#]) &@(ArcTan @@ (pt - #) & /@ poly), 2 Pi, -Pi]/2/Pi)] cross[e1_, e2_] /; (N[Det[{Subtract @@ e1, Subtract @@ e2}]] === 0.) = ...


31

Obtain the image: i = Import["http://i.stack.imgur.com/iab6u.png"]; Compute the distance transform: k = DistanceTransform[ColorNegate[i]] // ImageAdjust; ReliefPlot[Reverse@ImageData[k]] (* To illustrate *) Identify the "peaks," which must bound the Voronoi cells: l = ColorNegate[Binarize[ColorNegate[LaplacianGaussianFilter[k, 2] // ImageAdjust]]]; ...


31

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


31

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


30

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, methodData, pdeData}, {ndstate} = NDSolve`ProcessEquations[Flatten[{pde, Γ}], ...


29

My friend C.P and I worked out these solutions. The 1st is C.P.s' Here we go. First things to know: 1) New Graph[] and related functionality in v8.0.4 is powerful in the sense that it does not only create an image but also stores all the information, including vertex coordinates, in that Graph[] object. 2) There is a GridGraph[...] function that makes ...


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


27

Edit V10! This is simple example what we can now do in real time! R = RegionUnion @@ Table[Disk[{Cos[i], Sin[i]}, .4], {i, 0, 2 Pi, Pi/6.}]; R2 = RegionBoundary@DiscretizeRegion@R; go[] := (While[r > .105, x += v; r = RegionDistance[R2, x]; Pause[.01]]; bounce[];) bounce[] := With[{normal = Normalize[x - RegionNearest[R2, x]]}, If[break, Abort[]]; ...


27

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


26

Short answer Yes, it is possible to speed up the Delaunay-triangulation and make it as fast as it is in Matlab. If you are not afraid of some setup-work, then one possibility is to use a package which calls a c-implementation of the Delaunay-triangulation. One package I know is qh-math which is available in the Wolfram-library: This package includes ...


25

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


25

You'll be interested in the (undocumented!) functions Graphics`Mesh`IntersectQ[] (for checking the intersections) and Graphics`Mesh`FindIntersections[] (for actually finding them). As a sample: BlockRandom[SeedRandom[42, Method -> "MersenneTwister"]; (* for reproducibility *) lins = Table[{Line[RandomReal[1, {2, 2}]]}, {42}];] Graphics`Mesh`...


23

The second "Neat Example" in the documentation for SmoothKernelDistribution contains this compiled function: (* A region function for a bounding polygon using winding numbers: *) inPolyQ = Compile[{{polygon, _Real, 2}, {x, _Real}, {y, _Real}}, Block[{polySides = Length[polygon], X = polygon[[All, 1]], Y = polygon[[All, 2]], Xi, Yi, Yip1, wn = ...


23

Sometimes speed is an issue if there are many polygons and or many points to check. There is an excellent reference on this issue under http://erich.realtimerendering.com/ptinpoly/ with the main conclusion that the angle summation algorithm should be avoided if speed is the objective. Below is my Mathematica implementation of the point in polygon problem ...


22

SystemModeler is one of the Wolfram products that allows building and simulating complex electric circuits - stand alone or as coupled to other systems, like thermodynamic or mechanical ones. This is an alternative answer. If you have latest SystemModeler 4 you can visually create a model there and then import it into Mathematica: Needs["WSMLink`"]; ...


22

Because (a) RegionPlot3D does not render edges well and (b) detailed information about the vertices and faces could be worthwhile, I will offer a solution that finds this information and displays it clearly. (The first two lines of code produce the region plot, if you just want to stop there; the rest develop the improved solution.) I am stuck at one thing:...


21

An alternative approach that does not require the ComputationalGeometry package: You can use a combination of ClusteringComponents and ComponentMeasurements as follows: Define chVertices[txtimg_] := Insert[#, First@#, -1] &@ ComponentMeasurements[ClusteringComponents[Binarize@txtimg, 2], "ConvexVertices"][[2, 2]] Example data: textimg1 = ...


21

You could use this package to triangulate your polygon, and then use this barycentric formula on each of the triangles. inside[{{x1_, y1_}, {x2_, y2_}, r3 : {x3_, y3_}}, r : {_, _}] := # >= 0 && #2 >= 0 && # + #2 < 1 & @@ LinearSolve[{{x1 - x3, x2 - x3}, {y1 - y3, y2 - y3}}, r - r3] Example for a single triangle: tri = {...


21

Another approach to this problem is computing the winding number by integrating $1/z$ centered on the point of interest along the contour of the polygon in the complex plane. Sure this isn't exactly efficient but still i think it's nice to see this working in action. And since complex integration is feasible in Mathematica i just tried :) PointToComplex[{x_,...


20

How about RegionPlot? RegionPlot[ { (x - 0.2)^2 + y^2 < 0.5 && 0 < x < 1 && 0 < y < 1, (x - 0.2)^2 + y^2 < 0.5 && ! (0 < x < 1 && 0 < y < 1), ! ((x - 0.2)^2 + y^2 < 0.5) && 0 < x < 1 && 0 < y < 1 }, {x, -1, 1.5}, {y, -1, 1.5}, PlotStyle -> {...



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