I have a matrix pmatrix
sigma = 0.03
alpha = 0.01
sims = 6
N = 10
pmatrix = matrix(NA, ncol=sims, nrow = N)
for (i in 1:N){
x = rnorm(sims)
pmatrix[i,] <- x
}
And I need to use this matrix in order to get the xt values from the following expression:
xt = 0
for (i in 1:10){
xt[i+1] = xt[i] * exp(-alpha*1) + sqrt(((sigma^2)/2*alpha)*(1-exp(-2*alpha*1)))*pmatrix[i]
}
However the following loop only returns a xt vector. Ideally I would like to obtain a matrix which consists of 10 rows (N- number of years) and 6 columns (sims - the number of simulated scenarios).
I believe it is doable via a second loop or an apply function.
Hope this suits you. Sometimes its easier to use an apply function on column or row indices instead of a data object itself.
sigma = 0.03
alpha = 0.01
sims = 6
N = 10
pmatrix <- matrix(rnorm(N * sims), N)
xt <- matrix(nrow=N, ncol=6)
xt[1,] <- 0
sapply(2:N, FUN = function(x) {
xt[x,] <<- xt[x-1,] * exp(-alpha*1) + sqrt(((sigma^2)/2*alpha)*(1-exp(-2*alpha*1)))*pmatrix[x-1,]
})
> xt
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.0000000000 0.000000e+00 0.000000e+00 0.0000000000 0.0000000000 0.000000e+00
[2,] -0.0006488202 4.730257e-04 4.707051e-04 0.0002174562 0.0001655868 -2.063875e-04
[3,] -0.0007110547 3.792143e-04 3.922429e-04 0.0009465164 -0.0001667539 -1.165253e-05
[4,] -0.0003679911 -3.596447e-05 5.490986e-06 0.0013176437 -0.0006049390 2.276431e-04
[5,] -0.0007176342 1.754809e-05 3.647631e-04 0.0015136978 -0.0010303508 4.773186e-04
[6,] -0.0007918234 -3.065909e-05 -3.703564e-05 0.0015006314 -0.0005650229 7.792698e-05
[7,] -0.0008442265 -2.808698e-04 7.808261e-05 0.0015505998 -0.0005407453 -3.106797e-04
[8,] -0.0010265038 8.540579e-05 2.547632e-04 0.0017364697 -0.0007112818 -3.972706e-04
[9,] -0.0004011710 7.346707e-05 7.471667e-04 0.0014031268 -0.0008266330 -4.296555e-04
[10,] -0.0001490369 -3.189111e-04 1.133248e-03 0.0013038771 -0.0011771068 -2.719285e-04
Just as an extended comment: the issue you were facing came from the fact that you were subsetting xt wrongly. If you want to do something on a matrix rowwise, use the entire row, which you can retrieve using xt[1,] as opposed to xt[1]. See:
sigma = 0.03; alpha = 0.01; sims = 6; N = 10
pmatrix = matrix(rnorm(sims*N), ncol=sims, nrow = N)
xt <- matrix(0, ncol=sims, nrow = N)
xt[1] # just one element
[1] 0
xt[1,] # entire row
[1] 0 0 0 0 0 0
Then it works also with your approach:
for(i in 2:N){
xt[i,] <- xt[i-1,] * exp(-alpha) + sqrt(((sigma^2)/2*alpha)*(1-exp(-2*alpha)))*pmatrix[i-1,]
}
head(xt)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.0000000000 0.000000e+00 0.0000000000 0.000000e+00 0.000000e+00 0.0000000000
[2,] 0.0005102757 9.680876e-05 0.0006264992 2.147689e-05 9.432744e-05 0.0004370840
[3,] 0.0005035357 -4.704802e-04 0.0003954507 -5.083994e-04 4.237845e-04 0.0004007277
[4,] 0.0009345963 -2.699634e-04 0.0003559880 -3.877696e-04 5.337181e-04 0.0005230792
[5,] 0.0016501564 -1.947569e-04 0.0005003010 -6.680216e-05 6.098233e-04 0.0007106022
[6,] 0.0015317653 4.316999e-04 0.0011361772 -2.209149e-04 6.881100e-04 0.0005893373
Related
So I have a 1131 element list, with each element being a 5 by 5 matrix. The first element looks much like the other ones
sotest.corr.try[1]
[[1]]
[,1] [,2] [,3]
[1,] 1.00000000 -0.04125426 0.1565728
[2,] -0.04125426 1.00000000 0.1199373
[3,] 0.15657281 0.11993733 1.0000000
[4,] 0.10209354 0.06125212 0.1937589
[5,] -0.19069820 0.17598585 -0.1235949
[,4] [,5]
[1,] 0.10209354 -0.19069820
[2,] 0.06125212 0.17598585
[3,] 0.19375885 -0.12359492
[4,] 1.00000000 -0.08771679
[5,] -0.08771679 1.00000000
Starting at element 126, I'd like to just add the preceding 125 matrices to 126. So that the component in the 1,2 spot, for example, would be the sum of the first 126 1,2 components. I've noticed that something like this gets what I want
sotest.corr.try[[1]]+sotest.corr.try[[2]]
[,1] [,2] [,3] [,4]
[1,] 2.00000000 -0.08842164 0.3155670 0.2063603
[2,] -0.08842164 2.00000000 0.2363135 0.1156103
[3,] 0.31556697 0.23631345 2.0000000 0.3869373
[4,] 0.20636030 0.11561033 0.3869373 2.0000000
[5,] -0.38288102 0.35103362 -0.2489587 -0.1804376
[,5]
[1,] -0.3828810
[2,] 0.3510336
[3,] -0.2489587
[4,] -0.1804376
[5,] 2.0000000
But this doesn't
sum(sotest.corr.try[[1:126]])
Error in sotest.corr.try[[1:126]] : recursive indexing failed at level 2
Is there any way to do this quickly? Maybe using lapply?
Thanks
For purposes of illustration suppose we have a list L of 5 2x2 matrices and we want the output to be the first two, followed by the cumulative sums for the others.
1) We concatenate the first two components of the list with everything but the first two components of the cumulative sum list computed using Reduce.
# test input
M <- matrix(1:4, 2)
L <- list(M, 2*M, 3*M, 4*M, 5*M)
ix <- 1:2
out1 <- c(L[ix], Reduce(`+`, L, acc = TRUE)[-ix])
# check
out2 <- list(L[[1]], L[[2]], L[[1]] + L[[2]] + L[[3]],
L[[1]] + L[[2]] + L[[3]] + L[[4]], L[[1]] + L[[2]] + L[[3]] + L[[4]] + L[[5]])
identical(out1, out2)
## [1] TRUE
2) A simple for loop would also work. Input L is from (1).
L2 <- L
for(i in seq_along(L2)[-1]) L2[[i]] <- L2[[i]] + L2[[i-1]]
ix <- 1:2
out3 <- c(L[ix], L2[-ix])
# check - out2 is from (1)
identical(out2, out3)
## [1] TRUE
Here are two other options using apply or rowSums with array (borrow data from G. Grothendieck's answer)
> apply(
+ array(
+ do.call(
+ cbind,
+ L
+ ), c(2, 2, length(L))
+ ), 1:2, sum
+ )
[,1] [,2]
[1,] 15 45
[2,] 30 60
> rowSums(
+ array(
+ do.call(
+ cbind,
+ L
+ ), c(2, 2, length(L))
+ ),
+ dims = 2
+ )
[,1] [,2]
[1,] 15 45
[2,] 30 60
I have 3 vectors as such:
p
[,1]
[1,] 0.002715955
[2,] 0.004460214
[3,] 0.006855524
[4,] 0.007438570
[5,] 0.042657555
q
[,1]
[1,] 0.9972840
[2,] 0.9955398
[3,] 0.9931445
[4,] 0.9925614
[5,] 0.9573424
f
[,1]
[1,] 0.008364157
[2,] 0.013058930
[3,] 0.019131397
[4,] 0.020559785
[5,] 0.090786054
I want to perform the following operation so as to obtain the var-cov matrix (which fills only the upper triangle of the matrix)
v_ij <- p_i*q_j/(n*f_i*f_j); 1<=i<=j<=n
Where n is the number of observations(here 5). so I wrote the following code to perform the code
v_ij <- matrix(nrow=length(p), ncol=length(p))
for(i in 1:nrow(p)){
for(j in 1:nrow(q)){
if(i==j){
diag(v_ij) <- p[i]*q[j]/(f[i]*f[j])
}
}
}
This code was only able to fill the diagonal but I didn't which function could fill the upper part of the matrix for i
Maybe you can use tcrossprod + lower.tri, e.g.,
v <- tcrossprod(p,q)/tcrossprod(f)/5
v[lower.tri(v)] <- 0
such that
> v
[,1] [,2] [,3] [,4] [,5]
[1,] 0.04444444 0.050 0.05333333 0.05555556 0.05714286
[2,] 0.00000000 0.075 0.08000000 0.08333333 0.08571429
[3,] 0.00000000 0.000 0.09600000 0.10000000 0.10285714
[4,] 0.00000000 0.000 0.00000000 0.11111111 0.11428571
[5,] 0.00000000 0.000 0.00000000 0.00000000 0.12244898
DATA
p <- matrix(1:5,nrow = 5,ncol = 1)
q <- matrix(2:6,nrow = 5,ncol = 1)
f <- matrix(3:7,nrow = 5,ncol = 1)
You can use upper.tri() as suggested to produce the upper part if that is all you need. The cov() function produces the full symmetric matrix:
X <- matrix(rnorm(15), ncol=3)
vcov <- cov(X)
If you run
vcov[upper.tri(vcov, diag=TRUE)]
then you only extract the elements but return them as a vector, but
vcov*upper.tri(vcov, diag=TRUE)
will give you what you want.
> X <- matrix(rnorm(15), ncol=3)
> vcov <- cov(X)
> vcov[upper.tri(vcov, diag=TRUE)]
[1] 0.2698385 0.2844101 0.9375529 0.1457635 0.0223076 0.1626811
> vcov*upper.tri(vcov, diag=TRUE)
[,1] [,2] [,3]
[1,] 0.2698385 0.2844101 0.1457635
[2,] 0.0000000 0.9375529 0.0223076
[3,] 0.0000000 0.0000000 0.1626811
I want to initialise a matrix with randomly generated numbers such that the sum of numbers in a row/column is 1 in 1 go.Both do not need to be 1 simultaneously i.e. either row sum is 1 or column sum is 1
For sum of rows = 1 you could try something like:
num_rows <- 5
num_cols <- 5
random_uniform_matrix <- matrix(runif(num_rows * num_cols), nrow = num_rows, ncol = num_cols)
random_uniform_matrix_normalised <- random_uniform_matrix / rowSums(random_uniform_matrix)
random_uniform_matrix_normalised
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0.23587728 0.09577532 0.28102271 0.03763127 0.34969342
# [2,] 0.07252286 0.42979916 0.19738456 0.19545165 0.10484177
# [3,] 0.12868304 0.30537875 0.08245634 0.26911364 0.21436823
# [4,] 0.31938540 0.37610285 0.18834984 0.10297283 0.01318908
# [5,] 0.10775810 0.09167090 0.54077248 0.16717661 0.09262190
I have the following matrix:
j <- matrix(c(1,1,.5,1,1,.5,.5,.5,1), nrow=3, ncol=3)
Which is positive semi-definite, because all of the eigenvalues are >= 0.
Source: https://math.stackexchange.com/questions/40849/how-to-check-if-a-symmetric-4-times4-matrix-is-positive-semi-definite
> eigen(j, symmetric = TRUE)
$values
[1] 2.3660254 0.6339746 0.0000000
$vectors
[,1] [,2] [,3]
[1,] -0.6279630 -0.3250576 7.071068e-01
[2,] -0.6279630 -0.3250576 -7.071068e-01
[3,] -0.4597008 0.8880738 -1.942890e-15
However, the cholesky decomposition fails...
> chol(j)
Error in chol.default(j) :
the leading minor of order 2 is not positive definite
I also adapted some code from the internet...
cholesky_matrix <- function(A){
# http://rosettacode.org/wiki/Cholesky_decomposition#C
L <- matrix(0,nrow=nrow(A),ncol=ncol(A))
colnames(L) <- colnames(A)
rownames(L) <- rownames(A)
m <- ncol(L)
for(i in 1:m){
for(j in 1:i){
s <- 0
if(j > 1){
for(k in 1:(j-1)){
s <- s + L[i,k]*L[j,k]
}
}
if(i == j){
L[i,j] <- sqrt(A[i,i] - s)
} else {
L[i,j] <- (1 / L[j,j])*(A[i,j] - s)
}
}
}
return(L)
}
Which also "fails" with NaNs.
> cholesky_matrix(j)
[,1] [,2] [,3]
[1,] 1.0 0 0
[2,] 1.0 0 0
[3,] 0.5 NaN NaN
Does anyone have any idea what is going on? Why is my decomposition failing?
The eigenvalues of your matrix are
> eigen(j)
$values
[1] 2.366025e+00 6.339746e-01 4.440892e-16
the last of which is effectively zero, within the limits of numerical precision. Per ?chol:
Compute the Choleski factorization of a real symmetric positive-definite square matrix.
(emphasis mine)
That said, you can still get the decomposition by setting pivot=TRUE, which is able to handle semi-definiteness:
> chol(j, pivot=TRUE)
[,1] [,2] [,3]
[1,] 1 0.5000000 1
[2,] 0 0.8660254 0
[3,] 0 0.0000000 0
attr(,"pivot")
[1] 1 3 2
attr(,"rank")
[1] 2
Warning message:
In chol.default(j, pivot = TRUE) :
the matrix is either rank-deficient or indefinite
I am trying to do something relatively simple in R; I am trying to compute the percentage changes from one row to the next for each component of the matrix. This is the code I am running
> fun <- function(x) diff(x, lag=1)/lag(x,1);
> mat <- dx[2490:2520,];
> mat <- apply(mat, 2, fun);
There were 30 warnings (use warnings() to see them)
> warnings()
Warning messages:
1: In diff(x, lag = 1)/lag(x, 1) :
longer object length is not a multiple of shorter object length
The R console returns this message to me, and I have no idea why. If this doesn't work, can someone point out a different way to compute percentage changes? any help with this is appreciated.
If the input is m rows and n columns, and you want the output to be m-1 rows and n columns, then:
(mat <- matrix(sample(50, 15, replace = TRUE), nr=3, nc=5))
## [,1] [,2] [,3] [,4] [,5]
## [1,] 28 2 21 9 2
## [2,] 18 11 8 2 24
## [3,] 21 2 20 8 21
apply(mat, 2, function(cc) (cc[-1] - head(cc, n = -1)) / head(cc, n = -1))
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.3571429 4.5000000 -0.6190476 -0.7777778 11.000
## [2,] 0.1666667 -0.8181818 1.5000000 3.0000000 -0.125
Or, even faster:
nr <- nrow(mat)
(mat[-1,] - mat[-nr,]) / mat[-nr,]
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.3571429 4.5000000 -0.6190476 -0.7777778 11.000
## [2,] 0.1666667 -0.8181818 1.5000000 3.0000000 -0.125