# Tag Info

10

So you guys know - quasicrystals are cool structures that can consist of finite number of parts which can be arranged in never repeating - aperiodic - pattern. Thing here is called projection method from a regular lattice. http://www.nature.com/nmat/journal/v3/n11/fig_tab/nmat1244_F3.html Interestingly if you know Fibonacci rabbits problem - that is also ...

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

6

You can do this without a NDSolve by calculating the distance from the follower cranks joint to the end of the driving cranks end. Then use this distance with law of cosines to calculate the deviation angle. This is also pretty easy to implement on ANY hardware capable of doing a ArcCos and Atan2 operation (note that in c atan2 parameters are swapped). ...

6

Overdetermined systems of differential equations can have any solutions only if they satisfy certain compatibility conditions, therefore in general one shouldn't expect that any solutions necessarily exist. For differential equations of the first order one can impose initial conditions in the form of values of unknown functions (at certain points for ODEs) ...

5

Another way is to use Maximize rather than solving for the zero of the derivative. f[x_] = (r ω^2 Sin[x] Cos[x])/(g - ω^2 (Cos[x])^2 r); as = {r > 0, ω > 0, g > 0, r ω^2 < g}; You can see that f[x] // TrigReduce (* -((r ω^2 Sin[2 x])/(-2 g + r ω^2 + r ω^2 Cos[2 x])) *) therefore you can make a simple substitution and, assuming the ...

5

Ok, here is my take on it. Your equation appears to be a stiff one, given your initial condition in s. General First observation is that you can integrate your equation exactly. To do this, make a substitution: $\phi(s) = s'(t)$ Then, you have $s''(t) = \frac{\partial}{\partial{t}}\phi(s) = \frac{\partial\phi}{\partial{s}} \frac{\partial ... 5 I Let's write down an appropriate system we would like to solve, i.e. we are to maximize a^3 + b^3 + c^3 knowing that a + b + c == 5 and 1/a + 1/b + 1/c == 1/5, thus the most direct approach uses Maximize with adequate conditions: Maximize[{a^3 + b^3 + c^3, a + b + c == 5, 1/a + 1/b + 1/c == 1/5}, {a, b, c}] {125, {a -> 1, b -> 5, c -> -1}} ... 5 Since Mathematica offers powerful symbolic capabilities I find that more effective solution to the problem uses exact numbers instead of machine precission ones and consequently appropriate symbolic functions. The given matrix m: m = {{0.04 - 0.4 b, 0, 0.04 - 0.4 b}, {0, -0.08 - 1.2 b, -0.06 - 0.9 b}, {1.04 - 0.4 b, 2.08 - 0.8 b, 0}}; we ... 4 Here you are with the bands -- note also an (I think) improvement over the brute force fine discretization of the line: (I'm Not sure if that improved performance, but it didn't hurt and it looks cleaner) caveat I think my little trick thinning down the lndat list is not guaranteed to find all of the strictly nearest points. It seems to work for the ... 4 eqns = {d == (1* c*(f/130))/(1 + (f/130) + (d/50)) - (c*(d/10))/(1 + (f/ 130) + (d/50)) + a/(1 + (a/100) + (d/100) + (f/80)) - d/(1 + (a/100) + (d/100) + (f/80)), a == (c*(d/10))/(1 + (f/130) + (d/50)) - a/(1 + (a/100) + (d/100) + (f/80))}; exprs = Numerator[Together[Subtract @@@ eqns]] (* Out[4]= {-260000 a + 520000 d - ... 3 You can reformulate this as a objective function minimisation problem, where you minimise the sum of the squares of the left hand sides of your equations. Here is how to do this with NMinimize, trying all of the optimisation methods that are mentioned in the documentation: {#, NMinimize[(a^10 E^-a - b^10 E^-b)^2 + ((362880. + a (362880. + ... 3 I did not see there is an easy way to do it within DSolve. But for ODEs which could be integrated directly, using Integrate would be a possible choice to get the implicit solution. For the problem mentioned, it could be integrated directly by Integrate[ Integrate[ (1 + G (A + y[x])^3) y''[x] + 3G (A + y[x])^2 (y'[x])^2 + R, x] - C[1], x] - C[2] == 0 ... 3 There are no solutions as shown by Solve: {eq1, eq2, eq3, eq4} = { a*Log[b + d] == 20, a*Log[b*30^c + d] == 125, a*Log[b*180^c + d] == 710, a*Log[b*360^c + d] == 1350 }; Solve[{eq1, eq2, eq3, eq4}, {a, b, c, d}] (* {} *) To show why there are no solutions over the reals, let's investigate a little further. First let's define our own Solve ... 3 Numerical approach according to Jens' comment : pde = D[u[x, t], t] - 0.2 D[u[x, t], {x, 2}] == 0; g[x_] := 1/(1 + x^2)^0.25; sol = NDSolve[{pde, u[x, 0] == g[x], u[-10, t] == u[10, t] == g[10]}, u[x, t], {x, -10, 10}, {t, 0, 20}] Plot3D[u[x, t] /. sol, {x, -10, 10}, {t, 0, 20}, AxesLabel -> {Style["x", Italic, Red, 20], ... 3 You don't have to calculate thing by hand in MMA. Use D and Cross to formulate expectations. One solution can be found analitically: ClearAll[a, b , p1, p2, c] p1[t_] := (a Cos[t]^2 + b)*{Cos[t], Sin[t]} p2[t_] := c*{Cos[t] + 1, Sin[t]} Solve[{ Cross[D[p1[t], t]].D[p2[t], t] == 0, p1[t] == p2[t], 0 <= t <= Pi/2, c > 1 }, {t, c}, ... 3 You can display zero crossing using MeshFunctions. Here is a clumsy exploitation from created graphic. The half-periods (difference between consecutive points) are displayed below with mean in red. x1plot = ListPlot[x1data, AxesLabel -> {"t", "x1"}, Joined -> True, MeshFunctions -> (#2 &), Mesh -> {{0.}}, MeshStyle -> {Red, ... 3 This system of equations is overdetermined: In[27]:= Solve[(10*^3 == 1/(2*Pi*Sqrt[10000*r2*c1*c2])) && (20 == 3*Sqrt[r2*c2]/Sqrt[10000*c1]) && (3 == Sqrt[r2/10000]*Sqrt[c1*c2]/(c1 + c2)), {c1, c2, r2}, Reals] Out[27]= {{c1 -> 3/(4000000000 π), c2 -> 11/(12000000000 π), r2 -> 4000000/11}} Just using the first three ... 3 An alternative is to recognize that the product of the eigenvalues is equal to the determinant. Hence: m = {{0.04 - 0.4 b, 0, 0.04 - 0.4 b}, {0, -0.08 - 1.2 b, -0.06 - 0.9 b}, {1.04 - 0.4 b, 2.08 - 0.8 b, 0}}; Roots[Det[m] == 0, b] Since the Det is a 3rd order polynomial, there are three zeros, which occur when b == 2.6 || b == 0.1 || b == ... 2 Short Answer Clear[Derivative] first. Long Answer OK, it's surprising that there seems to be no regular answer to this common problem for beginners, let me elaborate my comment into an answer. If you restart your Mathematica and run your code again then you'll find your problem no longer exists anymore! Then, why? Because Mathematica is unstable? Of ... 2 Combined symbolic and numeric calculation can be hard to deal with. You may do the symbolic part first and then do the substitution, or do the pure numeric integration NItegrate many times. Integrate[(n3 + s^2/(2 r))*(c e n)/(g r^(2/3) (s/lb (end - beg) + beg)^(4/3)), {s, 0, lb}][[1]] Output: (3 c e lb n (beg^( 1/3) (5 beg + 6 beg^(2/3) end^(1/3) + 3 ... 2 Here is a 'cheat': p1 = Plot3D[V[x, 0, z], {x, -1.01, 1.01}, {z, 0, 0.6}, MeshFunctions -> (#3 &), Mesh -> {{E0}}, MeshStyle -> {Red, Thick}, PlotPoints -> 100] You can then extract the desired mesh points from the object: lns = Cases[p1, Line[x_] :> x, Infinity]; gr = Graphics[{Red, Thick, Line[(p1[[1, ... 2 Using a finer grid in the loop (e.g. 0.0001) helps to reduce the gap in the middle. If we do not join the data points and give different colors to your neg and pos lists, we see that something strange happens for small$z_0$: Your equation has 4 solutions (two negative, two positive), so just using the first or the second argument wont pick the smallest or ... 2 Mathematica can handle it. Use reduce for non-linear / non-polynomial Your equations: eqs = -(0.35 - b)/sigma == 9.8602 && A*Exp[-(0.35 - b)^2/(2*sigma)] == 0.150099 && A*Exp[-(0.55 - b)^2/(2*sigma)] == 0.895049; Your solutions: Reduce[eqs, {A, b, sigma}, Reals] // Quiet A == 27.5999 && b == 1.40764 && sigma ... 2 Alternate answer, this is an exact analytic approach to the nearest point problem: (not i think precisely what @martin was after, but its an interesting problem and others may find it useful) lb = -1;ub = 1; pts0 = Select[Flatten[ Table[ {i, j}, {i, 2 lb, 2 ub , .2}, {j, 2 lb , 2 ub , .2}], 1] ,Norm[#] < 1 &]; intv[ p_, pn_] := If[(pn[[1]] != ... 2 Plot[ First@ FindMinimum[{ 2/Sin[th] + 2/Sin[ Pi - (alpha Degree) - th] , 0 < th < Pi - alpha Degree} , th] , {alpha, 45, 135}, PlotRange -> {0, Automatic}] Your NSolve approach works as well, the key is to limit the range: NSolve[{ D[2/Sin[th] + 2/Sin[Pi - 100 Degree - th], th] == 0, Pi - 100 ... 2 rectangle[{r1_Rule, r2_Rule}] := (#~Join~First@Solve[ (e1 e2 == area) /. # , First@Complement[ {area, e1, e2}, First /@ #] ]) &@{r1, r2} rectangle[{e2 -> 3, e1 -> 2}] {e2 -> 3, e1 -> 2, area -> 6} rectangle[{area -> 12, e1 -> 2}] {area -> 12, e1 -> 2, e2 -> 6} 2 Here is a way of finding the general solution of your equations: Define the expressions expr1 = (2 + 12*s)/(9*x^2) + (4*Sqrt[2*s])/(9*x^2*y) - (4*Sqrt[2*s])/(9*x^3) - k; expr2 = (1 + 3*Sqrt[2*s] - 6*s)/(9*y^2) + (2*Sqrt[2*s])/(9*y^2*x) - (2*Sqrt[2*s])/(9*y^3) - k; Solve for y in terms of x. ysol = Solve[expr1 == 0, y] (* {{y -> (4 Sqrt[2] Sqrt[s] ... 2 It is a minor syntax problem. This: deq2 = DSolve[{T1''[t] == -1.062880475*10^7*T1[t] + 845.813407*T2[t], T2''[t] == 281.937803*T1[t] - 1.135556134*10^6*T2[t] - 1.807293611*10^6*T3[t] + 854.700858*(1 - 555.5555556*t)*Exp[-194.4444444*t], T3''[t] == -1.036565839*10^10*T3[t] - 6.506256977*10^9*T2[t], T1[0] == 0, T1'[0] == 0, T2[0] == 0, T2'[0] == ... 2 I know it doesn't answer your question directly, but with the definition above, your function H[n] asymptotically approaches 1 pretty fast regardless of the starting value H[0]: (* Generates a table for the first 20 values of H given H[0] == alpha *) f[alpha_] := Module[{H}, H[0] = alpha; H[n_] := H[n] = H[n - 1] (1 + .7 (1 - H[n - 1])); Table[H[n], ... 2 You could also just program iteratively: f[{x_, y_}] := With[{ch = {1, 0.7 x}.{x, y}}, {ch, 1 - ch}] hdt[p_, n_] := Transpose@NestList[f, {p, 1 - p}, n] If you just want$\{H(n),h(n)\}$for starting values$\{H(0),h(0)\}=\{p,1-p\}\$: hd[p_, n_] := Nest[f, {p, 1 - p}, n]; Visualizing: lp[p_] := ListPlot[hdt[p, 10], Joined -> True, PlotMarkers -> ...

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