# Find value of parameter such that the maximum value of a function satisfies a condition

I have defined a function x3 as follows:

F0 = 31.6*1000 (*N*);
t1 = 0.0109 (*s*);
m = 4200(*kg*);
force[τ_] :=
Piecewise[{
{F0 τ/(t1/2), 0 <= τ < t1/2},
{2 F0 (1 - τ/t1), t1/2 <= τ < t1},
{0, t1 <= τ}}
]

x3[t_, k_]:=
Integrate[1/m force[τ] 1/Sqrt[k/m] Sin[Sqrt[k/m] (t - τ)], {τ,0, t1/2},
Assumptions -> t1 ∈ Reals ] +
Integrate[1/m force[τ] 1/Sqrt[k/m] Sin[Sqrt[k/m] (t - τ)], {τ,t1/2, t1},
Assumptions -> t1 ∈ Reals] +
Integrate[1/m force[τ] 1/Sqrt[k/m] Sin[Sqrt[k/m] (t - τ)], {τ, t1, t},
Assumptions -> {t > t1, k > 0}]


Now I have to find the minimum value of the parameter $k$ such that the maximum value of x3[t, k] is less than $0.001$. I would personally also like to see a plot of the function, but I can't get that far.

I tried the following code:

NSolve[FindMaximum[x3[t, k], t] <= 0.001, k]


where my idea was to find the maximum value of x3 for arbitrary $t$. Yet this doesn't work as I imagined (actually it doesn't work at all!).

• force is not defined. You mention the variable F0 but it is not used. Can you update the question. Commented Apr 10, 2016 at 14:35
• @JackLaVigne yes, my mistake! The example above should be complete now. Commented Apr 10, 2016 at 14:38
• Skrat, as mentioned in the answer to your other question, you probably should also define x3 using Set (=) rather than SetDelayed (:=), so you don't recalculate the integral every time x3 is evaluated. Commented Apr 10, 2016 at 16:35

First, using the rest of your definitions, redefine x3 using Set so that it doesn't recompute the integral for each evaluation:

Clear[x3]
x3[t_, k_] = Simplify[
Integrate[1/m force[τ] 1/Sqrt[k/m] Sin[Sqrt[k/m] (t - τ)], {τ, 0, t1/2}, Assumptions -> t1 ∈ Reals] +
Integrate[1/m force[τ] 1/Sqrt[k/m] Sin[Sqrt[k/m] (t - τ)], {τ, t1/2, t1}, Assumptions -> t1 ∈ Reals] +
Integrate[1/m force[τ] 1/Sqrt[k/m] Sin[Sqrt[k/m] (t - τ)], {τ, t1, t}, Assumptions -> {t > t1, k > 0}]
]

(*Out:
(1/(k^(3/2)))(-3.75764*10^8 Sin[0.0154303 Sqrt[k] (-0.0109 + t)] +
7.51528*10^8 Sin[0.0154303 Sqrt[k] (-0.00545 + t)] -
3.75764*10^8 Sin[0.0154303 Sqrt[k] t])
*)


Let's plot x3 for a few values of k, randomly chosen:

Plot[
Evaluate@Table[
Tooltip[x3[t, k], k],
{k, PowerRange[1, 1000, 2]}
],
{t, 0, 50},
PlotRange -> All,
PlotLegends -> ("k = " <> ToString@# & /@ PowerRange[1, 1000, 2])
]


It is clear from the plot, if not from the expression for x3, that the higher the value of $k$, the smaller the period of the function, and the lower the maximum amplitude.

Some more exploration using the plotting expression shown above and adjusting parameters by hand indicates that the minimum $k$ value for which x3[t, k] has a maximum under $0.001$ is close to 6,000,000.

Now that we have a good starting point, we can use FindRoot to obtain a more accurate result:

Clear[nmax]
nmax[k_?NumericQ] := NMaxValue[x3[t, k], t]
FindRoot[nmax[k] == 0.001, {k, 6000000}]

(* Out: {k -> 7.00376*10^6} *)


Update for damped oscillation:

As you mentioned in comments, you are now interested in:

x3[t_, k_] = Simplify[
Integrate[
F0/(t1/
2) 1/(m ω0D) Exp[-δ ω0D (t - τ)] τ Sin[ω0D (t - τ)], {τ, 0, t1/2}
] +
Integrate[
2 F0 (1 - τ/
t1) 1/(m ω0D) Exp[-δ ω0D (t - τ)] Sin[ω0D (t - τ)], {τ, t1/2, t1}
]
]


This expression also leads to a closed-form integral, so the method outlined above should work as well.

Again, let's identify a reasonable range for our search using plotting:

Plot[
Evaluate@
Table[Tooltip[x3[t, k], k], {k, PowerRange[1000000, 10000000, 2]}],
{t, 0, 0.1}, PlotRange -> All,
PlotLegends ->
("k = " <> ToString@# & /@ PowerRange[1000000, 10000000, 2])
]


$k=4\times10^6$ looks like a good starting point for the search. Using the same FindRoot code, however, leads to many complaints, although it does return a somewhat reasonable result:

The difficulty is in NMaxValue though, not in FindRoot. However, since we know roughly from the plot in what range of $t$ the maximum is to be found ($0.04 \leq t \leq 0.07$)), let's help out NMaxValue by providing a constraint on $t$:

Clear[nmaxConstrained]
nmaxConstrained[k_?NumericQ] := NMaxValue[{x3[t, k], 0.04 < t < 0.07}, t]
FindRoot[nmaxConstrained[k] == 1/1000, {k, 4000000}]

(* Out: {k -> 3.79798*10^6} *)


... and no more complaints from NMaxValue.

• I really like you calling k={1, 2, 4, 8, 16,... 512} randomly chosen... Commented Apr 11, 2016 at 3:37
• @BlacKow Hehe... I guess I meant that I didn't know if $k$ should be very small or very large to fulfill the requirement, so I "randomly" chose to start with very large values and got lucky. Also, xkcd :-) Commented Apr 11, 2016 at 5:32
• A very nice idea using nmax[k_?NumericQ] := NMaxValue[x3[t, k], t]. Thank you. This answers my question completely. Commented Apr 11, 2016 at 8:43
• @MarcoB: I tried to use your solution in case of damped oscillations, where x3[t_, k_] = Simplify[(Integrate[ F0 /(t1/2) 1/(m ω0D) Exp[-δ ω0D (t - τ)] τ Sin[ω0D \ (t - τ)], {τ, 0, t1/2}] + Integrate[ 2 F0 (1 - τ/t1) 1/(m ω0D) Exp[-δ ω0D (t - τ)] Sin[ω0D (t - \ τ)], {τ, t1/2, t1}])]; and \[Omega]0D = Sqrt[k/m] Sqrt[1 - \[Delta]^2]; but FindRoot from your answer gives me an error saying that the function may be unbounded. Do you have an idea what could be the problem and how to pass it? Commented Apr 22, 2016 at 10:36
• @skrat I've updated my answer to address your damped oscillation issue. Commented Apr 22, 2016 at 15:21