0

I am trying to run the code below. It is a population model for given life history traits in Elk. It starts with 100 elk who then have calves that are listed on the same row. At the end of each yearly cycle those calves that survive are given their own row in the data frame as yearlings. Yearlings are converted to adults the following year. Those adults the don't make it are deleted.

The code is a bit ugly so I apologize. I am still trying to rough things out. I'll pretty-fy it once it is running.

So when I run the code about half of the time it gives me the following error:

Error in `$<-.data.frame`(`*tmp*`, "Age", value = NA) : 
  replacement has 1 row, data has 0

I have a feeling this occurs when no calves make it through winter so there is nothing to be added to the data frame. But I am not sure and if it is I do not know how to fix it.

Thanks for your help...

Marc


library("dplyr")

num.years=30; #number of cycles (years) the model with run
start.cows=100; #set initial population of female elk
pop.list=list() #create an empty list to store the end results for each year
annual.pop=as.vector(start.cows)
growth.dat=setNames(data.frame(matrix(data = NA, nrow = num.years, ncol = 10)), c("Total_Population","Total_Females","Total_Males","Total_Calves","Total_Mortality","Female_Mortality","Male_Mortality","Calf_Mortality","Lambda","Winter_Length"))
lambda=as.vector(0)
winterlength=rbeta(num.years,2,2.5)*122
#create Matrix with header labels
pop.mat=setNames(data.frame(matrix(data = NA, nrow = start.cows, ncol = 19)), c("Age","Sex", "Spring_Condition","Calf","DoB", "Birth_Mass","Survive_to_Winter", "Gest_Energy", "Lact_Energy","Calf_Growth_Rate","Condition_Change","Winter_Condition","Winter_Survival","Eary_Winter_Calf_Mass","Calf_Winter_Survival","w","x","y","z"))
pop.mat$Age = "A"; # set all initial animals as adult
pop.mat$Sex = "F"; # set all initial animals as female

for(j in 1:num.years) { #loop population through chosen number of years
  num.elk=nrow(pop.mat); #recounts number of elk (rows)
  pop.mat$Elk
  WL=winterlength[j]
  #set inital sping body condition
  pop.mat$Spring_Condition=rweibull(num.elk,3.871341,6.146970)  #selects random body condition from disribution above #rnorm(1000,5.253205,1.910929)
  
  # pregnancy and sex of calves
  pop.mat$w=runif(num.elk,0,1)
  pop.mat$Calf=ifelse(pop.mat$Age=="A" & pop.mat$w <= 0.425 & pop.mat$Sex=="F", "F",
       ifelse(pop.mat$Age=="A" & pop.mat$w >0.425 & pop.mat$w <=0.85 & pop.mat$Sex=="F","M",
              ifelse(pop.mat$Age=="Y" & pop.mat$w <= 0.05 & pop.mat$Sex=="F","F",
                     ifelse(pop.mat$Age=="Y" & pop.mat$w >0.05 & pop.mat$w<=0.1 & pop.mat$Sex=="F", "M","N"))))

  #DOB and Birth Mass
  DoBstoch=rnorm(num.elk,0,9.236958)
  BMstoch=rnorm(num.elk,0, 2.577775)
  pop.mat$DoB=ifelse(pop.mat$Calf=="N", NA,(pop.mat$Spring_Condition*-2.485+163.11+DoBstoch))
  pop.mat$Birth_Mass=ifelse(pop.mat$Calf=="N",0, pop.mat$DoB*0.128-2.145+BMstoch)               
 
  #Calf Survival to early winter
  pop.mat$x=runif(num.elk,0,1)
  pop.mat$Survive_to_Winter=ifelse((pop.mat$Calf=="F" & pop.mat$x <= (-0.0101*pop.mat$Birth_Mass^2 + 0.4127*pop.mat$Birth_Mass-3.2477))|(pop.mat$Calf=="M" & pop.mat$x <= (-0.0016*pop.mat$Birth_Mass^3 + 0.0823*pop.mat$Birth_Mass^2-1.2594*pop.mat$Birth_Mass + 6.048)),TRUE,FALSE)
  
  # Additional energy devoted to gestation
  pop.mat$Gest_Energy=ifelse(pop.mat$Birth_Mass > 0,((pop.mat$Birth_Mass-12.0354)*12937),0)
  
  # Energy invested in lactation 
  pop.mat$Lact_Energy=ifelse(pop.mat$Birth_Mass > 0,((pop.mat$Gest_Energy*-5.552)+3000000),0)
  
  #Calf growth rate
  CGStoch=rnorm(num.elk,0,  0.03592153)
  pop.mat$Calf_Growth_Rate=ifelse(pop.mat$Birth_Mass > 0, pop.mat$Lact_Energy*(10^-7)+0.117+CGStoch,0)
  
  #Change in dam over summer
  pop.mat$Condition_Change=ifelse(pop.mat$Birth_Mass > 0, (pop.mat$Spring_Condition*-0.7)-(pop.mat$Calf_Growth_Rate*6.297)+8.423, (pop.mat$Spring_Condition*-0.7)+8.423)
  
  #Early Winter Conditon
  pop.mat$Winter_Condition=mapply(sum,pop.mat$Spring_Condition,pop.mat$Condition_Change)
  
  #Adult male harvest
  pop.mat$y=runif(num.elk,0,1)
  pop.mat$Winter_Survival=ifelse(pop.mat$Age=="A" & pop.mat$y >= 0.56 & pop.mat$Sex=="M",FALSE,TRUE)
  
  #Adult survival through winter
  pop.mat$z=runif(num.elk,0,1)
  pop.mat$Winter_Survival=ifelse(pop.mat$z<=(exp(-4.717+0.955*pop.mat$Winter_Condition))/(1+exp(-4.717+0.955*pop.mat$Winter_Condition)) & pop.mat$Winter_Survival!=FALSE,TRUE,FALSE)
  
  #Early Winter Calf Mass
  WMStoch=rnorm(num.elk,3.019996, 4.869422)
  pop.mat$Eary_Winter_Calf_Mass=ifelse(pop.mat$Birth_Mass > 0,pop.mat$Calf_Growth_Rate*193.13+25.398+WMStoch,0)
  
  #Calf survival through winter
  pop.mat$Calf_Winter_Survival=ifelse((-0.0120088*(pop.mat$Eary_Winter_Calf_Mass^2)+3.1656*pop.mat$Eary_Winter_Calf_Mass-109.9) >WL,TRUE,FALSE)
  
  # Save old data frame in list
  old.dat=pop.mat
  #assign(paste("Old.pop", j, sep = ""), pop.mat)
  old.pop=nrow(pop.mat)
  pop.list[[j]]<-pop.mat
  
  # Create a dataframe for calves that survie winter to become yearlings
  calf.mat = subset(pop.mat[,4],  pop.mat[,15] == TRUE)
  no.babies=length(calf.mat)
  calf.temp=setNames(data.frame(matrix(data = NA, nrow = no.babies, ncol = 19)),c("Age","Sex", "Spring_Condition","Calf","DoB", "Birth_Mass","Survive_to_Winter", "Gest_Energy", "Lact_Energy","Calf_Growth_Rate","Condition_Change","Winter_Condition","Winter_Survival","Eary_Winter_Calf_Mass","Calf_Winter_Survival","w","x","y","z"))
  
  calf.temp$Age=ifelse(no.babies>0,"Y",calf.temp$Age)
  calf.temp$Sex=ifelse(no.babies>0,calf.mat,calf.temp$Sex)
  
  # Delete rows W/ dead yearlings and adults from main data frame
  pop.mat <- filter(pop.mat, pop.mat$Winter_Survival == TRUE)
  
  # Set all yearlings as adults
  pop.mat$Age=ifelse(pop.mat$Age=="Y","A","A")
  
  # Merge adult and calf data frames
  
  pop.mat=rbind(pop.mat,calf.temp)
  
  # Create a vetor for the population at the end of year
  new.pop=nrow(pop.mat)
  annual.pop=c(annual.pop,nrow(pop.mat))
  
  # create a vector for the lambda at the end of each year
  L=new.pop/old.pop
  lambda=c(lambda,L)
  
  #create dataframe for population demographics if through years
  growth.dat[j,1]=new.pop
  growth.dat[j,2]=nrow(subset(pop.mat, old.dat[,2]=="F"))
  growth.dat[j,3]=nrow(subset(pop.mat, old.dat[,2]=="M"))
  growth.dat[j,4]=no.babies
  growth.dat[j,5]=nrow(subset(pop.mat, old.dat[,13]==FALSE))
  growth.dat[j,6]=nrow(subset(pop.mat, old.dat[,13]==FALSE & old.dat[,2]=="F"))
  growth.dat[j,7]=nrow(subset(pop.mat, old.dat[,13]==FALSE & old.dat[,2]=="M"))
  growth.dat[j,8]=nrow(subset(pop.mat, old.dat[,15]==FALSE))
  growth.dat[j,9]=L
  growth.dat[j,10]=winterlength[j]


# Create a first line
x=1:num.years
plot(x, growth.dat[,1], type = "b", frame = FALSE, pch = 19, 
     col = "black", xlab = "Year", ylab = "Population")
# Add a second line
lines(x, growth.dat[,2], pch = 18, col = "blue", type = "b", lty = 2)
lines(x, growth.dat[,3], pch = 17, col = "green", type = "b", lty = 2)
lines(x, growth.dat[,4], pch = 16, col = "red", type = "b", lty = 2)

# Add a legend to the plot
legend("topleft", legend=c("Total", "Females","Males","Calves"),
       col=c("black", "blue","green","red"), lty = 1:2, cex=0.8)
 

}

growth.dat
Marc Wiseman
  • 9
  • 1
  • 1
    I don't know that you'll get a lot of help with this as-is, MarcWiseman, for two reasons: (1) you should be able to reduce this substantially (if not self-resolve) if you go line by line and figure out which line is failing, please don't make use have to do that. Even if it's half the time, that means on average you only have to run it twice to find one. Once there, just look at all of the components of that one expression and see what looks "not quite right". (2) We don't have your data, so we're at a stand-still anyway. – r2evans Jan 29 '21 at 01:22
  • 1
    There are many techniques (strongly urged/requested!) that will help make this question a bit more reproducible for the rest of us to help with more confidence/certainty; please see https://stackoverflow.com/q/5963269, [mcve], and https://stackoverflow.com/tags/r/info for some good ideas. (Hint: sample data from `dput(head(...))` is a good start; so is reducing your data a bit.) Thanks! – r2evans Jan 29 '21 at 01:23
  • The error comes after this part in the code: calf.mat = subset(pop.mat[,4], pop.mat[,15] == TRUE) no.babies=length(calf.mat) calf.temp=setNames(data.frame(matrix(data = NA, nrow = no.babies, ncol = 19)),c("Age","Sex", "Spring_Condition","Calf","DoB", "Birth_Mass","Survive_to_Winter", "Gest_Energy", "Lact_Energy","Calf_Growth_Rate","Condition_Change","Winter_Condition","Winter_Survival","Eary_Winter_Calf_Mass","Calf_Winter_Survival","w","x","y","z")) calf.temp$Age=ifelse(no.babies>0,"Y",NA) calf.temp$Sex=ifelse(no.babies>0,calf.mat,NA) – Marc Wiseman Jan 29 '21 at 04:28
  • Perhaps it would be helpful to know that `length` of a dataframe returns the number of *columns*, not the *rows* as I suspect you intend. Try `no.babies=nrow(calf.mat)`. – r2evans Jan 29 '21 at 04:32
  • I think it has to with there being no new calves generated. But the code is still trying to create a data frame with no values. How can it ignores it when there are no new calves? – Marc Wiseman Jan 29 '21 at 04:33
  • If there are no new calves, then `length(calf.mat)` can still be non-zero, therefore `data.frame(matrix(..., nrow = no.babies, ncol = 19))` will have more than zero rows. Also, `ifelse(no.babies>0,...)` is using that function incorrectly. Just use `if (no.babies > 0) ... else ...`. (That isn't causing an error here, but it's bad practice.) – r2evans Jan 29 '21 at 04:36
  • Thanks r2evans. I changed that and I get the following new error: Error in matrix(data = NA, nrow = no.babies, ncol = 19) : non-numeric matrix extent – Marc Wiseman Jan 29 '21 at 04:36
  • Disregard my prev comment about `length`, I assumed it was a matrix or frame, but the way you're using `subset`, it is a vector, so `length` is appropriate. Sorry about that. Another sorry, I'm out (for now), g'night. – r2evans Jan 29 '21 at 04:39
  • 1
    r2evans...actually changing the ifelse to if...else fixed my problem. I appreciate your help. – Marc Wiseman Jan 29 '21 at 05:05

0 Answers0