# Optimize a parametric matrix to get a lowest possible eigenvalue

This question is a followup of Plot the lowest eigenvalues of a parametric matrix

Now I can get the lowest eigenvalue LowEign(t) of the matrix for a given t numerically.

When I plot the LowEign with respect to t, I find it a perfect convex function in the region of interesting t, which means I can find a t* to give the lowest LowEign (the lowest of the lowest eigenvalue of the matrix). See here: Now I hope to get the t* at a much higher precision, say 6 decimal places. Instead of plotting in a much smaller interval, I try using NMinimizeor Minimize function like:

NMinimize[{Eigenvalues[M[t_], -1], t > 2.3 && t < 2.4}, t]


or

NMinimize[{Min[Eigenvalues[M[t_]]], t > 2.3 && t < 2.4}, t]


but the output is the same:

Eigenvalues::eival: Unable to find all roots of the characteristic polynomial.


I suspect that MMA is trying to solve the Eigenvalues[M[t_], -1] or Min[Eigenvalues[M[t_]]] analytically but failed.

Note: I converted the Matrix M into a numerical instead of symbolic representation of t before using the Minimization.

## First answer (extended comment actually)

You have to define better your objective function. For example, the following works:

ClearAll[mat, minev]
SeedRandom
rm = RandomInteger[10, {40, 40, 3}];

mat[t_] := N[rm.{1, t, t^2}];
minev[t_?NumericQ] := First@Eigenvalues[mat[t], -1];

Take[Table[minev[t], {t, 0, 1, .01}], 3]

(* {-0.864071 - 1.30548 I, -0.861327 - 1.21718 I, -0.859129 -
1.12321 I} *)

DiscretePlot[Abs@minev[t], {t, 0, 1, .01}] ClearAll[mf]
mf[M_, t_?NumericQ] := First@Eigenvalues[M[t], -1];

NMinimize[{Abs[mf[mat, t]], 0.25 < t < 0.4}, t]

(* {7.13047*10^-11, {t -> 0.323957}} *)


## Optimizing for larger matrices

For larger matrices we can use memoization and a coarser grid of numbers:

ClearAll[rm, mat]
rm = RandomInteger[10, {400, 400, 3}];
mat[t_] := N[rm.{1, t, t^2}];

ClearAll[mf, mfChop]
mf[M_, t_?NumericQ] := mfChop[M, Round[t*10^6]/10^6.];
mfChop[M_, t_?NumericQ] := mfChop[M, t] = First@Eigenvalues[M[t], -1];

AbsoluteTiming[
sol = NMinimize[{Abs[mf[mat, t]], 0.25 < t < 0.4}, t, PrecisionGoal -> 5]
]

(* {11.9561, {4.85666*10^-6, {t -> 0.330967}}} *)


This is the value found:

Round[(t /. sol[])*10^6]/10^6.

(* 0.330967 *)


### Visualizing the minimization with memoized points

We can visually verify that the mininmization process proceeded as expected plotting the memoized points together with the actual points.

memPoints =
Cases[DownValues[
mfChop], (_[mfChop[mat, x_]] :> y_) :> {x, y}, \[Infinity]];

ListPlot[{#[], Abs[#[]]} & /@ memPoints, PlotRange -> All,
PlotTheme -> "Detailed", PlotStyle -> Red] Using non-memoizing function for the next plot:

Clear[minev]
minev[t_?NumericQ] := First@Eigenvalues[mat[t], -1];

Show[{
DiscretePlot[Abs@minev[t], {t, 0, 1, .005}],
ListPlot[{#[], Abs[#[]]} & /@ memPoints,
PlotTheme -> "Detailed", PlotStyle -> Red]}] • I guess my matrix 400 by 400 is too expensive to evaluate? I use your code but after 30mins it is still running.... May 4 '16 at 18:20
• @James My first answer was more of an extended comment... See my update with an implementation that gets the result for $400 \times 400$ matrix within 15 seconds on my laptop. May 4 '16 at 21:02