この関数は,最初は 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 }