# Tag Info

0

Going through this solution, it looks like that function f in FindMinimum[f,x] should be declared to have numerical parameters. Ivan's answer indicated this too. Essentially, for the parametric function route to work, one needs: func[k1_, k2_, k3_] := Total[(ci - Through[pfun[k1, k2, k3][ti]])^2, 2] /; And @@ NumericQ /@ {k1, k2, k3}; ...

2

Define this function: f[k1_?NumericQ, k2_?NumericQ, k3_?NumericQ] := Sum[Total[(ci[[i, All]] - Map[pfun[k1, k2, k3][[i]], ti])^2], {i, 1, 3}] // Quiet Then, fit = NMinimize[f[k1, k2, k3], {k1, k2, k3}]; params = fit // Last (*{k1 -> 0.000194805, k2 -> 0.0291469, k3 -> 0.109229}*) Plot it, Table[Show[ ListPlot[Transpose[{ti, ci[[i]]}]], ...

3

I just wanted to point out that all the routes above will work if there is only one differential equation: data = NDSolveValue[{ x''[t] - k1*(1 - x[t]^2)*x'[t] + k2*x[t] == 0, x[0] == 2, x'[0] == 0} /. {k1 -> 1., k2 -> 1.}, Table[{t, x[t] + RandomReal[{-.3, .3}]}, {t, 0, 10, .2}], {t, 10}]; dataT = data\[Transpose]; ti = dataT[[1, ...

3

Your code has three major flaws: Since a, b , c , d are numbers you cannot pass the step k to them. This syntax is for functions. Print[k] should be used before changing the "the number of iterations" (k=k+1) . Your code does not allow enough iterations to bracket the minimum (n is small). You may also use internal Fibonacci function, instead of ...

1

LinearProgramming will work but you need the values for the parameters as it is not a symbolic algorithm. Constructing the parameters for LinearProgramming will give: c = Flatten@{{1, 0, -1, 0}, {0, 1, -1, 0}, {0, 1, -1, 0}, {0, 1, -1, 0}}; This corresponds to the minimisation problem. I use the matrix form and then flatten to assist with translating. ...

0

The Print statement requires that the output from PaddedForm be converted to a String. Additionally, the second and third Module statements cause problems and seem unnecessary. With them deleted, the second half of the code can be rewritten as While[ (b - a) > ϵ, If[ f[x2] > f[x1], bright = x2; b = x2; x2 = x1; x1 = bleft + ρ*(bright - ...

1

Select ItemNumbered text cell in the Format > Style pulldown menu.

4

Here's a simple way to enumerate all the conditions: fs = {x, y, z, 0}; conds = Table[{Equal @@ fs1, And @@ Table[First@fs1 >= f, {f, Complement[fs, fs1]}]}, {fs1, Subsets[fs, {2}]}] (* {{x == y, x >= 0 && x >= z}, {x == z, x >= 0 && x >= y}, {x == 0, x >= y && x >= z}, {y == ...

2

Just use NMaximize yRx1[a_, b_] := y /. #2 & @@ NMaximize[{Rx1[y, a, b], y > 0}, y] Example: yRx1[1, 1.5] (*0.903322*)

3

It seems to be a bug, that manifests because of the fact that the answer could be positive or negative. If you look at the Trace of this operation, with TraceInternal -> True, you can see that it gets as far as finding the answer as a rounded version of $\pm720000\sqrt{6}$. It has candidate solutions of either Ceiling[-720000 Sqrt[6]] or Floor[720000 ...

0

I am not exactly sure, but I think it is happening because of a poor starting point (probably coming from the default algorithm) which is not giving any convergence. As a result Mathematica is giving the only possible output - the input itself. A possible alternative can be defining a starting point with FindMaximum FindMaximum[{n^2, n^2 <= ...

2

I take it you are interested in the minimum in the absolute value of the difference Abs[f[x]-c g[x]]. Otherwise, the answer is trivial: c=-Infinity. Let us define the functions: f[x_] := (-1 + x) Log[1 - x] - x Log[x]; g[x_] := Log[1 + 2 (-1 + x) x]; w[x_, c_] := f[x] - c*g[x]; and plot them: Manipulate[Plot[w[x, c], {x, 0, 1}], {c, -3, -0.1}] ...

3

Before I begin, a quick note. In the problem as stated, the optimal value of c is $-\infty$, since that makes the value of $f-(-\infty)g=f-\infty=-\infty$ (since $g<0$ for all $x\in(0,1)$). I'll instead work the problem of minimizing $|f-cg|$. First we can evaluate the Maximize statement, just to see what we get: Maximize[{Abs[f[x] - c g[x]], 0 < x ...

0

This could also be an example for InfinitLine. If your line is a vertical line the intersection is just the function value, i.e.{x,f[x]}. Given p1 = {1, 1}; p2 = {2, 3}; and f[x_] := Sqrt[4 - x^2] one can define line = InfiniteLine[p1, p2] and calculate the intersection points via sols = NSolve[{x, y} \[Element] line \[And] {x, f[x]} \[Element] ...

0

There is no missing point for the function as defined. g[-2] is not defined an returns undefined. Mathematica just joins. Plot[g[x], {x, -6, 6}, Exclusions -> {-2}] is the appropriate plot of function Consider also: Limit[g[x], x -> -2, Direction -> 1] Limit[g[x], x -> -2, Direction -> -1] The following achieves aim of second set of ...

2

Isn't this is a problem of mathematics more than programming? Under the stated conditions, by permutation symmetry of the indexes of $v$ all entries of $v$ should be the same (up to absolute value, because in the problem statement all elements are squared). Thus one answer is $v$ is an array of $c$ entries each of which is $n/c$. This solution is ...

1

You're like 99% of the way there. You just need to tell Mathematica that z is a vector by feeding it the components: With[{z = Array[v, 3]}, Minimize[{Total[z^4]/Total[z^2]^2, Total[z] == n}, z]] For dimensions 1 and 2 the answers are as expected. For 3 (the code above) Minimize outputs a bunch of ugly Roots. So although there is a symbolic solution, ...

Top 50 recent answers are included