Tag Info

Hot answers tagged

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


32

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


19

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


16

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


14

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


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

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

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


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


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

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

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


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

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


8

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_] :> ...


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


8

Your data is appended at the end this answer. Setting up (parametrizing your curve): {xs, ys} = Transpose[data]; xi = ListInterpolation[xs, {0, 1}]; yi = ListInterpolation[ys, {0, 1}]; It is a nice looking cake: ParametricPlot3D[{xi[s] Cos[t], xi[s] Sin[t], yi[s]}, {s, 0, 1}, {t, 0, 2 Pi}, Mesh -> False, Axes -> False, Boxed -> False, ...


8

NMinimize[{Norm[{xm[t][p], ym[t][p]} - {xsc[t][p], ysc[t][p]}] /. soln, 0 < t < tmax && 0 < p < 5}, {t, p}, Method -> "SimulatedAnnealing"] (* {71729.9, {t -> 118.095, p -> 5.}} *)


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



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