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?
Related
I apologize in advance for the elementary question, but thought it may be a quick pointer from someone out there.
I am looking at this publicly-available code and wondering why it runs slow (or stalls completely), when the mu for the negative binomial generation is >1. Is it related to the nested loops?
Thank you.
for(i in 1:runs) {
cases <- seed
t <- rep(0,seed)
times <- t
while(cases > 0) {
secondary <- rnbinom(cases,size=fit.cases$estimate[1],mu=fit.cases$estimate[2])
t.new <- numeric()
for(j in 1:length(secondary)) {
t.new <- c(t.new,t[j] + rgamma(secondary[j],shape=fit.serial$estimate[1],
rate=fit.serial$estimate[2]))
}
cases <- length(t.new)
t <- t.new
times <- c(times,t.new)
}
lines(sort(times),1:length(times),col=cols[i],lwd=1)
points(max(times),length(times),col=cols[i],pch=16)
}
https://github.com/calthaus/Ebola/blob/master/Superspreading%20(Lancet%20Inf%20Dis%202015)/Ebola_superspreading_analysis.R
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)
}
I'm trying to improve the speed of my code, which is trying to optimise a value using 3 variables which have large ranges. The most likely output uses values in the middle of the ranges, so it is wasting time starting from the lowest possible value of each variable. I want to start from the middle value and iterate out! The actual problem has thousands of lines with numbers from 150-650. C,H and O limits will be defined somewhat based on the starting number, but will always be more likely at a central value in the defined range. Is there a way to define the for loop to work outwards like I want? The only, quite shabby, way I can think of is to simply redefine the value within the loop from a vector (e.g. 1=20, 2=21, 3=19, etc). See current code below:
set_error<-2.5
ct<-c(325.00214,325.00952,325.02004,325.02762,325.03535,325.03831,325.04588, 325.05641,325.06402,325.06766,325.07167,325.07454,325.10396)
FormFun<-function(x){
for(C in 1:40){
for(H in 1:80){
for(O in 1:40){
test_mass=C*12+H*1.007825+O*15.9949146-1.0072765
error<-1000000*abs(test_mass-x)/x
if(error<set_error){
result<-paste("C",C,"H",H,"O",O,sep ="")
return(result)
break;break;break;break
}
}
}
}
}
old_t <- Sys.time()
ct2<-lapply(ct,FormFun)
new_t <- Sys.time() - old_t # calculate difference
print(new_t)
Use vectorization and create a closure:
FormFun1_fac <- function(gr) {
gr <<- gr
function(x, set_error){
test_mass <- with(gr, C*12+H*1.007825+O*15.9949146-1.0072765)
error <- 1000000 * abs(test_mass - x) / x
ind <- which(error < set_error)[1]
if (is.na(ind)) return(NULL)
paste0("C", gr[ind, "C"],"H", gr[ind, "H"],"O", gr[ind, "O"])
}
}
FormFun1 <- FormFun1_fac(expand.grid(C = 1:40, H = 1:80, O = 1:40))
ct21 <- lapply(ct, FormFun1, set_error = set_error)
all.equal(ct2, ct21)
#[1] TRUE
This saves a grid of all combinations of C, H, O in the function environment and calculates the error for all combinations (which is fast in vectorized code). The first combination that passes the test is returned.
I'm a novice R user and have created a small script that is doing some trigonometry with movement data. I need to add a final column that deletes repeated values from the column before it.
I've tried adding an if else statement that seems to work when isolated, but keep having errors when it is put into the for loop. I'd appreciate any advice.
# trig loop
list.df <- vector("list", max(Sp_test$ID))
names1 <- c(1:max(Sp_test$ID))
for(i in 1:max(Sp_test$ID)) {
if(i %in% unique(Sp_test$ID)) {
idata <- subset(Sp_test, ID == i)
idata$originx <- idata[1,3]
idata$originy <- idata[1,4]
idata$deltax <- idata[,"UTME"]-idata[,"originx"]
idata$deltay <- idata[,"UTMN"]-idata[,"originy"]
idata$length <- sqrt((idata[,"deltax"])^2+(idata[,"deltay"]^2))
idata$arad <- atan2(idata[,"deltay"],idata[,"deltax"])
idata$xnorm <- idata[,"deltax"]/idata[,"length"]
idata$ynorm <- idata[,"deltay"]/idata[,"length"]
sumy <- sum(idata$ynorm, na.rm=TRUE)
sumx <- sum(idata$xnorm, na.rm=TRUE)
idata$vecsum <- atan2(sumy,sumx)
idata$width <- idata$length*sin(idata$arad-idata$vecsum)
# need if else statement excluding a repeat from the position just before it
list.df[[i]] <- idata
names1[i] <- i
} }
# this works alone, I think the problem is when it gets to the first of the dataset and there is not one before it
if (idata$width[j]==idata$width[j-1]) {
print("NA")
} else {
print(idata$width[j])
}
I think you want to use the function diff for this. diff(idata$width) will give the differences between successive values of idata$width. Then
idata$width[c(FALSE, diff(idata$width) == 0)] <- NA
I think does what you want. The initial FALSE is since there is no value corresponding to the first element (since as you rightly noted, the first element doesn't have an element before it).
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.