Tag Info

Hot answers tagged

39

I'm going to brute force it numerically. First, let's define the function we're interested in: fun = KnotData[{3, 1}, "SpaceCurve"] Imagine that this function fun[t] describes the position of a moving point in time. The the magnitude of its velocity as a function of the time t is Sqrt[#.#] & [fun'[t]] I'm going to make an interpolating function ...


29

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


29

Mathematica wouldn't be much helpful if one applied only formulae calculated by hand. Here we demonstrate how to calculate the desired geometric objects with the system having a definition of the curve r[t] : r[t_] := {t, t^2, t^3} now we call uT the unit tangent vector to r[t]. Since we'd like it only for real parameters we add an assumption to Simplify ...


25

There are many ways to proceed, the best one uses FrobeniusSolve : I Since we know, that a x + b == y /. Solve[{-4 a + b == 11, 16 a + b == -1}, {a, b}] // Simplify {3 x + 5 y == 43} we find FrobeniusSolve[ {3, 5}, 43] {{1, 8}, {6, 5}, {11, 2}} a bit more straightforward way : II {x, y} /. Solve[ (a x + b == y /. Solve[ {-4 a + b == 11, 16 ...


25

To answer your question: I don't think it's a bad or good idea to use If. It depends on how you do it. To demonstrate I'll use If combined very powerfully with Mathematica 10's ability to tell if a point is inside a specified region or not. step[position_, region_] := Module[{randomStep}, randomStep = RandomChoice[{{-1, 0}, {1, 0}, {0, -1}, {0, 1}}]; ...


24

General remarks In General Relativity we work in a 4-dimentional Lorentzian manifold i.e. there is a metric tensor $g$ of signature $(+,-,-,-)$ or $(-,+,+,+)$. Theses signatures are mathematically equivalent and we choose the latter because of certain quite formal aspects even though there are some physically relevant reasons for choosing the former one. In ...


22

Update With the approach described in detail below and the function given by J. M. in his answer, we can additionally introduce points to the lines which vary randomly in their size. This gives the look and feel of a pen not drawing with constant thickness due to outrunning ink: ParametricPlot[{{Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 ...


22

A basic approach You can start with a regular density plot, restricted to the domain of x and y using RegionFunction. Then you can transform the plot to an equilateral triangle. f[p_, q_, r_] := r Sin[10 p]^2 + (1 - r) r Cos[20 q]^2; dp = DensityPlot[f[x, y, 1 - x - y], {x, 0, 1}, {y, 0, 1}, RegionFunction -> (#1 <= 1 - #2 &), ColorFunction ...


18

Here's one way to implement Yves's suggestion: (* arclength function *) trefarc = \[FormalS] /. First[NDSolve[ {\[FormalS]'[t] == Norm[KnotData[{3, 1}, "SpaceCurve"]'[t]], \[FormalS][0] == 0}, \[FormalS], {t, 0, 2 Pi}, Method -> "Extrapolation"]] (* length of trefoil *) end = trefarc[2 Pi]; With[{n = 25}, (* n - number of points to ...


18

The idea is quite simple: Since any great circle can be parametrized as $\cos(\theta)u + \sin(\theta)v$ where $u$ and $v$ are two orthonormal vectors. One can start with $u=\{1,0,0\}, v=\{0,1,0\}$ and use RotationTransform to get out of the xy plane, then use RotationTransform again to spin around the z-axis to get all great circles with desired inclination. ...


18

With the solutions you already found, you can generate all possible triangles: ss = Subsets[{x, y} /. Solve[{(x - a)^2 + (y - b)^2 == r^2, x != a, y != b}, {x, y}, Integers], {3} ] Now, select from those the ones not containing an angle of 90 degrees (with integers, Mathematica is smart enough to find exact right angles where they ...


18

Edit A new solution (no luck needed now): g[x_] := (a x + b)/(c x + 1); (*d is a scale factor or zero*) cent[x1_, x2_, x3_] := 1/3 ({x1, g[x1]} + {x2, g[x2]} + {x3, g[x3]}); fi = First@FindInstance[{ g@First@cent[x1, x2, x3] == Last@cent[x1, x2, x3], a/b != c != 0, x1 != x2 != x3, Element[{x1, x2, x3, g[x1], g[x2], g[x3],Sequence @@ ...


18

I recreated the animation on Wikipedia for those who like such things (I do). Here is the Manipulate version: R = 3; r = 1; fx[θ_, a_: 1] := (R + r) Cos[θ] - a r Cos[(R + r) θ/r]; fy[θ_, a_: 1] := (R + r) Sin[θ] - a r Sin[(R + r) θ/r]; gridlines = Table[{x, GrayLevel[0.9]}, {x, -6, 6, 0.5}]; plot[max_] := ParametricPlot[ {fx[θ], fy[θ]}, {θ, 0, ...


18

I prefer PolygonArea myself, but for version 7 users, there's this function by Mr.Wizard for non-intersecting polygons: polygonArea = Compile[{{v, _Real, 2}}, Block[{x, y}, {x, y} = Transpose[v]; Abs[x.RotateLeft[y] - RotateLeft[x].y]/2 ] ] It gives the same answer as the undocumented built-in (as it should).


18

I think you should not be looking at Graph, which is for graph plotting. This is really a graphics question. Looking at your example, I see one or more curves split into (equal?) segments, and then the division points connected with straight lines. So we can base this on this answer (please check there for the code). After dividing a single curve into ...


17

Basing on undocumented function introduced by J. M. in this Q&A: pts = {{0, 200}, {200, 100}, {500, 300}, {100, 700}}; Graphics`Mesh`MeshInit[]; PolygonArea[pts] 155000. Usage of undocumented functions is usualy useful but keep in mind that it may not work with future versions or with all cases. On the other side, it may work. One just can't be ...


16

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


16

Since this is rather long, some might prefer a teaser of what is coming: Introduction First of all, I don't really know why you make your figure inconsistent. I mean, from the first big triangle you separate three smaller triangles. Why don't you just repeat this process and inscribe a circle in each of the new triangles and again separate three new ...


15

Here are three points in space. SeedRandom[2]; {p1, p2, p3} = {{x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3}} = RandomReal[{-3, 3}, {3, 3}]; If the center is $p=(x,y,z)$ and the radius is $r$, then the distance from $p$ to each $p_i$ must be exactly $r$. Thus, for each $i=1,2,3$, we have $$(x - x_i)^2 + (y - y_i)^2 + (z - z_i)^2 = r^2.$$ Furthermore, ...


15

Is this what you are searching for? a = {-4, 11}; b = {16, -1}; dy = (b[[2]] - a[[2]])/(b[[1]] - a[[1]]); offset = u /. Solve[a[[2]] == dy*a[[1]] + u, u][[1]]; coords = {x, y} /. {Reduce[y == dy*x + offset && x > 0 && y > 0, {x, y}, Integers] // ToRules} (* {{1, 8}, {6, 5}, {11, 2}} *) Graphics[{PointSize[Large], ...


15

First, if you use := in your assignment, then the compilation is not done instantly but every time you call winding2. That's btw the reason why you get the error message when you try to call the function, because it is not compiled until then and the error is a compilation error. Secondly, as the error messages sais, @@ can only be used with Times, Plus or ...


15

A simple numerical maximization using NMaximize as suggested by b.gatessucks: pts = Array[{x[#], y[#]} &, 10]; mindist2 = Min[#.# & /@ Subtract @@@ Subsets[pts, {2}]]; vars = Flatten[pts]; constraints = Thread[0 <= vars <= 1]; {md2, rules} = NMaximize[{mindist2, constraints}, vars]; minimaldistance = Sqrt[md2] (* 0.381759 *) ...


14

As a starting point: ParametricPlot[{ (* modified hypotrochoid *) {Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 t])/4}, (* lemniscate of Bernoulli *) 3/2 {1, Cos[t]} Sin[t]/(1 + Cos[t]^2)}, {t, 0, 2 Pi}, Axes -> None, Background -> ColorData["Legacy", ...


14

If you want to get complete command over the symbol and make it available to various types of geometrical transformations and text styling, you could use FilledCurve function. If splines work for you, FilledCurve may come handy too. If you have or will install the font Poetica Supp Ornaments mentioned in the comments by @Guillochon, then you could turn the ...


14

I have made several pictures very similar to this, using code similar to the one below: MakePic[f_, g_, off_, nlines_, col_, dim_] := Module[{g1, cf, lines}, g1 = ParametricPlot[{f[t], g[t + off]}, {t, 0, 2 Pi}, AspectRatio -> 1, Axes -> None, PlotStyle -> {{col, Thick, Opacity[0.2]}}]; lines = Line@Table[{f[t], g[t + off]}, {t, ...


14

The kite-domino tiling is based the pinwheel tiling which is falls out of a particular decomposition of a right triangle with legs of length 1 and 2. In the code that follows, rt[{a,b,c}] represents such a right triangle and dissect indicates how such a triangle should be decomposed into smaller copies of itself. We simply iterate the dissect function on ...


13

I am not aware of any built-in functionality (I might easily be wrong), but there's an example at MathWorld for calculating intersections of convex polygons. You'd need to approximate the circle with a polygon. Get the notebook from that page: there's an intersection calculation inside that uses the IMTEK Mathematica supplement. Example: << ...


13

The (undocumented!) function Graphics`Mesh`PolygonIntersection[] seems up to the task. Using Sjoerd's example: Graphics`Mesh`MeshInit[]; polys = {Polygon[{{1, 3}, {3, 4}, {4, 7}, {5, -1}, {3, -3}}], Polygon[{{2, 2}, {3, 3}, {4, 2}, {0, 0}}]}; Graphics[Append[{Gray, polys}, {Blue, PolygonIntersection[polys]}]] Disk[] objects are not covered by ...


13

To answer your first question: when in doubt, fall back to basic construction geometry. Fix two points arbitrarily, and "construct" the third by finding the point of intersection of two circles with these points as centers and radii as the sides. Example: sideAB = 4;sideBC = 5;sideCA = 6; ptA = {0, 0};ptB = ptA + {sideAB, 0}; ptC = {x, y} /. Last@Solve[x^2 ...


13

Here's my version. I don't know how fast/slow it is compared to the other solutions, but at least is shortish. spiral[rlist_ /; Length[rlist] >= 2] := Module[{findCentre}, findCentre[zlist_] := Module[{coslst, theta, ind, k}, k = Length[zlist] + 1; coslst = Table[ With[{dist = N@Norm[zlist[[-1]] - zlist[[l]]]}, ((rlist[[k - 1]] ...



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