Renaming matrix and scalar in loop - r

I'm trying to make a loop, which changes the name for every iteration. The code is shown below. So what I basically need is for instance for a=2, I want W_(a-1) to refer to a matrix called W_1, W_(a) to refer to a matrix called W_1 and finally GMM_(a-1)$par should refer to GMM_(1)$par.
for (a in 2:100){
GMM <- function(beta) {
for (i in 1:(nrow(gmm_i))){
gmm_i[i,] <- g_beta(i,beta)
}
gmm_N <- t(colSums(gmm_i)) %*% W_(a-1) %*% colSums(gmm_i)
W_(a) <<- solve((1/(nrow(A)/5))*t(gmm_i)%*%gmm_i)
return(gmm_N)
}
GMM_(a)<-optim(GMM_(a-1)$par,GMM)
}
I hope my question makes sense.
Thanks.

Do you want 100 variables(a1,a2 ....) in your workspace? It will be better if you put all of this in a list as it will be easy to use. But if for some reason you do want a bunch of variables then use this,
W_1 = 0
for (a in 2:100){
GMM <- function(beta) {
for (i in 1:(nrow(gmm_i))){
gmm_i[i,] <- g_beta(i,beta)
}
gmm_N <- t(colSums(gmm_i)) %*% W_(a-1) %*% colSums(gmm_i)
tmp <- solve((1/(nrow(A)/5))*t(gmm_i)%*%gmm_i)
assign((paste("W_",a,sep="")),tmp,envir=.GlobalEnv)
return(gmm_N)
}
tmp1 <- optim(GMM_(a-1)$par,GMM)
assign((paste("GMM_",a,sep="")),tmp1,envir=.GlobalEnv)
GMM_(a)<-
}
Give W_1 appropriate value.

Related

Using map function instead of for loop in R

Apologies if this is a dumb question- I am quite new to R and have been trying to teach myself. I've been trying to rewrite the following code using a map function instead of a for loop.
columnmean <- function(y){
nc <- ncol(y)
means <- numeric(nc)
for(i in 1:nc){
means[i] <- mean(y[, i])
}
means
}
columnmean(mtcars)
My code which uses map prints out means but it also adds the column names as well. How do I utilize map properly to avoid this? Should I be using imap or map2? Thanks!
columnmean1 <- function(y){
nc <- ncol(y)
means <- numeric(nc)
map(y, function (y) means <- mean(y) )
}
columnmean1(mtcars)
You can use map_dbl :
columnmean_map <- function(y){
purrr::map_dbl(y, mean)
}
You can also use summarise_all
columnmean_summarise <- function(y){
dplyr::summarise_all(y, mean)
}

R - Saving the values from a For loop in a vector or list

I'm trying to save each iteration of this for loop in a vector.
for (i in 1:177) {
a <- geomean(er1$CW[1:i])
}
Basically, I have a list of 177 values and I'd like the script to find the cumulative geometric mean of the list going one by one. Right now it will only give me the final value, it won't save each loop iteration as a separate value in a list or vector.
The reason your code does not work is that the object ais overwritten in each iteration. The following code for instance does what precisely what you desire:
a <- c()
for(i in 1:177){
a[i] <- geomean(er1$CW[1:i])
}
Alternatively, this would work as well:
for(i in 1:177){
if(i != 1){
a <- rbind(a, geomean(er1$CW[1:i]))
}
if(i == 1){
a <- geomean(er1$CW[1:i])
}
}
I started down a similar path with rbind as #nate_edwinton did, but couldn't figure it out. I did however come up with something effective. Hmmmm, geo_mean. Cool. Coerce back to a list.
MyNums <- data.frame(x=(1:177))
a <- data.frame(x=integer())
for(i in 1:177){
a[i,1] <- geomean(MyNums$x[1:i])
}
a<-as.list(a)
you can try to define the variable that can save the result first
b <- c()
for (i in 1:177) {
a <- geomean(er1$CW[1:i])
b <- c(b,a)
}

Trying to use a for loop for population simulation(2)

Im sorry to say that I have a problem with a for loop, again. I'm trying to save the final number from a population estimate for loop into a new matrix but I am only able to get the population estimate to show up in row 100. I know it relates to breedingPop2 but I cant figure it out. Any help would be much appreciated. Please find the code below:
finalPop=matrix(nrow=102, ncol=1)
for(i in 1:100){
SWWAyears=data.frame(iteration=rep(NA,101),pop=NA)
breedingPop<-90000
fallMig<-.825
springMig<-.825
winterSurvival<-rbeta(100,.95,.05)
npFecund<-rbinom(100, 3.0, .9)
pFecund<-rbeta(100, .85,.25)
breedingSurvival<-rbeta(100,.95,.05)
# Set initial starting condition
SWWAyears[1,2]=breedingPop
for(years in 2:101) {
fallPop<-(SWWAyears[years-1,2]*fallMig)
for (i in 1:100){
winterPop<-(fallPop*winterSurvival[i])}
springPop<-(winterPop*springMig)
for (i in 1:100){
summerPop<-(springPop*breedingSurvival[i])
}
for(i in 1:100){
breedingPop2<-((summerPop*.26)*npFecund[i])+((summerPop*.14)*pFecund[i])+(summerPop*.60)
}
SWWAyears[years,1]=years
SWWAyears[years,2]<-breedingPop2
}
finalPop[i,1]<-breedingPop2
}
I think you have more fundamental issues with your looping structure and you're not getting the correct results you're expecting. However, the reason for your specific question about only the 100th row being updated is:
Your variable i is being updated inside your 'inner' for() loops, so by the time you reach finalPop[i, 1] <- breedingPop2, i always equals 100.
You need to use a different variable, j for example, in your inner for() loops.
finalPop=matrix(nrow=102, ncol=1)
for(i in 1:100){
SWWAyears = data.frame(iteration=rep(NA,101),pop=NA)
breedingPop <- 90000
fallMig <- .825
springMig <- .825
winterSurvival <- rbeta(100,.95,.05)
npFecund <- rbinom(100, 3.0, .9)
pFecund <- rbeta(100, .85,.25)
breedingSurvival <- rbeta(100,.95,.05)
# Set initial starting condition
SWWAyears[1,2] = breedingPop
for(years in 2:101) {
fallPop <- (SWWAyears[years-1,2]*fallMig)
for (j in 1:100){
winterPop <- (fallPop*winterSurvival[j])
}
springPop <- (winterPop*springMig)
for (j in 1:100){
summerPop <- (springPop*breedingSurvival[j])
}
for(j in 1:100){
breedingPop2 <- ((summerPop*.26)*npFecund[j])+((summerPop*.14)*pFecund[j])+(summerPop*.60)
}
SWWAyears[years,1] = years
SWWAyears[years,2] <- breedingPop2
}
finalPop[i,1] <- breedingPop2
}
Having said that, using multiple nested for() loops is generally not recommended in R; you should be able to use matrix multiplication / vectorisation to achieve the same result.
Other Issues
your values of winterPop and summerPop will only ever be fallPop * winterSurvival[100] and springPop * breedingSurvival[100] respectively. Is this what you intended?

Output function results to a vector

I have created a function to call a function on each row in a dataset. I would like to have the output as a vector. As you can see below the function outputs the results to the screen, but I cannot figure out how to redirect the output to a vector that I can use outside the function.
n_markers <- nrow(data)
p_values <-rep(0, n_markers)
test_markers <- function()
{
for (i in 1:n_markers)
{
hets <- data[i, 2]
hom_1 <- data[i, 3]
hom_2 <- data[i, 4]
p_values[i] <- SNPHWE(hets, hom_1, hom_2)
}
return(p_values)
}
test_markers()
Did you just take this code from here? I worry that you didn't even try to figure it out on your own first, but hopefully I am wrong.
You might be overthinking this. Simply store the results of your function in a vector like you do with other functions:
stored_vector <- test_markers()
But, as mentioned in the comments, your function could probably be reduced to:
stored_vector <- sapply(1:nrow(data), function(i) SNPHWE(data[i,2],data[i,3],data[i,4]) )

How do I do a QR decomposition on an object of class "sparseMatrix" in the Matrix package?

I want to do a QR decomposition with the Matrix:::qr() function on a Matrix that I created with B<-as(A, "sparseMatrix"). I know that I can get the R matrix with Matrix:::qr.R(). However, I also need to the Q Matrix. There seems to be no qr.Q() function in the Matrix package. How do I get the Q matrix?
The Q matrix is actually stored in the V slot. It seems that the current R Matrix version contains a bug --- it just mysteriously adds zero rows into the matrix a before doing the qr decomposition. I wish the developers could come and explain it. Therefore the following codes help you recover both R and Q:
gx.qr.Q <- function(a){
if(is(a, "qr")){
return(qr.Q(a, complete = T))
}else if(is(a, "sparseQR")){
Q <- diag(nrow = a#V#Dim[1], ncol = a#V#Dim[1])
for(i in rev(1:a#V#Dim[2])){
Q <- Q - (a#V[ ,i] * a#beta[i]) %*% (a#V[ ,i] %*% Q)
}
return(Q[order(a#p), ][1:a#Dim[1], 1:a#Dim[1]])
}else{
stop(gettextf("gx.qr.Q() fails on class '%s'", class(a)[1]))
}
}
gx.qr.R <- function(a){
if(is(a, "qr")){
return(qr.R(a, complete = T)[ ,order(a$pivot)])
}else if(is(a, "sparseQR")){
if(length(a#q) == 0){
return(a#R[1:a#Dim[1], ])
}else{
return(a#R[1:a#Dim[1] ,order(a#q)])
}
}else{
stop(gettextf("gx.qr.R() fails on class '%s'", class(a)[1]))
}
}
I have tested by randomly set the matrix size and sparsity and they work smoothly. However this is of the style "just make it work without knowing why", and is posted here only for discussion. Because I have not hacked into the implementation details of the package "Matrix".

Resources