# Tag Info

46

Consider this: ParametricPlot3D[ RotationTransform[a, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}], {a, 0, 2 Pi}, Evaluated -> True] Now rotate this around a circle, while rotating it at the same time around its' origin: ParametricPlot3D[ RotationTransform[b, {0, 0, 1}][{6, 0, 0} + RotationTransform[a + 3 b, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}]], ...

30

You asked for alternative approaches to what you did, so here is one: A completely different approach to the one-dimensional time-independent Schrödinger equation would be to use matrix techniques. The idea is to eliminate the need for NDSolve entirely. For bound-state problems, you can do this by choosing a basis satisfying the condition of vanishing wave ...

18

We couldn't be really pleased if we didn't exploit existing Mathematica functionality to get exact solutions. Here we provide them with Reduce rewriting the given system to an exact one and using a trick by adding another variable x because one can see that any solutions are described by two different arguments t and t + x. Now we can realize that one can ...

17

I'm adding this answer to put on record an answer to the second part the question, "what is the parametric equation?". The parametric equation is implicit in Kirma's RotationTransform expression. To extract it, one need simply write something like Clear[a, b] quoit[a_, b_] := Evaluate @ RotationTransform[b, {0, 0, 1}][{6, 0, 0} + ...

15

You can get the curve in polynomial implicit form as below. poly = GroebnerBasis[{x^2 - ct, y^2 - st, ct^2 + st^2 - 1}, {x, y}, {ct, st}][[1]] (* Out[290]= -1 + x^4 + y^4 *) To get the area, integrate the characteristic function for the interior of the region. That that's where the polynomial is nonpositive (just notice that it is negative at the ...

13

If the potential is $(\tanh (x)+1) (\tanh (x)-1)$ you can obtain the analytic solution using Mathematica as follows: [I have omitted some of the detail - e.g. the asymptotic expansions - because the details are analogous to the simple harmonic oscillator case in my previous answer (see above).] Define the potential. u[x_] = (1 + Tanh[x]) (-1 + Tanh[x]) ...

12

Since it seems to have not been mentioned yet: yet another way to obtain an approximation of the area of your Lamé curve is to use the shoelace method for computing the area. Here's a Mathematica demonstration: pts = First[Cases[ ParametricPlot[{Sqrt[Abs[Cos[t]]] Sign[Cos[t]], Sqrt[Abs[Sin[t]]] Sign[Sin[t]]}, {t, 0, 2 π}, ...

12

Can be done as follows. (1) Find implicit form from parametric. (2) Solve for pts $(x,y)$ where implicit eqn and gradient simultaneously vanish. (3) Discard those solutions that correspond to cusps. The rest correspond to crossings. The code below handles steps (1) and (2). I found it useful to rationalize because we eventually get an overdetermined ...

12

My defined function next find {nextpoint, nextdirection} value from {startpoint, startdirection} using NSolve. next[{sp_, sd_}][δ_] := Module[{φ, sol, fp, fd}, sol = NSolve[{{x[φ, δ], y[φ, δ]} == sp + t sd, Abs[t] > 10^(-9), 0 <= φ < 2 π}, {t, φ}, Reals]// Quiet; sol = If[Length[sol] > 0, sol[[1]]]; fp = {x[φ, δ], y[φ, δ]} /. sol; ...

11

As Jens mentioned, the spatially discretize the equation is another alternative for bound state problem. Here is my very simple implementation of this approach. The basic idea is express the equation on a grid. The differentials can be expressed as finite differences. For example, the second order derivative can be expressed as $$\frac{d^2\psi}{d ... 11 Concerning the comment about creating the surfaces, sure: Mathematica is one of the best tools available for that. Here's the Klein bottle, for example. ParametricPlot3D[{ (3 + Cos[v/2]*Sin[u] - Sin[v/2]*Sin[2 u])*Cos[v], (3 + Cos[v/2]*Sin[u] - Sin[v/2]*Sin[2 u])*Sin[v], Sin[v/2]*Sin[u] + Cos[v/2]*Sin[2 u]}, {u, -Pi, Pi}, {v, 0, 2 Pi}, Axes -> ... 10 For this, you could use the answer by J.M. to the question "Extruding along a path". The question here isn't a duplicate because it makes use of features in J.M.'s excellent answer that go beyond what the linked question actually asked for. In particular, that answer can deal with self-intersecting cross sectional curves, which is what you need for this ... 10 I guess I know what you've encountered. The model doesn't print correctly though it looks OK in Mathematica, right? Specifically speaking, nothing seems to be wrong when you plot the object in Mathematica: ParametricPlot3D[{Cos[v]*(3 - u) + .25*Sin[4 u], Sin[v]*(3 - u) + .25 Sin[4 u], u}, {u, 6, 13}, {v, 6, 13}, PlotStyle -> {Thickness[.3], ... 9 Finding the whole solution set Inspired by @Szabolcs idea, you can let Reduce solve this problem with the help of existential quantifiers: Reduce[ ForAll[x, 5 x^3 + z + x z + x^2 (1 + z) == 0 \[And] Im[z] == 0, Re[x] < 0], z] It immediately affirms your conjecture: (* z > 4 *) This problem formulation via ForAll can be read as: Reduce the ... 9 Here is a symbolic solution of your eigenvalue problem. Define the differential equation (setting \hbar = \omega = m_0 = 1). diffeq = -(1/2) \[Psi]''[x] + 1/2 x^2 \[Psi][x] == e \[Psi][x] Symbolically solve the differential equation. soln = DSolve[diffeq, \[Psi], x][[1, 1]] (* \[Psi] -> Function[{x}, C[2] ParabolicCylinderD[1/2 (-1 - 2 e), I ... 9 I upvoted the response by @J.M. and was tempted to leave it at that. This is similar but automates the process a bit further by explicitly implicitizing (is that an oxymoron?) the tori. Somehow I think that step deserves mention since it can be a useful thing in its own right. We start with code to take the trig parametrized tori and find algebraic implicit ... 9 I just finished blog post about the creation of nice graphics from Mathematica Graphics3D using the Blender render framework: http://wolfig-techblog.blogspot.de/2015/04/blender-as-shader-for-mathematica.html Maybe you can find some inspiration there for your own graphics. I managed to generate a reasonable Klein bottle with glass shading: Note: the ... 9 Probably this match your plot: ParametricPlot[{r {r k2, v1}}, {s1, 0.0, 50}, {r, 0, 1}, PlotRange -> {{0, 0.3}, {0, 1.5}}, AspectRatio -> 0.5, BoundaryStyle -> Directive[Black, Thick], Mesh -> 100, MeshFunctions -> (50 #1 - #2 &)] 8 Third solution A slightly simpler and more geometric approach leads to a third form for the solution (including Artes' and my second) -- don't you just love trigonometric functions! By symmetry, two points starting from a vertex of the hypocycloid (star) and going in opposite directions at the same speed will meet at one of the desired crossings. If the ... 8 If you're happy with an approximate solution, you can use NSolve[]. As I mentioned in an answer to an earlier question of yours, GroebnerBasis[] can be used for parameter elimination. Let's do that for your three "tori": t1 = First @ GroebnerBasis[Thread[{x, y, z} == Rationalize[torus1[a, b]]] ~Join~ {Cos[a]^2 + Sin[a]^2 == 1, ... 8 One can use one of the line integral forms of the area, derived from Green's Theorem:$$A = \frac12 \int_C x \; dy - y \; dx = \int_C x \; dy = - \int_C y \; dx The first one is symmetric, which sometimes is an advantage. c[t_] := {Sqrt[Abs[Cos[t]]] Sign[Cos[t]], Sqrt[Abs[Sin[t]]] Sign[Sin[t]]} dA = 1/2 c'[t].Cross[c[t]] (* complicated output *) One ...

8

You've already done the hard work in putting the path together. Now you could just do a quick and dirty interpolation and FindRoot. rex = Interpolation[Thread[{Range@Length@pathre, First /@ pathre}]]; rey = Interpolation[Thread[{Range@Length@pathre, Last /@ pathre}]]; imx = Interpolation[Thread[{Range@Length@pathim, First /@ pathim}]]; imy = ...

7

Similar to @ybeltukov, you can extract the lines from the plot. But to get a proper polygon, you need to reverse one of the lines. plot = ParametricPlot[{{u + Sin[u], -Cos[u]}, {u + Sin[u + Pi], Cos[u + Pi]}}, {u, 0, Pi}, Axes -> True]; {line1, line2} = Cases[plot, l_Line :> First@l, Infinity]; Graphics[ {Opacity[0.4], Darker@Blue, ...

7

Complex roots come in pairs therefore the equation will have a single real solution only if it has a real double root and two complex root or if it has a quadruple root. So we require poly = -4 l^2 + 4 l^2 x + (5 - l^2) x^2 - 4 x^3 + x^4 Solve[{poly == 0, D[poly, x] == 0}, {x, l}, Reals] This gives us three solutions for l: {0, -((2 + ...

7

This is an old (and possibly abandoned) question; however, its solution involves a number of issues related to NonlinearModelFit and ParametricNDSolveValue that show up on this site and it's perhaps constructive to look at this problem as a case study. Rescaling the fit data We wish to fit the following data: fitdata = {{1962, 0}, {1963, 0.9}, {1964, ...

7

--- edit --- I forgot to address an issue which I now see was raised in a comment by @Michael E2. This setup is only going to give a tangent circle. If it osculates it is largely by accident. (Outright snogging, now that might be intentional.) --- end edit --- The issue is that these curves need not intersect at the same value of the parameter. So you can ...

7

You need to define partial sums (I will use Simon's definition in the comments which is faster than my older one): Manzoni[n_, y_] := Transpose@{Re@#, Im@#} &@Accumulate[Range[n]^-(.5 + y I)] The thing worth attention here is 1/k^(.5 + I y) - meaning 0.5 which makes it automatically numeric before the sum is taken. If you would keep 1/2 and wrap ...

7

Just for fun: f[a_, t_] := a {t - Sin[t], 1 - Cos[t]} Manipulate[ ParametricPlot[{f[1, 4 t], f[2, 2 t], f[4, t]}, {t, 0, 4 Pi}, PlotStyle -> {Red, Green, Blue}, Epilog -> {{Orange, Circle[{4 p, 1}, 1], Black, PointSize[0.015], Point[f[1, 4 p]]}, {Orange, Circle[{4 p, 2}, 2], Black, PointSize[0.015], Point[f[2, 2 p]]}, {Orange, ...

7

Consider A = {{1, 2}, {3, 4}}; B = {{5, 6}, {7, 8}}; Then ParametricPlot[ { {Cos[θ], Sin[θ]}.A.{Cos[θ], Sin[θ]}, {Cos[θ], Sin[θ]}.B.{Cos[θ], Sin[θ]} }, {θ, 0, 2 π}] Or more generally, A = {{1, 2}, {3, 4}}; B = {{5, 6}, {x, 8}}; ParametricPlot[ Table[{{Cos[θ], Sin[θ]}.A.{Cos[θ], Sin[θ]}, {Cos[θ], Sin[θ]}.B.{Cos[θ], Sin[θ]}}, ...

7

To fill with a solid color, you can post-process the Line primitive into a Polygon ParametricPlot[{k2, v1}, {s1, 0.0, 50}, PlotRange -> {{0, 0.3}, {0, 1.5}}, AspectRatio -> 0.5, PlotStyle -> Black] /. Line[x_] :> {Blue, Polygon[x]} Update: Using the approach in this answer mentioned in Alexey's comment: poly = Cases[pp, Line[x_] :> ...

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