Следующие могут делать то, что вы хотите.Это, конечно, возможно более элегантно, я верю.Но моя линейная алгебра слишком далека, чтобы сделать это на макушке головы.
Сначала я строю некоторые игрушечные данные.
Матрица для "сглаживания":
x <- 0*diag(10)
x[8,4] <- x[6,7] <- x[3,3] <- 50
print(x)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 0 0 0 0 0
[2,] 0 0 0 0 0 0 0 0 0 0
[3,] 0 0 50 0 0 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 0 0 0 0 0 0
[6,] 0 0 0 0 0 0 50 0 0 0
[7,] 0 0 0 0 0 0 0 0 0 0
[8,] 0 0 0 50 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0 0 0 0
Далее мы определяем вспомогательную матрицу, которую можно использовать при умножении матрицы на матрицу:
b <- 0*diag(10)
b[col(b) == row(b) + 1] <- 0.5
b[col(b) == row(b) - 1] <- 0.5
print(b) # A symmetric matrix with the first off-diagonal set to 0.5
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0.0 0.5 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
[2,] 0.5 0.0 0.5 0.0 0.0 0.0 0.0 0.0 0.0 0.0
[3,] 0.0 0.5 0.0 0.5 0.0 0.0 0.0 0.0 0.0 0.0
[4,] 0.0 0.0 0.5 0.0 0.5 0.0 0.0 0.0 0.0 0.0
[5,] 0.0 0.0 0.0 0.5 0.0 0.5 0.0 0.0 0.0 0.0
[6,] 0.0 0.0 0.0 0.0 0.5 0.0 0.5 0.0 0.0 0.0
[7,] 0.0 0.0 0.0 0.0 0.0 0.5 0.0 0.5 0.0 0.0
[8,] 0.0 0.0 0.0 0.0 0.0 0.0 0.5 0.0 0.5 0.0
[9,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.5 0.0 0.5
[10,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.5 0.0
Выполните вычисление:
res <- x %*% b + b %*% x + x
res
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 0 0 0 0 0
[2,] 0 0 25 0 0 0 0 0 0 0
[3,] 0 25 50 25 0 0 0 0 0 0
[4,] 0 0 25 0 0 0 0 0 0 0
[5,] 0 0 0 0 0 0 25 0 0 0
[6,] 0 0 0 0 0 25 50 25 0 0
[7,] 0 0 0 25 0 0 25 0 0 0
[8,] 0 0 25 50 25 0 0 0 0 0
[9,] 0 0 0 25 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0 0 0 0
Редактировать Это дает то же самое:
d <- 0.5*diag(10)
d[col(d) == row(d) + 1] <- 0.5
d[col(d) == row(d) - 1] <- 0.5
res2 <- x %*% d + d %*% x # or crossprod(d, x) + tcrossprod(x, d)
print(res2)