D <- matrix(
c(2,1,3,1,1,1,0,-3,3,-2,2,-6),
nrow=3
)
print(D)
[,1] [,2] [,3] [,4]
[1,] 2 1 0 -2
[2,] 1 1 -3 2
[3,] 3 1 3 -6
print(svd(D))
$d
[1] 8.185353e+00 3.464102e+00 5.949421e-16
$u
[,1] [,2] [,3]
[1,] -0.3015113 -0.4923660 0.8164966
[2,] 0.3015113 -0.8616404 -0.4082483
[3,] -0.9045340 -0.1230915 -0.4082483
$v
[,1] [,2] [,3]
[1,] -0.3683547 -6.396021e-01 -0.59657075
[2,] -0.1105064 -4.264014e-01 0.76959951
[3,] -0.4420257 6.396021e-01 -0.08350441
[4,] 0.8103804 1.664464e-17 -0.21177099
round(svd(D)$d, 5)
J <- matrix(
c(1,2,3,4,2,5,6,7,3,6,8,9,4,7,9,10),
nrow=4
)
print(J)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 5 6 7
[3,] 3 6 8 9
[4,] 4 7 9 10
eigen(J)$values
W = 1/16 * matrix(
c(11,-5,-3,1,4,2,
-5,11,-3,1,4,2,
-3,-3,3,-1,-4,-2,
1,1,-1,11,-4,6,
4,4,-4,-4,8,0,
2,2,-2,6,0,4),
nrow=6
)
print(W)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.6875 -0.3125 -0.1875 0.0625 0.25 0.125
[2,] -0.3125 0.6875 -0.1875 0.0625 0.25 0.125
[3,] -0.1875 -0.1875 0.1875 -0.0625 -0.25 -0.125
[4,] 0.0625 0.0625 -0.0625 0.6875 -0.25 0.375
[5,] 0.2500 0.2500 -0.2500 -0.2500 0.50 0.000
[6,] 0.1250 0.1250 -0.1250 0.3750 0.00 0.250
print(W%*%W)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.6875 -0.3125 -0.1875 0.0625 0.25 0.125
[2,] -0.3125 0.6875 -0.1875 0.0625 0.25 0.125
[3,] -0.1875 -0.1875 0.1875 -0.0625 -0.25 -0.125
[4,] 0.0625 0.0625 -0.0625 0.6875 -0.25 0.375
[5,] 0.2500 0.2500 -0.2500 -0.2500 0.50 0.000
[6,] 0.1250 0.1250 -0.1250 0.3750 0.00 0.250
identical(W%*%W, W)
(11+11+3+11+8+4)/16
J <- matrix(
c(1,2,3,4,2,5,6,7,3,6,8,9,4,7,9,10),
nrow=4
)
print(J)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 5 6 7
[3,] 3 6 8 9
[4,] 4 7 9 10
B = diag(c(1,2,3,4))
print(B)
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 0 2 0 0
[3,] 0 0 3 0
[4,] 0 0 0 4
print(solve(B) %*% J)
[,1] [,2] [,3] [,4]
[1,] 1 2.00 3.000000 4.0
[2,] 1 2.50 3.000000 3.5
[3,] 1 2.00 2.666667 3.0
[4,] 1 1.75 2.250000 2.5
v <- eigen(solve(B) %*% J)
print(v)
eigen() decomposition
$values
[1] 8.72092773 -0.44430671 0.32358111 0.06646455
$vectors
[,1] [,2] [,3] [,4]
[1,] -0.5435392 -0.89192923 0.6940891 0.3644724
[2,] -0.5513428 -0.20780650 -0.6892020 0.3393605
[3,] -0.4776681 0.03445862 0.0282874 -0.7965877
[4,] -0.4152343 0.40011413 0.2060117 0.3426986
a <- sum(v$vectors[,1]^2 * c(1,2,3,4))
x <- v$vectors[,1] / sqrt(a)
print(abs(x))
[1] 0.3601595 0.3653303 0.3165121 0.2751422