# Tag Info

44

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

29

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

22

Here is another approach. It could be improved (I am sure) to properly determined the principle axes and translation (if I get time I will aim to update): lin = {#1^2, #1, #2, 2 #1 #2, #2^2} & @@@ points; lm = LinearModelFit[lin, {1, a, b, c, d}, {a, b, c, d}] Exploring model: lm["ParameterTable"] Determining quadric formula: pa = ...

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

15

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

In analytic geometry, the ellipse is defined as the set of points (X,Y) of the Cartesian plane that, in non-degenerate cases, satisfy the implicit equation with and where Lets fit points with second-order curve (which include ellipse). elipse = a11*x^2 + a22*y^2 + 2*a12*x*y + 2*a13*x + 2*a23*y + a33; coeff = {a11, a22, a12, a13, a23, a33}; ...

14

Here is a standard direct way to get the principal exes and other transformation data. Find the mean of the points, subtract it to center them, and take the singular value decomposition. The third and second components thereof give the rotation and scaling data necessary to form a circle on which the first component, viewed as a point set, roughly lies. The ...

13

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

11

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

10

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

10

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

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

10

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

The approach mentioned in my comment using a polar representation: r[ a_, b_, theta_, t_] := a b/Sqrt[b^2 Cos[theta] Sin[2 t] - a^2 Sin[2 t] Sin[theta]^2 + (a^2 + b^2) Sin[t]^2 Sin[theta]^2 + Cos[t]^2 (b^2 Cot[theta]^2 + a^2 Sin[theta]^2)]; some random sample data: data = With[ {a = 1, b = 1/2, theta = Pi/3 , x0 = 1, y0 = 1} , ...

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

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

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

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

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

Clear["Global`*"] f[x_, \[Theta]_] = RotationTransform[\[Theta], {1, 0, 1}, {5 Pi, 0, 5 Pi}][{x, 0, -((10 Pi)/6) Sin[x] + 5 Pi}][[{1, 3}]]; p1 = ParametricPlot[{x, x}, {x, -10 Pi, 10 Pi}, PlotRange -> {{-10 Pi, 10 Pi}, {-10 Pi, 10 Pi}, {-10 Pi, 10 Pi}}, ImageSize -> 300, Axes -> True]; n = 7; g[a_] := Evaluate[ t^(1/n) (5 a ...

8

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

7

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

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

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