Re: (Numerisches?) Problem beim Bestimmen der Eigenvektoren

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Hallo Andreas,

> Mathematica 7.0 scheint mich wieder einmal zur Verzweiflung bringen zu
> wollen.

Verzweiflungsfreies Rechnen ist mit Mma 7.0.1.0 auch unter Windows XP 32  
Bit möglich.

In[2]:= Clear[c1, c2, c3, c4, e1, e2, e3]
c1 = 34.8669;
c2 = 36.6194;
c3 = -3.7212;
c4 = -4.5547;
e1 = 1958.56;
e2 = 1950.11;
e3 = 2096.11;

In[10]:= Clear[M]
M = {{e1, c1, c2, c3}, {c1, e1, c2, c3}, {c2, c2, e2, c4}, {c3, c3,
    c4, e3}};

Die Fehler bei der direkten Anwendung von Eigenvectors[] haben wir  
gesehen, auch, dass Eigenvectors[Rationalize[M]] nichtnormierte  
Eigenvektoren herausgibt.
Deshalb erweitert man die Matrix M trivial

In[48]:= Clear[messmerM]
messmerM[m_?MatrixQ, n_Integer?Positive] :=
 ArrayPad[m, {0, n}] + ArrayPad[IdentityMatrix[n], {Length[m], 0}] /;
  Length[m] == Length[Transpose[m]]

das n gibt die Extradimensionen an, die es gestatten, die Arnoldimethode  
warnungsfrei zu verwenden:

In[62]:= Clear[v]
With[{q = Length[M], p = 4},
 v = Take[#, q] & /@
   Take[Eigenvectors[messmerM[M, p], q, Method -> Arnoldi] // Chop, q]
 ]

Out[63]= {{0.0568049, 0.0568049, 0.0592536, -0.995005},
        {-0.58598, -0.58598, -0.550739, -0.0997043},
        {0.707107, -0.707107, 0, 0},
        {-0.391663, -0.391663, 0.832572, 0.00486037}}

In[65]:= Inverse[Transpose[v]] . M . Transpose[v] // Chop
Out[65]= {{2096.81, 0, 0, 0},
        {0, 2027.21, 0, 0},
        {0, 0, 1923.69, 0},
        {0, 0, 0, 1915.63}}

Schönen dritten Advent!
Udo.

P.S.: Übrigens gibt es noch einen an sich inhaltsleeren Umschwung beim an  
sich inhaltsleeren Übergang von p = 6 auf p = 7:

In[88]:= Clear[v]
With[{q = Length[M], p = 6},
 v = Take[#, q] & /@
   Take[Eigenvectors[messmerM[M, p], q, Method -> Arnoldi] // Chop, q]
 ]

Out[89]= {{0.0568049, 0.0568049, 0.0592536, -0.995005},
        {-0.58598, -0.58598, -0.550739, -0.0997043},
        {0.707107, -0.707107, 0, 0},
        {-0.391663, -0.391663, 0.832572, 0.00486037}}


In[90]:= Clear[v]
With[{q = Length[M], p = 7},
 v = Take[#, q] & /@
   Take[Eigenvectors[messmerM[M, p], q, Method -> Arnoldi] // Chop, q]
 ]

Out[91]= {{-0.0568049, -0.0568049, -0.0592536, 0.995005},
        {0.58598, 0.58598, 0.550739, 0.0997043},
        {-0.707107, 0.707107, 0,  0},
        {-0.391663, -0.391663, 0.832572, 0.00486037}}