# Tag Info

48

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

39

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

23

The plan is first get the "external" contour and then use Green's theorem to find its area. r[t_] := {-9 Sin[2 t] - 5 Sin[3 t], 9 Cos[2 t] - 5 Cos[3 t], 0} (*find the intersections*) tr = Quiet@ToRules@Reduce[{r@t1 == r@t2, 0 < t1 < t2 < 2 Pi}, {t1, t2}]; pt = {t1, t2} /. {tr} // Flatten; pts = SortBy[pt, N@# &]; pps = Partition[pts, 2]; Now ...

21

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

18

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

17

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

16

ColorFunction and Epilog were around in version 7. However, ColorFunction did get an update in version 9 so I am not certain if this will work in version 7. Animate[ ParametricPlot[circle[t], {t, Max[0, u - .2], u}, PlotRange -> {{-dMax, dMax}, {-dMax, dMax}}, ColorFunction -> Function[{x, y, w}, Opacity[w, Blue]], Frame -> True, Axes ...

15

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

14

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

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

13

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 ... 12 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 ... 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 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 -> ... 11 Okay, this'll be a short answer just to show what you can do. What you are trying for here is essentially an inverse to FrenetSerretSystem, which will give the curvature and basis vectors from the parametric equations. We have these equations for the tangent vector, the normal vector, and the binormal vector \begin{align} \dfrac{d\mathbf{T}}{ds} &= ... 11 s = ParametricNDSolveValue[{x'[t] == -y[t] + x[t]*Log[x[t]], y'[t] == x[t] + y[t]*Log[x[t]], x[0] == x0, y[0] == 0}, {x, y}, {t, 1}, x0] f[x0_, t_] := Through[Through[s@x0]@t] pts = Table[f[x0, t], {x0, 1, 2, .2}, {t, 0, 1, .1}]; Show[Graphics[{Green, Arrow /@ pts, Black, Point /@ pts}, ... 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 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 &)] 10 I have reworked your code somewhat. I hope what I have done will help you with your problem. BezierDefinition[pts_, u0_?NumericQ] := Nest[MovingAverage[ArrayPad[#, 1], {u0, 1 - u0}] &, {1}, Length[pts] - 1].pts ClearAll @ CAGDBezierCurve; Options[CAGDBezierCurve] = {SplineClosed -> False, SplineDegree -> Automatic, ControlPoints -> ... 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 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 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 ...

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

The main issue is simply that your constraint should not be imposed after the integration of the field lines, but beforehand. This means that we should choose the starting points from which the differential equations of the field lines are integrated to lie on the desired cylinder right from the beginning. Then, all you have to do is to impose the ...

9

Method 1: unconstrained regions You can easily do it with regions: ℛ = ParametricRegion[{a^2 + b^2, a c + b d, d^2 + c^2}, {a, b, c, d}]; RegionPlot3D[ℛ, Axes -> True] or ineq = RegionMember[ℛ, {x, y, z}] (* (x | y | z) ∈ Reals && ((y == 0 && x >= 0 && z >= 0) || (z > 0 && -y^2 + x z >= 0)) *) ...

9

I suspect that there simply isn't a nice equation of the form $y = f(x)$ for these curves. As you note the equation for $x_d$ involves both algebraic and trigonometric terms, and almost all such equations are transcendental (i.e., no solution in the form of "elementary functions".) Mathematica can, however, construct inverse functions that it can use ...

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

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

8

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