実対称行列の固有値・固有ベクトルを求める関数     Last modified: May 15, 2002

 この関数は,最初は FORTRAN で書いたものを C に移して,さらに AWK に移植したのですが,AWK の変な制限のためにひねくれたコードになってしまった箇所があります。

 この実対称行列の固有値・固有ベクトルを求めるアルゴリズムはかなり高速なので,AWK を使っても見劣りしないかもしれません。10 変数 47 ケースのデータを使って,EPSON PC-486 NOTE AS で,10秒で結果が出ました。

 固有値・固有ベクトルを求める関数があれば,数量化II類や正準判別分析も書けますね。あと,逆行列を求める関数があれば,鬼に金棒か(^_^;)


# 実対称行列の,固有値(e),固有ベクトル(v)を求める関数 eigen.awk

function eigen2(a, n, ne, eps, e, v,     sw, i, j, k, k1, m, nea, nm1,
nm2, nv, nva, a1, ajk, d, ei, eps1, eps2, f, q, r, s, sr, t, wj1, w, lw)
{
   nv = nva = nea = abs(ne)
   if (nea == 0 || nea > n) return 1
   nm1 = n-1; nm2 = n-2
   if (eps <= 0) {
       eps = 1e-16
   }
   if (n == 1) {
       e[0] = a[0,0]
       if (nv != 0) {
           v[0,0] = 1
       }
       return 0
   }
   if (n == 2) {
       w[0,0] = a[0,1]; t = 0.5*(a[0,0]+a[1,1])
       r = a[0,0]*a[1,1]-a[0,1]^2
       d = t*t-r
       q = abs(t)+sqrt(d)
       if (t < 0) {
           q = -q
       }
       t *= ne
       if (t >= 0) {
           e[0] = q
           if (nea == 2) {
               e[1] = r/q
           }
       }
       else {
           e[0] = r/q
           if (nea == 2) {
               e[1] = q
           }
       }
   }
   else {
       for (k = 1; k <= nm2; k++) {
           k1 = k-1
           s = 0
           for (i = k; i < n; i++) {
               s += a[k1,i]^2
           }
           w[0,k1] = 0
           if (s != 0) {
               sr = sqrt(s)
               a1 = a[k1,k]
               if (a1 < 0) {
                   sr = -sr
               }
               w[0,k1] = -sr
               r = 1/(s+a1*sr)
               a[k1,k] = a1+sr
               for (i = k; i < n; i++) {
                   s = 0
                   for (j = k; j <= i; j++) {
                       s += a[j,i]*a[k1,j]
                   }
                   if (i != nm1) {
                       for (j = i+1; j < n; j++) {
                           s += a[i,j]*a[k1,j]
                       }
                   }
                   w[0,i] = s*r
               }
               s = 0
               for (i = k; i < n; i++) {
                   s += a[k1,i]*w[0,i]
               }
               t = 0.5*s*r
               for (i = k; i < n; i++) {
                   w[0,i] -= t*a[k1,i]
               }
               for (j = k; j < n; j++) {
                   wj1 = w[0,j]
                   ajk = a[k1,j]
                   for (i = j; i < n; i++) {
                       a[j,i] -= a[k1,i]*wj1+w[0,i]*ajk
                   }
               }
           }
       }
       w[0,nm2] = a[nm2,nm1]
       for (i = 0; i < n; i++) {
           w[5,i] = a[i,i]
       }
       r = abs(w[5,0])+abs(w[0,0])
       f = abs(w[0,nm2])+abs(w[5,nm1])
       r = max(r, f)
       for (i = 1; i < nm1; i++) {
           f = abs(w[0,i-1])+abs(w[5,i])+abs(w[0,i])
           r = max(r, f)
       }
       eps1 = r*1e-16
       eps2 = r*eps
       for (i = 0; i < nm1; i++) {
           w[1,i] = w[0,i]^2
       }
       if (ne < 0) {
           r = -r
       }
       f = r
       for (i = 0; i < nea; i++) {
           e[i] = -r
       }
       pass2 = 0
       for (k = 1; k <= nea; k++) {
           if (!pass2) {
               k1 = k-1
               d = e[k1]
           }
           pass2 = 0
           t = 0.5*(d+f)
           if (abs(d-f) > eps2 && t != d && t != f) {
               j = 0
               i = 1
               for (;;) {
                   if (!pass1) {
                       q = w[5,i-1]-t
                   }
                   pass1 = 0
                   if (q >= 0) {
                       j++
                   }
                   if (q != 0) {
                       if (++i > n) {
                           break
                       }
                       q = w[5,i-1]-t-w[1,i-2]/q
                       pass1 = 1
                       continue
                   }
                   else {
                       i += 2
                   }
                   if (i > n) {
                       break
                   }
               }
               if (ne < 0) {
                   j = n-j
               }
               if (j < k) {
                   f = t
                   pass2 = 1
                   k--
                   continue
               }
               d = t
               m = min(j, nea)
               for (i = k-1; i < m; i++) {
                   e[i] = t
               }
               pass2 = 1
               k--
               continue
           }
           e[k1] = t
       }
   }
   if (nv != 0) {
       if (n == 2) {
           w[5,0] = a[0,0]
           w[5,1] = a[1,1]
       }
       w[0,nm1] = 0
       for (i = 0; i < nva; i++) {
           ei = e[i]
           for (j = 0; j < n; j++) {
               w[1,j] = w[5,j]-ei
               w[2,j] = w[0,j]
               v[i,j] = 1
           }
           sw = 0
           for (j = 0; j < nm1; j++) {
               if (abs(w[1,j]) >= abs(w[0,j])) {
                   if (w[1,j] == 0) {
                       w[1,j] = 1e-30
                   }
                   w[4,j] = w[0,j]/w[1,j]
                   lw[j] = 0
                   w[1,j+1] -= w[4,j]*w[2,j]
                   w[3,j] = 0
               }
               else {
                   w[4,j] = w[1,j]/w[0,j]
                   lw[j] = 1
                   w[1,j] = w[0,j]
                   t = w[2,j]
                   w[2,j] = w[1,j+1]
                   w[3,j] = w[2,j+1]
                   w[1,j+1] = t-w[4,j]*w[2,j]
                   w[2,j+1] = -w[4,j]*w[3,j]
               }
           }
           if (w[1,nm1] == 0) {
               w[1,nm1] = 1e-30
           }
           if (i > 0 && abs(e[i]-e[i-1]) < eps1) {
               for (j = 0; j < n; j++) {
                   v[i,j] = rand()
               }
           }
           for (;;) {
               t = v[i,nm1]
               r = v[i,nm2]
               v[i,nm1] = t/w[1,nm1]
               v[i,nm2] = (r-w[2,nm2]*v[i,nm1])/w[1,nm2]
               for (k = nm2-1; k >= 0; k--) {
                   v[i,k] = (v[i,k]-w[2,k]*v[i,k+1]-w[3,k]*v[i,k+2])/w[1,k]
               }
               if (sw == 0) {
                   sw = 1
                   for (j = 0; j < nm1; j++) {
                       if (lw[j] == 1) {
                           t = v[i,j]
                           v[i,j] = v[i,j+1]
                           v[i,j+1] = t-w[4,j]*v[i,j+1]
                       }
                       else {
                           v[i,j+1] -= w[4,j]*v[i,j]
                       }
                   }
                   continue
               }
               else
               break
           }
       }
       if (n > 2) {
           for (i = 0; i < nm2; i++) {
               w[0,i] *= -a[i,i+1]
           }
           for (i = 0; i < nva; i++) {
               for (k = nm2-1; k >= 0; k--) {
                   r = w[0,k]
                   if (r != 0) {
                       r = 1/r
                       s = 0
                       for (j = k+1; j < n; j++) {
                           s += a[k,j]*v[i,j]
                       }
                       r *= s
                       for (j = k+1; j < n; j++) {
                           v[i,j] -= r*a[k,j]
                       }
                   }
               }
           }
       }
       for (i = 0; i < nva; i++) {
           if (i == 0) {
               m = 1
           }
           else {
               if (abs(e[i]-e[i-1]) >= eps1) {
                   m = i+1
               }
               else {
                   for (j = m-1; j < i; j++) {
                       s = 0
                       for (k = 0; k < n; k++) {
                           s += v[j,k]*v[i,k]
                       }
                       for (k = 0; k < n; k++) {
                           v[i,k] -= s*v[j,k]
                       }
                   }
               }
           }
           t = s = 0
           for (j = 0; j < n; j++) {
               s += v[i,j]^2
           }
           if (s != 0) {
               t = sqrt(1/s)
           }
           for (j = 0; j < n; j++) {
               v[i,j] *= t
           }
       }
   }
   return 0
}

・ 直前のページへ戻る  ・ E-mail to Shigenobu AOKI