Related
I have been told to implement the Levenberg-Marquardt algorithm in R studio, considering lambda's initial value equals 10. The algorithm must stop when the gradient's norm is lower than the tolerance. I also need to print the values that x1, x2, λ, ∇f(x), d1 and d2 take for each iteration. Any ideas on how to do it? Many thanks in advance
This is what I have:
library(pracma)
library(matlib)
MetodeLM<-function(f,xi,t)
{
l=10
stop=FALSE
x<-xi
k=0
while (stop==FALSE){
dk<- inv(hessian(f,x)+l*diag(diag(hessian(f,x))))
x1<-x+dk
if (Norm(grad(f,x1))<t){
stop<-TRUE
}
else{
if (f(x1) < f(x)){
l<-l/10
k<-k+1
stop<-FALSE
}
else{
l<-l*10
stop<-FALSE
}
}
}
}
Correcting a few mistakes in your code, the following implementation of Levenberg Marquadt's algorithm should work (note that the update rule for the algorithm is shown in the following figure):
library(pracma)
# tolerance = t, λ = l
LM <- function(f, x0, t, l=10, r=10) {
x <- x0
k <- 0
while (TRUE) {
H <- hessian(f, x)
G <- grad(f, x)
dk <- inv(H + l * diag(nrow(H))) %*% G # dk <- solve(H + l * diag(nrow(H)), G)
x1 <- x - dk # update rule
print(k) # iteration
# print(l) # λ
print(x1) # x1, x2
print(G) # ∇f(x)
print(dk) # d1, d2
if (Norm(G) < t) break
l <- ifelse(f(x1) < f(x), l / r, l * r)
k <- k + 1
x <- x1 # update the old point
}
}
For example, with the following function, the non-linear optimization algorithm will quickly find a local minimum point (in the 10th iteration) as shown below
f <- function(x) {
return ((x[1]^2+x[2]-25)^2 + (x[1]+x[2]^2-25)^2)
}
x0 <- rep(0,2)
LM(f, x0, t=1e-3, l=400, r=2)
# [1] 0
# [,1]
# [1,] 0.165563
# [2,] 0.165563
# [1] -50 -50
# [,1]
# [1,] -0.165563
# [2,] -0.165563
# [1] 1
# [,1]
# [1,] 0.7986661
# [2,] 0.7986661
# [1] -66.04255 -66.04255
# [,1]
# [1,] -0.6331031
# [2,] -0.6331031
# ...
# [1] 10
# [,1]
# [1,] 4.524938
# [2,] 4.524938
# [1] 0.0001194898 0.0001194898
# [,1]
# [1,] 5.869924e-07
# [2,] 5.869924e-07
The following animation shows the convergence to the local minimum point for the function:
The following one is with LoG function
In R I have two matrices X and Z and I would like a
matrix W such that the row (i) of W contains row (i) of X interacted with row (i) of Z.
W(i) = X(i1)Z(i1) ... X(iJ)Z(i1) ... X(i1)Z(iK) ... X(iJ)Z(iK)
Here is an example in small scale doing what I want:
set.seed(1)
n <- 3
K <- 2
J <- 3
X <- matrix(rnorm(J*n),ncol=J)
Z <- matrix(rnorm(K*n),ncol=K)
W <- matrix(NA,nrow=n,ncol=K*J)
for (i in 1:n)
{
for (k in 1:K)
{
for (j in 1:J)
{
W[i,j + J*(k-1)] <- X[i,j] * Z[i,k]
}
}
}
Is there a clever way to do that?
I ended up doing
X[,sort(rep(1:J,K))] * Z[,rep(1:K,J)]
For this example, you can do
cbind(X * Z[, 1], X * Z[, 2])
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0.1913117 -0.4871802 -0.1488552 0.3891785 -0.9910532 -0.3028107
#[2,] 0.2776285 0.4981436 1.1161854 -0.4067148 -0.7297608 -1.6351676
#[3,] -0.3257642 -0.3198541 0.2244645 -0.9400245 -0.9229703 0.6477142
Or more generally we can use apply for many more columns.
W[] <- apply(Z, 2, function(x) X * x)
which gives the same output as W which we get after running your loop.
W
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0.1913117 -0.4871802 -0.1488552 0.3891785 -0.9910532 -0.3028107
#[2,] 0.2776285 0.4981436 1.1161854 -0.4067148 -0.7297608 -1.6351676
#[3,] -0.3257642 -0.3198541 0.2244645 -0.9400245 -0.9229703 0.6477142
enter image description hereI want to create a 10 by 8 matrix from two matrices again with dimensions 10 by 8 by using for loops.
I have matrices a and e and I want to save the results of below code to a matrix. But when I run the code, the matrix chi is an empty matrix except with the last row of the last column. I am kind of newby to R, so any help is appreciated. Thanks.
chi <- matrix(nrow = 10, ncol = 8, byrow = T)
i <- nrow(a)
j <- ncol(a)
k <- nrow(e)
l <- ncol(e)
m <- nrow(chi)
n <- ncol(chi)
for (i in 1:nrow(a)) {
for (j in 1:ncol(a)) {
for (k in 1:nrow(e)) {
for (l in 1:ncol(e))
chi[m, n] <- ((a[i, j] - e[k, l]) ^ 2 / (e[k, l] * (1 - e[k, l])))
}
}
}
Reconsider using any nested for loops as you can simply run matrix algebra since all inputs, a and e, are equal length objects:
chi <- ((a - e) ^ 2 / (e * (1 - e)))
With your nested for loop approach, your attempted matrix cell assignment is overwritten with each inner loop pass and only the very last instance is saved.
To demonstrate, consider the following random matrices (seeded for reproducibility):
set.seed(1162018)
a <- matrix(runif(800), nrow = 10, ncol = 8)
e <- matrix(runif(800), nrow = 10, ncol = 8)
With following output:
chi2 <- ((a - e) ^ 2 / (e * (1 - e)))
chi2
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,] 1.090516287 5.314965506 0.30221649 4.3078030566 0.08185310 0.33991625 7.475638e-01 7.136321e+01
# [2,] 0.339472596 0.037831564 1.00181544 0.0075194551 0.27228312 20.74823838 2.308509e-04 1.264312e-04
# [3,] 0.001493967 0.009102797 17.76508355 0.0318190760 0.08133848 0.90538852 1.425952e-01 3.600838e-02
# [4,] 25.941857200 2.182678801 0.52170472 0.5485710933 0.57015681 0.09332506 2.631002e-01 4.897862e-01
# [5,] 4.341993499 0.075724451 0.03409925 0.0058830640 0.15290151 0.83227284 2.982630e+02 2.615268e-01
# [6,] 0.327661207 0.058150213 0.17328257 0.3161902785 4.48620227 0.14685330 2.996204e+00 1.888419e+01
# [7,] 0.456397833 1.446942556 0.51597191 0.2051742161 0.20440765 0.58169351 5.345522e+00 1.320896e-03
# [8,] 12.844776005 0.753941152 0.36425134 0.0003481929 0.34011118 2.38649404 1.082046e-01 1.817180e-01
# [9,] 0.042779101 0.119540004 1.41313002 0.1262586599 0.36583013 1.76476721 1.353301e+00 1.670491e-01
# [10,] 4.729182008 5.257386394 0.62181731 0.0000251250 0.32324943 0.08491841 6.627723e+00 2.127289e+00
Notice the very first, second, all the way to last elements of chi2 is consistent to your original formula as seen with using only single values. The all.equal() demonstrates no value difference between scientific notation or not.
((a[1, 1] - e[1, 1]) ^ 2 / (e[1, 1] * (1 - e[1, 1])))
# [1] 1.090516
((a[1, 2] - e[1, 2]) ^ 2 / (e[1, 2] * (1 - e[1, 2])))
# [1] 1.090516
# ...
((a[10, 8] - e[10, 8]) ^ 2 / (e[10, 8] * (1 - e[10, 8])))
# [1] 2.127289
all.equal(2.127289e+00, 2.127289)
# [1] TRUE
Incorrect For Loop Processing
However, adjusting your for loop to use chi[i,j] assignment which does yield values but on closer look does not accurately align to your original formula:
chi <- matrix(nrow = 10, ncol = 8, byrow = T)
i <- nrow(a)
j <- ncol(a)
k <- nrow(e)
l <- ncol(e)
m <- nrow(chi)
n <- ncol(chi)
for (i in 1:nrow(a)) {
for (j in 1:ncol(a)) {
for (k in 1:nrow(e)) {
for (l in 1:ncol(e))
chi[i,j] <- ((a[i, j] - e[k, l]) ^ 2 / (e[k, l] * (1 - e[k, l])))
}
}
}
chi
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,] 3.409875713 1.91797098 0.983457185 0.72023148 0.96731753 0.047236836 2.20811240 0.6073649
# [2,] 0.011756997 2.96049899 3.614632753 1.30476270 2.49116488 0.074379894 1.01941080 0.3796867
# [3,] 2.061628776 0.03227113 0.691592758 2.58226782 0.17603261 4.377353084 1.07957101 0.9584883
# [4,] 5.477395731 0.07409188 5.287871705 1.86472765 2.02597697 0.078780553 6.20319269 2.6099405
# [5,] 4.342937737 3.57579681 1.016981597 2.83351392 1.11431922 0.083484410 0.08412765 0.5525810
# [6,] 0.008175703 2.63310577 0.005053893 3.69703754 0.05993078 0.004768071 5.92075341 4.2435415
# [7,] 1.051921956 0.31217144 5.624012725 0.90161687 0.43301151 0.156739757 0.72284317 1.2243496
# [8,] 4.941310521 4.85504735 0.021515999 3.66512027 0.08358373 3.603038468 0.38618455 6.1389345
# [9,] 0.559136535 5.08204325 2.999036687 2.72726724 5.99168376 0.319859158 0.59398961 3.6221932
# [10,] 0.001668949 2.97353267 4.703763876 0.04979429 5.31715581 0.053267595 2.09966809 2.1272893
Here, the for loop returns only the very last instance since chi[i,j] is overwritten multiple times during loop. As a result, ALL elements of chi matrix uses the last element of e:
((a[1, 1] - e[10, 8]) ^ 2 / (e[10, 8] * (1 - e[10, 8])))
# [1] 3.409876
((a[1, 2] - e[10, 8]) ^ 2 / (e[10, 8] * (1 - e[10, 8])))
# [1] 1.917971
# ...
((a[10, 8] - e[10, 8]) ^ 2 / (e[10, 8] * (1 - e[10, 8])))
# [1] 2.127289
Conversely, with using chi[k,l] for assignment in loop.
for (i in 1:nrow(a)) {
for (j in 1:ncol(a)) {
for (k in 1:nrow(e)) {
for (l in 1:ncol(e))
chi[k,l] <- ((a[i, j] - e[k, l]) ^ 2 / (e[k, l] * (1 - e[k, l])))
}
}
}
chi
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,] 5.649285e-01 5.813300e+00 0.035949545 10.14845208 0.002533313 0.405749651 0.711058301 2.592142e+01
# [2,] 7.481556e+00 4.531135e-05 0.455696004 0.09284383 0.192074706 4.178867177 0.105489574 3.541626e-01
# [3,] 4.953702e-04 6.703029e+00 41.109139456 0.08957573 1.511080005 0.254656165 0.004840752 2.805246e-01
# [4,] 1.152237e+01 2.556255e-02 0.018652264 0.65975403 0.515919955 0.280219679 0.124379946 7.777978e-01
# [5,] 2.126765e+00 5.356927e-01 0.251885418 0.06540162 0.008580900 0.003271672 41.259025738 2.963719e-06
# [6,] 1.401345e-01 1.603721e-02 0.334385097 0.05865054 0.622973490 0.608273911 0.888928067 1.046868e+01
# [7,] 1.018507e-01 1.756129e-01 0.005676374 0.72309875 0.011666290 0.314863595 12.420604213 7.778975e-02
# [8,] 6.082752e+00 1.250805e-01 0.287099891 0.17209992 0.050136187 1.339028574 1.059674334 2.627769e-01
# [9,] 8.005223e-02 9.260464e-02 2.823995704 0.04935770 0.020361815 0.258144647 0.275514317 9.392584e-03
# [10,] 4.952038e-01 3.870331e+00 0.089420009 1.05729955 0.002429084 0.349966871 6.702385325 2.127289e+00
As a result, ALL matrix elements uses the last values of a:
((a[10, 8] - e[1, 1]) ^ 2 / (e[1, 1] * (1 - e[1, 1])))
# [1] 0.5649285
all.equal(5.649285e-01, 0.5649285)
# [1] TRUE
((a[10, 8] - e[1, 2]) ^ 2 / (e[1, 2] * (1 - e[1, 2])))
# [1] 5.8133
all.equal(5.813300e+00, 5.8133)
# [1] TRUE
# ...
((a[10, 8] - e[10, 8]) ^ 2 / (e[10, 8] * (1 - e[10, 8])))
# [1] 2.127289
I have two matrices, call them A (n x 2) and B (q x 2). I'd like to get an n x q x 2 array C, such that C[1,5,] represents the difference between the first row of A and the fifth row of B, taking the subtraction of the first element in the first row of A with the first element in the fifth row of B and the second element similarly subtracted.
I'm trying to perform this function via the outer function, but it also gives me the "non-diagonal" subtractions; i.e. it will also subtract A[1,1] - B[5,2] and A[1,2] - B[5,1] which I am not interested in. Does anyone have a fast, easy way to do this?
Current code
>diffs <- outer(A,B,FUN ='-')
>diffs[1,,5,]
[,1] [,2]
[1,] **-0.3808701** 0.7591052
[2,] 0.2629293 **1.4029046**
I've added the stars to indicate what I actually want.
Thanks for any help in advance
(EDIT)
Here's a simpler case for illustrative purposes
> A <- matrix(1:10, nrow = 5, ncol = 2)
> B <- matrix(4:9, nrow = 3, ncol = 2)
> A
[,1] [,2]
[1,] 1 6
[2,] 2 7
[3,] 3 8
[4,] 4 9
[5,] 5 10
> B
[,1] [,2]
[1,] 4 7
[2,] 5 8
[3,] 6 9
>diffs <- outer(A,B,FUN ='-')
>diffs[1,,3,] == (A[1,] - B[3,])
[,1] [,2]
[1,] TRUE FALSE
[2,] FALSE TRUE
>diffs[1,,3,]
[,1] [,2]
[1,] -5 -8
[2,] 0 -3
Before worrying about the shape of the output I think we should make sure we're getting the correct values.
A <- matrix(1:10, nrow=5, ncol=2)
B <- matrix(4:9, nrow=3, ncol=2)
# long-winded method
dia_long <- c(
c(A[1,] - B[1,]),
c(A[1,] - B[2,]),
c(A[1,] - B[3,]),
c(A[2,] - B[1,]),
c(A[2,] - B[2,]),
c(A[2,] - B[3,]),
c(A[3,] - B[1,]),
c(A[3,] - B[2,]),
c(A[3,] - B[3,]),
c(A[4,] - B[1,]),
c(A[4,] - B[2,]),
c(A[4,] - B[3,]),
c(A[5,] - B[1,]),
c(A[5,] - B[2,]),
c(A[5,] - B[3,]))
# loop method
comb <- expand.grid(1:nrow(A), 1:nrow(B))
dia_loop <- list()
for (i in 1:nrow(comb)) {
dia_loop[[i]] <- A[comb[i, 1], ] - B[comb[i, 2], ]
}
dia_loop <- unlist(dia_loop)
# outer/apply method
dia_outer <- apply(outer(A, B, FUN='-'), c(3, 1), diag)
# they all return the same values
all.identical <- function(l) {
all(sapply(2:length(l), FUN=function(x) identical(l[1], l[x])))
}
all.identical(lapply(list(dia_long, dia_loop, dia_outer), sort))
# TRUE
table(dia_long)
# dia_long
# -5 -4 -3 -2 -1 0 1 2 3
# 1 2 4 5 6 5 4 2 1
Are these the values you are looking for?
My solution: use nested lapply and sapply functions to extract the diagonals. I then needed to do some post-processing (not related to this specific problem), before I then turned it into an array. Should be noted that this is a q x 2 x n array, which turned out to be better for my purposes - this could be permuted with aperm from here though to solve the original question.
A <- matrix(1:10, nrow = 5, ncol = 2)
B <- matrix(4:9, nrow = 3, ncol = 2)
diffs <- outer(A,B, FUN = '-')
diffs <- lapply(X = 1:nrow(A),FUN = function(y){
t(sapply(1:ncol(B), FUN = function(x) diag(diffs[y,,x,])))})
diffs <- array(unlist(lapply(diffs, FUN = t)), dim = c(nrow(B),2,nrow(A)))
I have some problems with the transformation of a matrix and the names of the rows and columns.
My problem is as follows:
As input-matrix I have a (symmetric) correlation matrix like this one:
The correlation-vector is given by the values of the lower triangular matrix:
Now, I want to compute the variance-covariance-matrix of the these correlations, which are approximately normally distributed with the variance-covariance-matrix:
The variances can be approximated by
-> N is the sample size (in this example N = 66)
The covariances can be approximated by
For example the covariance between r_02 and r_13 is given by
Now, I want to define a function in R which gets the correlation matrix as input and returns the variance-covariance matrix. However, I have problems to implement the calculation of the covariances. My idea is to give names to the elements of the correlation_vector as shown above (r_01, r_02...). Then I want to create the empty variance-cocariance matrix, which has the length of the correlation_vector. The rows and the columns should have the same names as the correlation_vector, so I can call them for example by [01][03]. Then I want to implement a for-loop which sets the value of i and j as well as k and l as shown in the formula for the covariance to the columns and rows of the correlations that I need as input for the covariance-formula. These must always be six different values (ij; ik; il; jk; jl; lk). This is my idea, but I don't now how to implement this in R.
This is my code (without the calculation of the covariances):
require(corpcor)
correlation_matrix_input <- matrix(data=c(1.00,0.561,0.393,0.561,0.561,1.00,0.286,0.549,0.393,0.286,1.00,0.286,0.561,0.549,0.286,1.00),ncol=4,byrow=T)
N <- 66 # Sample Size
vector_of_correlations <- sm2vec(correlation_matrix_input, diag=F) # lower triangular matrix of correlation_matrix_input
variance_covariance_matrix <- matrix(nrow = length(vector_of_correlations), ncol = length(vector_of_correlations)) # creates the empty variance-covariance matrix
# function to fill the matrix by calculating the variance and the covariances
variances_covariances <- function(vector_of_correlations_input, sample_size) {
for (i in (seq(along = vector_of_correlations_input))) {
for (j in (seq(along = vector_of_correlations_input))) {
# calculate the variances for the diagonale
if (i == j) {
variance_covariance_matrix[i,j] = ((1-vector_of_correlations_input[i]**2)**2)/sample_size
}
# calculate the covariances
if (i != j) {
variance_covariance_matrix[i,j] = ???
}
}
}
return(variance_covariance_matrix);
}
Does anyone have an idea, how to implement the calculation of the covariances using the formula shown above?
I would be grateful for any kind of help regarding this problem!!!
It's easier if you keep r as a matrix and use this helper function to make things clearer:
covr <- function(r, i, j, k, l, n){
if(i==k && j==l)
return((1-r[i,j]^2)^2/n)
( 0.5 * r[i,j]*r[k,l]*(r[i,k]^2 + r[i,l]^2 + r[j,k]^2 + r[j,l]^2) +
r[i,k]*r[j,l] + r[i,l]*r[j,k] - (r[i,j]*r[i,k]*r[i,l] +
r[j,i]*r[j,k]*r[j,l] + r[k,i]*r[k,j]*r[k,l] + r[l,i]*r[l,j]*r[l,k]) )/n
}
Now define this second function:
vcovr <- function(r, n){
p <- combn(nrow(r), 2)
q <- seq(ncol(p))
outer(q, q, Vectorize(function(x,y) covr(r, p[1,x], p[2,x], p[1,y], p[2,y], n)))
}
And voila:
> vcovr(correlation_matrix_input, 66)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.007115262 0.001550264 0.002917481 0.003047666 0.003101602 0.001705781
[2,] 0.001550264 0.010832674 0.001550264 0.006109565 0.001127916 0.006109565
[3,] 0.002917481 0.001550264 0.007115262 0.001705781 0.003101602 0.003047666
[4,] 0.003047666 0.006109565 0.001705781 0.012774221 0.002036422 0.006625868
[5,] 0.003101602 0.001127916 0.003101602 0.002036422 0.007394554 0.002036422
[6,] 0.001705781 0.006109565 0.003047666 0.006625868 0.002036422 0.012774221
EDIT:
For the transformed Z values, as in your comment, you can use this:
covrZ <- function(r, i, j, k, l, n){
if(i==k && j==l)
return(1/(n-3))
covr(r, i, j, k, l, n) / ((1-r[i,j]^2)*(1-r[k,l]^2))
}
And simply replace it in vcovr:
vcovrZ <- function(r, n){
p <- combn(nrow(r), 2)
q <- seq(ncol(p))
outer(q, q, Vectorize(function(x,y) covrZ(r, p[1,x], p[2,x], p[1,y], p[2,y], n)))
}
New result:
> vcovrZ(correlation_matrix_input,66)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.015873016 0.002675460 0.006212598 0.004843517 0.006478743 0.002710920
[2,] 0.002675460 0.015873016 0.002675460 0.007869213 0.001909452 0.007869213
[3,] 0.006212598 0.002675460 0.015873016 0.002710920 0.006478743 0.004843517
[4,] 0.004843517 0.007869213 0.002710920 0.015873016 0.003174685 0.007858948
[5,] 0.006478743 0.001909452 0.006478743 0.003174685 0.015873016 0.003174685
[6,] 0.002710920 0.007869213 0.004843517 0.007858948 0.003174685 0.015873016
I wrote an approach using combn and row/column indices to generate the different combinations of p.
variances_covariances <- function(m, n) {
r <- m[lower.tri(m)]
var <- (1-r^2)^2
## generate row/column indices
rowIdx <- rep(1:nrow(m), times=colSums(lower.tri(m)))
colIdx <- rep(1:ncol(m), times=rowSums(lower.tri(m)))
## generate combinations
cov <- combn(length(r), 2, FUN=function(i) {
## current row/column indices
cr <- rowIdx[i] ## i,k
cc <- colIdx[i] ## j,l
## define 6 cases
p.ij <- m[cr[1], cc[1]]
p.ik <- m[cr[1], cr[2]]
p.il <- m[cr[1], cc[2]]
p.jk <- m[cc[1], cr[2]]
p.jl <- m[cc[1], cc[2]]
p.kl <- m[cr[2], cc[2]]
## calculate covariance
co <- 0.5 * p.ij * p.kl * (p.ik^2 + p.il^2 + p.jk^2 + p.jl^2) +
p.ik * p.jl + p.il * p.jk -
(p.ij * p.ik * p.il + p.ij * p.jk * p.jl + p.ik * p.jk * p.kl + p.il * p.jl * p.kl)
return(co)
})
## create output matrix
com <- matrix(NA, ncol=length(r), nrow=length(r))
com[lower.tri(com)] <- cov
com[upper.tri(com)] <- t(com)[upper.tri(com)]
diag(com) <- var
return(com/n)
}
Output:
m <- matrix(data=c(1.000, 0.561, 0.393, 0.561,
0.561, 1.000, 0.286, 0.549,
0.393, 0.286, 1.000, 0.286,
0.561, 0.549, 0.286, 1.00), ncol=4, byrow=T)
variances_covariances(m, 66)
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0.007115262 0.001550264 0.001550264 0.003101602 0.003101602 0.001705781
#[2,] 0.001550264 0.010832674 0.010832674 0.001127916 0.001127916 0.006109565
#[3,] 0.001550264 0.010832674 0.007115262 0.001127916 0.001127916 0.006109565
#[4,] 0.003101602 0.001127916 0.001127916 0.012774221 0.007394554 0.002036422
#[5,] 0.003101602 0.001127916 0.001127916 0.007394554 0.007394554 0.002036422
#[6,] 0.001705781 0.006109565 0.006109565 0.002036422 0.002036422 0.012774221
I hope, I have done everything right.
salam/hello
variance_covariance_matrix<- diag (variance vector, length (r),length (r))
pcomb <- combn(length(r), 2)
for (k in 1:length(r)){
i<- pcomb[1,k]
j<- pcomb[2,k]
variance_covariance_matrix[i,j]<- variance_covariance_matrix [j,i]<- genCorr[k] * sqrt (sig2g[i]) * sqrt (sig2g[j])
}