# How to determine the $k$ value when an expression has exactly two solutions

I have an expression (an even function) like this:

Log2[k x^2] - 2^Abs[x]


We can plot it by using Manipulate,

Manipulate[
Plot[Log2[k x^2] - 2^Abs[x], {x, -3, 3}, PlotRange -> {-1, 3}], {k,
2, 4}] As we can see, when $k$ is approximately 3.1, the expression has two solutions. But how can we calculate this value of $k$ exactly?

### Current try:

Guess an initial solution, such as 3, that is smaller than the real solution.

sol=FindRoot[Log2[3x^2]-2^Abs[x],{x,1}]
(* {x->1.48605} *)

Solve[Log2[k x^2]==2^Abs[x]/.sol,k]
(* {{k->3.15632}} *)


For real values of x, Abs[x] == Sqrt[x^2]. This form is required for the derivative to be defined.

f[k_, x_] = Log2[k x^2] - 2^Sqrt[x^2];


You want the {x, k} values for which both the function and its derivative are zero.

eqns = {f[k, x] == 0, D[f[k, x], x] == 0};


The exact solutions are expressed in terms of ProductLog

(sol = Solve[eqns, {x, k}, Reals]) // TraditionalForm Verifying the solution,

eqns /. sol // Simplify

(*  {{True, True}, {True, True}}  *)


The approximate numerical values are

sol // N

(*  {{x -> -1.48605, k -> 3.15632}, {x -> 1.48605, k -> 3.15632}}  *)

• Perfect~~~~~ :)
– yode
Jan 16 '17 at 0:59

Simplify[k /. ToRules[Reduce[D[Log2[k x^2]-2^Abs[x],x]==0 &&
Log2[k x^2]-2^Abs[x]==0 && x>0, {x, k}]]]


which tells you that k is exactly (2^E^ProductLog[2/Log]*Log^2)/ProductLog[2/Log]^2

but I am not certain that is a particularly rewarding answer.

Checking that with N says it is approximately 3.1563220300507372963 so it seems correct.

You can solve in two steps. As $\log_2(k x^2)=\log_2(k)+\log_2(x^2)$ the value of x where derivative vanishes of the desired function is independent of k. Just considering $x>0$, given the symmetry,then solving $log_2(k {x_v}^2) -2^{x_v}=0$ for $k$ yields the result ($x_v$ is x value where derivative vanishes).

f[k_, x_] := Log2[k x^2] - 2^x
xv = x /. Solve[D[f[k, x], x] == 0, x][]
k /. Solve[f[k, xv] == 0, k][] // TraditionalForm
Manipulate[
Plot[{Log2[k x^2], 2^Abs[x], f[k, Abs@x]}, {x, -3, 3},
PlotRange -> {-15, 10}, GridLines -> {{-xv, xv}, None},
MeshFunctions -> (f[k, Abs[#]] &), Mesh -> {{0.}},
MeshStyle -> {Red, PointSize[0.02]}], {k, 1, 5,
Appearance -> "Labeled"}] 