3
$\begingroup$

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: LowEign with respect to t

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.

$\endgroup$
10
$\begingroup$

First answer (extended comment actually)

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

ClearAll[mat, minev]
SeedRandom[1]
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}]

enter image description here

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[[2]])*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[{#[[1]], Abs[#[[2]]]} & /@ memPoints, PlotRange -> All, 
 PlotTheme -> "Detailed", PlotStyle -> Red] 

enter image description here

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[{#[[1]], Abs[#[[2]]]} & /@ memPoints, 
   PlotTheme -> "Detailed", PlotStyle -> Red]}]

enter image description here

$\endgroup$
  • $\begingroup$ I guess my matrix 400 by 400 is too expensive to evaluate? I use your code but after 30mins it is still running.... $\endgroup$ – James May 4 '16 at 18:20
  • 1
    $\begingroup$ @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. $\endgroup$ – Anton Antonov May 4 '16 at 21:02

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.