Minimizing the largest difference between two functions

Question

I have two functions defined on the same domain, $f(x)$ and $g(x)$ where $x$ is in $(0,1)$:

f[x_] := (-1 + x) Log[1 - x] - x Log[x]
g[x_] := Log[1 + 2 (-1 + x) x]

I would like to find a constant $c$ such that the maximum of $f(x)-cg(x)$ is minimized on the domain $(0,1)$.

My first attempt was to try

Minimize[Maximize[{f[x]-c g[x],0<x<1},x],c]

but this just gives me back my input as the output.

Am I going about this the wrong way entirely? I feel like it's got something to do with the inner Maximize not evaluating because it's a function of more than one variable but I have no idea how to deal with this.

Answer 1

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 < 1}, x]
(* Maximize[{Abs[(-1 + x) Log[1 - x] - x Log[x] - 
c Log[1 + 2 (-1 + x) x]], 0 < x < 1}, x] *)

It appears that Maximize won't solve this subproblem, leaving Minimize nothing to work with. However, we can get Maximize to evaluate if we give it a numerical value of c. Let's define a helper function:

maxDiff[c_?NumericQ] := MaxValue[{Abs[f[x] - c g[x]], 0 < x < 1}, x]

Note the use of NumericQ to prevent this function from evaluating unless a number is passed to it. Also, I'm using MaxValue instead of Maximize because Maximize produces a list contain both the maximum value and a list of rules describing the location of the maximum, where we only want the former.

We can now plot our function:

Plot[maxDiff[c], {c, -2, 0}]

... and see that it reaches a minimum at around $c=-1$. We can now let FindMinimum loose:

FindMinimum[maxDiff[c], {c, -1}]
(* {0.098187, {c -> -1.14363}} *)

The sharp corner gives FindMinimum some trouble, as it expects a smooth function (we get a FindMinimum::sdprec message) but we can verify on the graph that the minimum was indeed found correctly.

Answer 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}]

yielding this: From playing with it it becomes clear that the minimum value of the function Abs[f[x]-c g[x]] takes place somewhere at negative cbetween about -1.25 and -0.3, where there are three extremes, two of them being different. Or at least it looks like that. I did not check this, but you may make a check analogously to what is written below.
Let us take this interval and determine the absolute maximum:

 lst = Table[{c, 
     Max[Abs[FindMaximum[w[x, c], {x, 0.1}][[1]]], 
      Abs[FindMinimum[w[x, c], {x, 0.45}][[1]]]]}, {c, -1.251, 0, 
     0.001}] // Quiet;

ListPlot[lst, 
 AxesLabel -> {Style["c", 16, Italic], 
   Style["Max[Abs[w]]", 16, Italic]}]

returning this:

Now it is not difficult to find the point, where it is absolute minimum:

 lst[[Position[lst, Min[Transpose[lst][[2]]]][[1, 1]]]]

(*  {-1.142, 0.0985002}   *)

This may be at least one way of how practically to get the value.

Have fun!