# Tag Info

13

You can control how the Jacobian is calculated via the Jacobian option: Grid[Module[{s = 0, e = 0}, {#, FindRoot[ArcTan[1000 Cos[x]], {x, 1}, StepMonitor :> s++, EvaluationMonitor :> e++, Jacobian -> #, Method -> {"Newton"}], "Steps" -> s, "Evaluations" -> e }] & /@ {"Symbolic", "FiniteDifference"}] ...

12

Working with such a sophisticated function as Reduce, if we can't get the result initially we should add possibly many assumptions. Without the Backsubstitution option it yielded: Reduce[ Abs[x] + Abs[y] + Abs[z] + Abs[t] == 1 && t != 0, {x, y, z, t}, Reals] No more memory available. Mathematica kernel has shut down. Try quitting other ...

10

We define the function f and multiple constraint functions g1, g2: f[x_, y_, z_] := x y + y z g1[x_, y_] := x^2 + y^2 - 2 g2[x_, z_] := x^2 + z^2 - 2 then, in order to find necessary conditions for constrained extrema we introduce the Lagrange function h with Lagrange multipliers λ1 and λ2: h[x_, y_, z_, λ1_, λ2_] := f[x, y, z] - λ1 g1[x, y] - λ2 g2[x, ...

5

I don't think you need to use any specific tensor functionality. SolveAlways seems to suffice: SolveAlways[ T1 - T3 == a1 T1 + a2 T2 + a3 T3, {T1, T1, T3} ] (* => {{a1 -> 1, a2 -> 0, a3 -> -1}} *)

4

At least you can eliminate $p$: continue[{exprs__}, f_] := Append[#, Switch[Head@f , Rule | RuleDelayed, # /. f & , _, f]@Last@#]& @ {exprs} toRHS[term_][lhs_ == rhs_] := lhs - term == rhs + term multiplyBothSidesBy[x_]@e_Equal := # x & /@ e privateDRule = f_'[x_] :> d[f@x]/d[x]; integrateLocally = u_ d[v_] :> d[u v] - v d[u]; ...

4

In Mathematica 9, it is already implemented under ImageDistance. See Similarity Graph of Images Using Earth Mover Distance.

4

Having an exact input we can find an exact solution: Maximize[{ 5 x^2 + x + 2, -5 <= x <= 5}, x] {132, {x -> 5}} We could simply provide appropriate mathematical tools fulfilling expectations (adequate conditions on derivatives of the function, i.e. vanishing of the first derivative (a critical point) and negativity of the second derivative, ...

4

Reduce[Abs@x + Abs@y + Abs@z + Abs@t == 1 && x < 0 && y z t != 0, {y, z, t}, Reals] || Reduce[Abs@x + Abs@y + Abs@z + Abs@t == 1 && x > 0 && y z t != 0, {y, z, t}, Reals] /. {Less -> LessEqual, Greater -> GreaterEqual} // BooleanMinimize Reduce[Abs@x + Abs@y + Abs@z + Abs@t == 1 && #, {x, y, z, ...

4

One way that works is to solve for one of the variables first. This seems like a natural first step. Perhaps, though, it will be considered a drawback that not all of the absolute values are expanded. We can deal with that later, if desired. Most importantly, though, finding the solution takes less than 0.2 seconds. Reduce[Equal @@ #[[1]], {x, y, z, t}, ...

4

The problem with WhenEvent has to do with the OP's DE. For an event to be detected, there has to be a point at which the condition is crossed, that is, changes from False for t < t0 to True for t > t0. NDSolve then applies a root-finding algorithm to approximate the value of t0 at which the event occurs. In your DE, the solution p1[t] theoretically ...

3

You could try specifying the event differently (this will trigger when the absolute difference between p1 and p2 is smaller than some value): Ad1=10/1000^2; Ad2=1.5*1000^(-2); Ad3=1.5*1000^(-2); Cd1=0.67; Cd2=0.67; Cd3=0.67; V1=10/1000; V2=10/1000; Rho=875; beta=1000*10^6; ps=100*10^5; Q1=Ad1*Cd1*Sqrt[(2/Rho)*(ps-p1[t])]; ...

3

Several syntax errors corrected. You should try to get a better grip on the syntax: mat = {{-(l0 + m0), l0, 0, 0, 0, 1}, {0, -(l1 + l2 + m0), l1, l2, 0, 1}, {0, m1, -(m1 + l2 + m0), 0, l2, 1}, {0, m2, 0, -(m2 + l1 + m0), l1, 1}, {0, 0, m2, m1, -(m2 + m1 + m0), 1}}; p = {p1, p2, p3, p4, p5}; Solve[p.mat == Join[-(l0 ...

3

2 problems: You were comparing, in the WhenEvent, solution, which had complex value at that t, to real numbers. I used Abs. If this does not work for you, you can use Re, but can't compare complex number to real number using >. Second, your system is stiff, need to use StiffnessSwitching to help NDSolve. d1 = 10/1000^2; Ad1 = 10/1000^2; Ad2 = ...

3

First you will need to make your definitions with SetDelayed (:=) rather than Set (=): x := 2 f1 := x^2 + 3 f2 := x + 5 You can get a list of all evaluation steps using Trace or TracePrint. To get only the steps that transform the entire expression use the Option TraceDepth -> 1, and you can format with Row Row[Trace[f1, TraceDepth -> 1], "="] ...

3

You can understand what is happening by comparing: s = Solve[p[[2]] == -q[[2]] && p[[1]] == q[[1]], y1] (* {{y1 -> -(Sqrt[ϵ]/Sqrt[b])}, {y1 -> Sqrt[ϵ]/Sqrt[b]}} *) with: s = Solve[p[[2]] == -q[[2]] && p[[1]] == q[[1]], y1, Reals] (* {{y1 -> ConditionalExpression[-Sqrt[(ϵ/b)], ϵ > 0 && b > 0]}} *) or: s = ...

3

I suppose you have tried your code from a fresh kernel -- sometimes old definitions unexpectedly cause such problems. I find I get the same (correct) approximate zeros from FindRoot in V9.0.1 and V8.0.4. Here's a nice way to get a bunch of zeros using a quick but somewhat sloppy NDSolve to seed FindRoot. (It misses the easy one, z -> 0, though because ...

2

This solution will only work for zeros of odd multiplicity that are spaced far enough apart. We can just look at the sign changes from Plot. Options[FindAllRootsInRange] = Options[FindRoot]; FindAllRootsInRange[e1_ == e2_, {x_, a_, b_}, ops:OptionsPattern[]] := Module[{p, s, g}, p = Plot[e1 - e2, {x, a, b}]; s = SplitBy[ p[[1, 1, 3, 2, 1]], ...

2

You have too many errors to describe each one of them separately. I'll post a working code below, but you should try to learn how to solve problems with Mathematica one step at a time. You had thrown in too much non-working code and your debugging will be always a nightmare programming like that. f0[y_] := 1/(E^((1 + y)^2/2)*Sqrt[2*Pi]) f1[y_] := ...

2

data = {{0, 1}, {1, 1}, {.2, 3}, {.4, 5}, {.6, 2}}; try[x_?NumericQ, y_?NumericQ, data_] := (A (x - y) + B Exp[x - y]) /. FindFit[data, A (xx - y) + B Exp[xx - y], {A, B}, xx] FindRoot[y - try[1, y, data] == 0, {y, 1}] (* {y -> 1.78209} *)

2

I would just notice that $$\frac{d}{dx}(k_0 (\frac{T[x]}{T_0})^n \frac{dT[x]}{dx})=k_0/T_0^n \frac{1}{n+1}\frac{d}{d x^2} T[x]^{n+1}$$ and therefore I'd solve it as below : (* Solve the differential equation and rename the integration constants *) aux = (Tnp1 /. First@DSolve[k0/T0^n 1/(n+1) Derivative[2][Tnp1][x] == 0, Tnp1, x]) /. {C[1] -> a, C[2] ...

1

Here is another way to solve this issue. I know, it is written everywhere, but this is a common mistake to think that the orifice equation is Cd * Ad * Sqrt[ 2/Rho * ( ps - p1[t] ) ] and could give complex results ! There is no physics going imaginary in the real world. The equation is just wrong. When the pressure reverse, the flow reverse, at least. ...

1

Ok, so this is my attempt at a short discussion and solution (after getting a little bit wiser). Due to these equations being stiff (Wikipedia) as pointed out by @Nasser, certain numerical methods have difficulty at tracking the solution, and thus, approximations of the orifice equations yield complex solutions at some point when p1[t]>ps and/or ...

1

Solved it! Here's the code. xi1 = 10; Sigma = 1; f3[z_] = BesselJ[1, xi1/z]*BesselY[0, Sigma/z] - BesselJ[0, Sigma/z]*BesselY[1, xi1/z]; Timing[roots3 = Reap[First[ NDSolve[{x'[z] == f3'[z], x[1] == f3[1]}, {x}, {z, 15, 0.1}, Method -> {"EventLocator", "Event" -> x[z], "EventAction" :> Sow[z]}, MaxStepSize -> 0.001, MaxSteps ...

1

First, it's more convenient to work with true vectors than $1\times n$ or $n\times 1$ matrices ("row vectors" and "column vectors"), so I'm going to rewrite things in that form. p = {p1, p2, p3, p4, p5} Now we can solve like this: Solve[Append[-(l0 + m0) p, 1] == p.mat, p] (* ==> {} *) We get {} which means that there's no solution. What ...

1

For a quadratic function, sometimes the extreme value (max. or min.) occurs at the vertex, at $x = -b/2a$; otherwise, it will occur at one of the endpoints of the interval. In this case $a =5 >0$, so the maximum will occur at an endpoint, the one farthest from the vertex, $x = -b/2a = -1/10$. Thus it will be the right endpoint, $x = 5$. So, in terms of ...

1

opt = {a -> 5, b -> 1, c -> 2}; y = a x^2 + b x + c FindMaxValue[{y /. opt, -5 < x < 5}, x] (* 131.999999424241 *) If you want the x value also, use opt = {a -> 5, b -> 1, c -> 2}; y = a x^2 + b x + c; r = FindMaximum[{y /. opt, -5 < x < 5}, x]; Plot[y /. opt, {x, -5, 5},Epilog->{Red, PointSize[Large], Point[{x ...

1

EDIT In the following the role of f and g have been inadvertently exchanged,i.e. $f(n)=f(n-1)^2+2 g(n-1)^2$ and $g(n)=2 f(n-1)g(n-1)$ Therefore, just exchange. The values can be obtained by defining the recursive functions with suitable starting values for f and g. I present alternatives. It is relatively straightforward to uncouple the relations: ...

1

(This may be better as a comment) This may be an exercise in testing the use of NSolve (which does produce the answer [Version 9]) the normal distribution and StudentTDistribution can be solved with Quantile or InverseCDF, as can be verified by testing solutions. Quantile[StudentTDistribution[2.964, 2.071, 5], 0.95] or ...

1

EDIT ParametricNDSolveValue may be a useful way to explore the parameter space and then you can quantify goodness of fit. Using the same definitions as your original post (with change of variables): fun = ParametricNDSolveValue[{s'[t] == mu*Population - mu*s[t] - beta*(i[t]/Population)*s[t], e'[t] == beta*(i[t]/Population)*s[t] - (mu + alpha) ...

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