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. – Jack LaVigne Apr 10 '16 at 14:35
• @JackLaVigne yes, my mistake! The example above should be complete now. – skrat Apr 10 '16 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. – MarcoB Apr 10 '16 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... – BlacKow Apr 11 '16 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 :-) – MarcoB Apr 11 '16 at 5:32
• A very nice idea using nmax[k_?NumericQ] := NMaxValue[x3[t, k], t]. Thank you. This answers my question completely. – skrat Apr 11 '16 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? – skrat Apr 22 '16 at 10:36
• @skrat I've updated my answer to address your damped oscillation issue. – MarcoB Apr 22 '16 at 15:21