Tag Info

Hot answers tagged

45

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


33

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


32

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


31

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


30

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


27

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


26

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}}]; ...


26

The following is based on the fact that the determinant of a matrix is equal to zero when two rows are the same. Thus, if you plug any of the points in, you get a true statement. SeedRandom[3]; pts = RandomReal[{-1, 1}, {5, 2}]; row[{x_, y_}] := {1, x, y, x*y, x^2, y^2}; eq = Det[Prepend[row /@ pts, row[{x, y}]]] == 0 (* Out: ...


25

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


25

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. Equadiff 8, 49 (1994) [pdf] and references therein). However I'm going to implement the simplest method as possible. Just ...


24

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


23

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


21

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


21

I've decided to expand on my comment. Before I delve into the solution, let's all pause for a moment and marvel at the stereographic parametrization of a unit circle: $$\begin{pmatrix}\frac{1-t^2}{1+t^2}\\\frac{2t}{1+t^2}\end{pmatrix}$$ Sometimes also referred to as the Weierstrass substitution, it has often been used as a tool in the solution of algebraic ...


20

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


20

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


20

After all this time, I came up with a very nice tensor calculus proof of the Hairy Ball Theorem. It only depends on Stokes theorem and standard laws of tensor calculus like the Ricci identity and symmetries of curvature tensors. All the topology is done by Stokes theorem. The remainder of the proof is equational, local and geometrical. It is coordinate/basis ...


19

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


19

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_, \[CapitalGamma]___}, u_, r__, o : OptionsPattern[NDSolve`ProcessEquations]] := Module[{ndstate, feData, sd, bcData, methodData, pdeData}, {ndstate} = ...


18

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


18

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


18

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


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

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


18

Update: now it is real ternary plot. You can start with the 2D-adaptation of the surface plotting: texturize[f_, n_, colf_] := # /. Polygon[{v1_, v2_, v3_}] :> {EdgeForm[], Texture@ImageData@Colorize[Image@f[#1, #2, 1 - #1 - #2] &[#, Transpose[#]] &@ ConstantArray[Range[-1./n, 1 + 1/n, 1./n], n + 3], ColorFunction ...


18

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


17

p1 = Partition[{{243.8, 77.}, {467.4, 12.}, {291.8, 130.}, {476., 210.5}, {103.2, 327.}, {245.2, 110.5}, {47.4, 343.}, {87.4, 108.5}, {371., 506.5}, {384.6, 277.}, {264.6, 525.5}, {353.8, 294.5}, {113.2, 484.5}, {296., 304.5}, {459.6, 604.5}, {320.2, 466.5}, {288.2, 630.5}, {199.6, 446.5}, {138.8, 615.5}, {81.8, 410.}, {232.4, 795.}, ...


17

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


17

Since another answer provides misleading results I'm motivated to explain what's wrong there and suggest a correct solution. One can guess that the error there has been produced by DiscretizeRegion or by an improper parametrization of the curve with RegionIntersection (more likely the former reason). Let's start from the begining defining the following ...



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