View file src/j/afu-ac.ijs - Download

NB. Analyse canonique avec AFU
NB. Données d'après http://iml.univ-mrs.fr/~reboul/canonique.pptx.pdf
NB.                 http://log.chez.com/text/math/canonique.pptx.pdf

transpose =: |:      NB. Transposition de matrice
matprod =: + / . *   NB. Produit de matrices
extprod =: */
inv =: %.             NB. Inverse
id =: (= / ~) @ i.   NB. Matrice identité

diag =: 3 : 0        NB. Matrice diagonale à partir d'un vecteur
 y * id #y
)

tmatprod =: 3 : 0
 (transpose y) matprod y
)
   
maptmatprod =: 3 : 0
 if. 0 = # y do. 0 0 0 $ 0
 else. (tmatprod {. y), maptmatprod }. y
 end.
)

mapprod =: 4 : 0
 if. 0 = # x do. 0 0 0 $ 0
 else. (({. x) matprod y) , (}. x) mapprod y
 end.
)

NB. Données

X =: 1 2 $ 100  100
X =: X ,   200  400
X =: X ,  _400 _200
X =: X ,   200 _300
X =: X ,  _100    0

Y =: 1 3 $ 200    0 _107
Y =: Y ,   600 _300  212
Y =: Y ,  _600 _200  233
Y =: Y ,  _200  200   92
Y =: Y ,     0  300 _430

NB. Réduction des données
X =: X % ((#X) # 1) */ (+/X^2)^0.5
Y =: Y % ((#Y) # 1) */ (+/Y^2)^0.5

T =: (1 0 extprod (X ,. (0*Y))) + (0 1 extprod ((0*X) ,. Y))
echo 'Tableau de données de l''AFU :'
echo T

Z1 =: + / T   NB. Tableau bidimensionnel somme des couches

V =: maptmatprod T
W =: + / V
S =: Z1 matprod (%. W) matprod (transpose Z1) 
LU =: deflation S   NB. Valeurs et vecteurs propres de S
echo 'Eléments propres :'
echo LU
U =: > 1 { LU

u1 =: 0 { transpose U
echo 'Premier vecteur propre :'
echo u1

a =: (inv (transpose X) matprod X) matprod (transpose X) matprod u1
b =: (inv (transpose Y) matprod Y) matprod (transpose Y) matprod u1

a =: a % (a matprod a)^0.5
b =: b % (b matprod b)^0.5

u2 =: 1 { transpose U

a2 =: (inv (transpose X) matprod X) matprod (transpose X) matprod u2
b2 =: (inv (transpose Y) matprod Y) matprod (transpose Y) matprod u2

a2 =: a2 % (a2 matprod a2)^0.5
b2 =: b2 % (b2 matprod b2)^0.5

echo 'Facteurs canoniques :'
echo a
echo a2
echo b
echo b2