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 kkk such that the maximum value of x3[t, k] is less than 0.0010.0010.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 ttt. 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 at 14:35      @JackLaVigne yes, my mistake! The example above should be complete now. – skrat Apr 10 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 at 16:35 ================= 1 Answer 1 ================= 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 kkk, 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 kkk value for which x3[t, k] has a maximum under 0.0010.0010.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×106k=4×106k=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 ttt the maximum is to be found (0.04≤t≤0.070.04 \leq t \leq 0.07)), let’s help out NMaxValue by providing a constraint on tt:

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.

1

 

I really like you calling k={1, 2, 4, 8, 16,… 512} randomly chosen…
– BlacKow
Apr 11 at 3:37

  

 

@BlacKow Hehe… I guess I meant that I didn’t know if kk 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 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 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 at 10:36

1

 

@skrat I’ve updated my answer to address your damped oscillation issue.
– MarcoB
Apr 22 at 15:21