Finding ArgMin of the function with undefined constants

Question

I have a problem which I can solve on the paper, but I want to be able to solve in Mathematica:

Find argument of the minimum of the following function:

So on paper my solutuon goes like this:

So in Mathematica I tried:

f = Function[x, Sum[(x - Indexed[t, k])^2, {k, 1, n}]] Solve[f'[x] == 0, x]

and I've got this result:

{{x -> InverseFunction[\!\( \*UnderoverscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(2\ \((x - \* TemplateBox[{"t","k"}, "IndexedDefault"])\)\)\), 1, 1][0]}}

Is there a method to get a solution like the one I calculated manually?

Answer 1

If you think it's worth the trouble, you can do the following (InputForm only to make the output clearer)

Sum[(x - t[k])^2, {k, 1, n}] // InputForm
(* Sum[(x - t[k])^2, {k, 1, n}] *)

D[%, x] == 0 // InputForm
(* Sum[2*(x - t[k]), {k, 1, n}] == 0 *)

% /. u__Sum :> Evaluate //@ MapAt[Expand, u, 1] // InputForm
(* Sum[2*x - 2*t[k], {k, 1, n}] == 0 *)

Distribute /@ % // InputForm
(* 2*n*x + Sum[-2*t[k], {k, 1, n}] == 0 *)

% /. HoldPattern[Sum[u_ v_?(FreeQ[#, k] &), {k, 1, n}]] :> v Sum[u, {k, 1, n}] // InputForm
(* 2*n*x - 2*Sum[t[k], {k, 1, n}] == 0 *)

Solve[%, x] // InputForm
(* {{x -> Sum[t[k], {k, 1, n}]/n}} *)

It might be worth doing this sort of thing for more complicated expressions.

EDIT

If you want to do this without doing a manual minimisation, Mathematica can solve it if you force x outside the summation. For example:

Sum[(x - t[k])^2, {k, 1, n}];
% /. u__Sum :> Evaluate //@ MapAt[Expand, u, 1] // InputForm
(* Sum[x^2 - 2*x*t[k] + t[k]^2, {k, 1, n}] *)

Distribute[%] // InputForm
(* n*x^2 + Sum[-2*x*t[k], {k, 1, n}] + Sum[t[k]^2, {k, 1, n}] *)

% /. HoldPattern[Sum[u_ v_?(FreeQ[#, k] &), {k, 1, n}]] :> 
   v Sum[u, {k, 1, n}] // InputForm
(* n*x^2 - 2*x*Sum[t[k], {k, 1, n}] + Sum[t[k]^2, {k, 1, n}] *)

Assuming[n > 0, ArgMin[%, x] // Refine] // InputForm
(* Piecewise[{{Sum[t[k], {k, 1, n}]/n, Sum[t[k], {k, 1, n}] > 0 || 
    Sum[t[k], {k, 1, n}] < 0}}, 0] *)

The use of Piecewise at the end is a little irritating, but getting rid of that is a separate question Piecewise[] merge equivalent conditions

Answer 2

It's pretty close to what you would do by hand:

allT = Array[t, 5];
der[x_] := D[Sum[(x - t[i])^2, {i, Length[allT]}], x];
Solve[der[x] == 0, x]

{{x -> 1/5 (t[1] + t[2] + t[3] + t[4] + t[5])}}