changeset 26:3c06cab3db2c draft

Uploaded
author greg
date Thu, 09 Nov 2017 11:30:27 -0500
parents 3852133fb058
children 24949e72f7ec
files insect_phenology_model.R
diffstat 1 files changed, 129 insertions(+), 132 deletions(-) [+]
line wrap: on
line diff
--- a/insect_phenology_model.R	Thu Nov 09 11:30:20 2017 -0500
+++ b/insect_phenology_model.R	Thu Nov 09 11:30:27 2017 -0500
@@ -25,24 +25,22 @@
 args <- parse_args(parser, positional_arguments=TRUE)
 opt <- args$options
 
-get_temperature_file_path=function(loc, temperature_data)
+convert_csv_to_rdata=function(loc, temperature_data)
 {
-    expdata <- matrix(rep(0, opt$num_days * 3), nrow=opt$num_days)
+    expdata <- matrix(rep(0, opt$num_days * 6), nrow=opt$num_days)
     expdata[,1] <- c(1:opt$num_days)
     # Minimum
-    expdata[,2] <- temperature_data[c(1:opt$num_days), 3]
+    expdata[,2] <- temperature_data[c(1:opt$num_days), 5]
     # Maximum
-    expdata[,3] <- temperature_data[c(1:opt$num_days), 2]
-    date <- temperature_data[1, 3]
-    year <- substr(date, 1, 4)
-    namedat <- paste(loc,  year, ".Rdat", sep="")
+    expdata[,3] <- temperature_data[c(1:opt$num_days), 6]
+    namedat <- "tempdata.Rdat"
     save(expdata, file=namedat)
     namedat
 }
 
 daylength=function(latitude, num_days)
 {
-    # from Forsythe 1995
+    # From Forsythe 1995.
     p=0.8333
     dl <- NULL
     for (i in 1:num_days) {
@@ -50,15 +48,16 @@
         phi <- asin(0.39795 * cos(theta))
         dl[i] <- 24 - 24 / pi * acos((sin(p * pi / 180) + sin(latitude * pi / 180) * sin(phi)) / (cos(latitude * pi / 180) * cos(phi)))
     }
-    # return a vector of daylength for the number of
-    # days specifie din the input temperature data
+    # Return a vector of daylength for the number of
+    # days specified in the input temperature data.
     dl
 }
 
 hourtemp=function(latitude, date, temperature_file_path, num_days)
 {
     load(temperature_file_path)
-    # base development threshold for BMSB
+    # Base development threshold for Brown Marmolated Stink Bug
+    # insect phenology model.
     threshold <- 14.17
     dnp <- expdata[date, 2]  # daily minimum
     dxp <- expdata[date, 3]  # daily maximum
@@ -69,27 +68,29 @@
         dd <- 0
     }
     else {
-        # extract daylength data for the number of
-        # days specified in the input temperature data
+        # Extract daylength data for the number of
+        # days specified in the input temperature data.
         dlprofile <- daylength(latitude, num_days)
-        T <- NULL  # initialize hourly temperature
-        dh <- NULL #initialize degree hour vector
-        # calculate daylength in given date
+        # Initialize hourly temperature.
+        T <- NULL
+        # Initialize degree hour vector.
+        dh <- NULL
+        # Calculate daylength in given date.
         y <- dlprofile[date]
-        # night length
+        # Night length.
         z <- 24 - y
-        # lag coefficient
+        # Lag coefficient.
         a <- 1.86
-        # night coefficient
+        # Night coefficient.
         b <- 2.20
-        # sunrise time
+        # Sunrise time.
         risetime <- 12 - y / 2
-        # sunset time
+        # Sunset time.
         settime <- 12 + y / 2
         ts <- (dxp - dnp) * sin(pi * (settime - 5) / (y + 2 * a)) + dnp
         for (i in 1:24) {
             if (i > risetime && i<settime) {
-                # number of hours after Tmin until sunset
+                # Number of hours after Tmin until sunset.
                 m <- i - 5
                 T[i]=(dxp - dnp) * sin(pi * m / (y + 2 * a)) + dnp
                 if (T[i]<8.4) {
@@ -197,44 +198,45 @@
     return
 }
 
-cat("Replications: ", opt$replications, "\n")
-cat("Photoperiod: ", opt$photoperiod, "\n")
-cat("Oviposition rate: ", opt$oviposition, "\n")
-cat("Egg mortality rate: ", opt$egg_mort, "\n")
-cat("Nymph mortality rate: ", opt$nymph_mort, "\n")
-cat("Adult mortality rate: ", opt$adult_mort, "\n")
-cat("Min clutch size: ", opt$min_clutch_size, "\n")
-cat("Max clutch size: ", opt$max_clutch_size, "\n")
-cat("(egg->young nymph): ", opt$young_nymph_accum, "\n")
-cat("(young nymph->old nymph): ", opt$old_nymph_accum, "\n")
-cat("(old nymph->adult): ", opt$adult_accum, "\n")
-
 # Read in the input temperature datafile into a Data Frame object.
 temperature_data <- read.csv(file=opt$input, header=T, sep=",")
-temperature_file_path <- get_temperature_file_path(opt$location, temperature_data)
+temperature_file_path <- convert_csv_to_rdata(opt$location, temperature_data)
 latitude <- temperature_data[1, 1]
 
+cat("Number of days: ", opt$num_days, ", ")
+cat("Latitude: ", latitude, "\n")
+cat("Replications: ", opt$replications, ", ")
+cat("Photoperiod: ", opt$photoperiod, "\n")
+cat("Oviposition rate: ", opt$oviposition, ", ")
+cat("Egg mortality rate: ", opt$egg_mort, "\n")
+cat("Nymph mortality rate: ", opt$nymph_mort, ", ")
+cat("Adult mortality rate: ", opt$adult_mort, "\n")
+cat("Min clutch size: ", opt$min_clutch_size, ", ")
+cat("Max clutch size: ", opt$max_clutch_size, "\n")
+cat("(egg->young nymph): ", opt$young_nymph_accum, ", ")
+cat("(young nymph->old nymph): ", opt$old_nymph_accum, "\n")
+cat("(old nymph->adult): ", opt$adult_accum
+
 # Initialize matrix for results from all replications
 S0.rep <- S1.rep <- S2.rep <- S3.rep <- S4.rep <- S5.rep <- matrix(rep(0, opt$num_days * opt$replications), ncol = opt$replications)
 newborn.rep <- death.rep <- adult.rep <- pop.rep <- g0.rep <- g1.rep <- g2.rep <- g0a.rep <- g1a.rep <- g2a.rep <- matrix(rep(0, opt$num_days * opt$replications), ncol=opt$replications)
 
 # loop through replications
 for (N.rep in 1:opt$replications) {
-    # during each replication
-    # start with 1000 individuals -- user definable as well?
+    # During each replication start with 1000 individuals.
+    # TODO: user definable as well?
     n <- 1000
-    # Generation, Stage, DD, T, Diapause
+    # Generation, Stage, DD, T, Diapause.
     vec.ini <- c(0, 3, 0, 0, 0)
-    # overwintering, previttelogenic, DD=0, T=0, no-diapause
+    # Overwintering, previttelogenic, DD=0, T=0, no-diapause.
     vec.mat <- rep(vec.ini, n)
-    # complete matrix for the population
-    vec.mat <- t(matrix(vec.mat, nrow=5))
-    # complete photoperiod profile in a year, requires daylength function
+    # Complete matrix for the population.
+    vec.mat <- base::t(matrix(vec.mat, nrow=5))
+    # Complete photoperiod profile in a year, requires daylength function.
     ph.p <- daylength(latitude, opt$num_days)
 
-    # time series of population size
+    # Time series of population size.
     tot.pop <- NULL
-    # gen.0 pop size
     gen0.pop <- rep(0, opt$num_days)
     gen1.pop <- rep(0, opt$num_days)
     gen2.pop <- rep(0, opt$num_days)
@@ -243,28 +245,25 @@
     N.newborn <- N.death <- N.adult <- rep(0, opt$num_days)
     dd.day <- rep(0, opt$num_days)
 
-    # start tick
-    ptm <- proc.time()
-
     # All the days included in the input temperature dataset.
     for (day in 1:opt$num_days) {
-        # photoperiod in the day
+        # Photoperiod in the day.
         photoperiod <- ph.p[day]
         temp.profile <- hourtemp(latitude, day, temperature_file_path, opt$num_days)
         mean.temp <- temp.profile[1]
         dd.temp <- temp.profile[2]
         dd.day[day] <- dd.temp
-        # trash bin for death
+        # Trash bin for death.
         death.vec <- NULL
-        # new born
+        # Newborn.
         birth.vec <- NULL
 
-        # all individuals
+        # All individuals.
         for (i in 1:n) {
-            # find individual record
+            # Find individual record.
             vec.ind <- vec.mat[i,]
-            # first of all, still alive?  
-            # adjustment for late season mortality rate
+            # First of all, still alive?
+            # Adjustment for late season mortality rate.
             if (latitude < 40.0) {
                 post.mort <- 1
                 day.kill <- 300
@@ -274,19 +273,19 @@
                 day.kill <- 250
             }
             if (vec.ind[2] == 0) {
-                # egg
+                # Egg.
                 death.prob = opt$egg_mort * mortality.egg(mean.temp)
             }
             else if (vec.ind[2] == 1 | vec.ind[2] == 2) {
                 death.prob = opt$nymph_mort * mortality.nymph(mean.temp)
             }
             else if (vec.ind[2] == 3 | vec.ind[2] == 4 | vec.ind[2] == 5) {
-                # for adult
+                # For adult.
                 if (day < day.kill) {
                     death.prob = opt$adult_mort * mortality.adult(mean.temp)
                 }
                 else {
-                    # increase adult mortality after fall equinox
+                    # Increase adult mortality after fall equinox.
                     death.prob = opt$adult_mort * post.mort * mortality.adult(mean.temp)
                 }
             }
@@ -296,218 +295,216 @@
                 death.vec <- c(death.vec, i)
             } 
             else {
-                # aggregrate index of dead bug
-                # event 1 end of diapause
+                # Aggregrate index of dead bug.
+                # Event 1 end of diapause.
                 if (vec.ind[1] == 0 && vec.ind[2] == 3) {
-                    # overwintering adult (previttelogenic)
+                    # Overwintering adult (previttelogenic).
                     if (photoperiod > opt$photoperiod && vec.ind[3] > 68 && day < 180) {
-                        # add 68C to become fully reproductively matured
-                        # transfer to vittelogenic
+                        # Add 68C to become fully reproductively matured.
+                        # Transfer to vittelogenic.
                         vec.ind <- c(0, 4, 0, 0, 0)
                         vec.mat[i,] <- vec.ind
                     }
                     else {
-                        # add to DD
+                        # Add to dd.
                         vec.ind[3] <- vec.ind[3] + dd.temp
-                        # add 1 day in current stage
+                        # Add 1 day in current stage.
                         vec.ind[4] <- vec.ind[4] + 1
                         vec.mat[i,] <- vec.ind
                     }
                 }
                 if (vec.ind[1] != 0 && vec.ind[2] == 3) {
-                    # NOT overwintering adult (previttelogenic)
+                    # Not overwintering adult (previttelogenic).
                     current.gen <- vec.ind[1]
                     if (vec.ind[3] > 68) {
-                        # add 68C to become fully reproductively matured
-                        # transfer to vittelogenic
+                        # Add 68C to become fully reproductively matured.
+                        # Transfer to vittelogenic.
                         vec.ind <- c(current.gen, 4, 0, 0, 0)
                         vec.mat[i,] <- vec.ind
                     }
                     else {
-                        # add to DD
+                        # Add to dd.
                         vec.ind[3] <- vec.ind[3] + dd.temp
-                        # add 1 day in current stage
+                        # Add 1 day in current stage.
                         vec.ind[4] <- vec.ind[4] + 1
                         vec.mat[i,] <- vec.ind
                     }
                 }
 
-                # event 2 oviposition -- where population dynamics comes from
+                # Event 2 oviposition -- where population dynamics comes from.
                 if (vec.ind[2] == 4 && vec.ind[1] == 0 && mean.temp > 10) {
-                    # vittelogenic stage, overwintering generation
+                    # Vittelogenic stage, overwintering generation.
                     if (vec.ind[4] == 0) {
-                        # just turned in vittelogenic stage
+                        # Just turned in vittelogenic stage.
                         n.birth=round(runif(1, 2 + opt$min_clutch_size, 8 + opt$max_clutch_size))
                     }
                     else {
-                        # daily probability of birth
+                        # Daily probability of birth.
                         p.birth = opt$oviposition * 0.01
                         u1 <- runif(1)
                         if (u1 < p.birth) {
                             n.birth=round(runif(1, 2, 8))
                         }
                     }
-                    # add to DD
+                    # Add to dd.
                     vec.ind[3] <- vec.ind[3] + dd.temp
-                    # add 1 day in current stage
+                    # Add 1 day in current stage.
                     vec.ind[4] <- vec.ind[4] + 1
                     vec.mat[i,] <- vec.ind
                     if (n.birth > 0) {
-                        # add new birth -- might be in different generations
-                        # generation + 1
+                        # Add new birth -- might be in different generations.
                         new.gen <- vec.ind[1] + 1
-                        # egg profile
+                        # Egg profile.
                         new.ind <- c(new.gen, 0, 0, 0, 0)
                         new.vec <- rep(new.ind, n.birth)
-                        # update batch of egg profile
+                        # Update batch of egg profile.
                         new.vec <- t(matrix(new.vec, nrow=5))
-                        # group with total eggs laid in that day
+                        # Group with total eggs laid in that day.
                         birth.vec <- rbind(birth.vec, new.vec)
                     }
                 }
 
-                # event 2 oviposition -- for gen 1.
+                # Event 2 oviposition -- for gen 1.
                 if (vec.ind[2] == 4 && vec.ind[1] == 1 && mean.temp > 12.5 && day < 222) {
-                    # vittelogenic stage, 1st generation
+                    # Vittelogenic stage, 1st generation
                     if (vec.ind[4] == 0) {
-                        # just turned in vittelogenic stage
+                        # Just turned in vittelogenic stage.
                         n.birth=round(runif(1, 2 + opt$min_clutch_size, 8 + opt$max_clutch_size))
                     }
                     else {
-                        # daily probability of birth
+                        # Daily probability of birth.
                         p.birth = opt$oviposition * 0.01
                         u1 <- runif(1)
                         if (u1 < p.birth) {
                             n.birth = round(runif(1, 2, 8))
                         }
                     }
-                    # add to DD
+                    # Add to dd.
                     vec.ind[3] <- vec.ind[3] + dd.temp
-                    # add 1 day in current stage
+                    # Add 1 day in current stage.
                     vec.ind[4] <- vec.ind[4] + 1
                     vec.mat[i,] <- vec.ind
                     if (n.birth > 0) {
-                        # add new birth -- might be in different generations
-                        # generation + 1
+                        # Add new birth -- might be in different generations.
                         new.gen <- vec.ind[1] + 1
-                        # egg profile
+                        # Egg profile.
                         new.ind <- c(new.gen, 0, 0, 0, 0)
                         new.vec <- rep(new.ind, n.birth)
-                        # update batch of egg profile
+                        # Update batch of egg profile.
                         new.vec <- t(matrix(new.vec, nrow=5))
-                        # group with total eggs laid in that day
+                        # Group with total eggs laid in that day.
                         birth.vec <- rbind(birth.vec, new.vec)
                     }
                 }
 
-                # event 3 development (with diapause determination)
-                # event 3.1 egg development to young nymph (vec.ind[2]=0 -> egg)
+                # Event 3 development (with diapause determination).
+                # Event 3.1 egg development to young nymph (vec.ind[2]=0 -> egg).
                 if (vec.ind[2] == 0) {
-                    # egg stage
-                    # add to DD
+                    # Egg stage.
+                    # Add to dd.
                     vec.ind[3] <- vec.ind[3] + dd.temp
                     if (vec.ind[3] >= (68 + opt$young_nymph_accum)) {
-                        # from egg to young nymph, DD requirement met
+                        # From egg to young nymph, DD requirement met.
                         current.gen <- vec.ind[1]
-                        # transfer to young nym stage
+                        # Transfer to young nymph stage.
                         vec.ind <- c(current.gen, 1, 0, 0, 0)
                     }
                     else {
-                        # add 1 day in current stage
+                        # Add 1 day in current stage.
                         vec.ind[4] <- vec.ind[4] + 1
                     }
                     vec.mat[i,] <- vec.ind
                 }
 
-                # event 3.2 young nymph to old nymph (vec.ind[2]=1 -> young nymph: determines diapause)
+                # Event 3.2 young nymph to old nymph (vec.ind[2]=1 -> young nymph: determines diapause).
                 if (vec.ind[2] == 1) {
-                    # young nymph stage
-                    # add to DD
+                    # young nymph stage.
+                    # add to dd.
                     vec.ind[3] <- vec.ind[3] + dd.temp
                     if (vec.ind[3] >= (250 + opt$old_nymph_accum)) {
-                        # from young to old nymph, DD requirement met
+                        # From young to old nymph, dd requirement met.
                         current.gen <- vec.ind[1]
-                        # transfer to old nym stage
+                        # Transfer to old nym stage.
                         vec.ind <- c(current.gen, 2, 0, 0, 0)
                         if (photoperiod < opt$photoperiod && day > 180) {
                             vec.ind[5] <- 1
-                        } # prepare for diapausing
+                        } # Prepare for diapausing.
                     }
                     else {
-                        # add 1 day in current stage
+                        # Add 1 day in current stage.
                         vec.ind[4] <- vec.ind[4] + 1
                     }
                     vec.mat[i,] <- vec.ind
                 }  
 
-                # event 3.3 old nymph to adult: previttelogenic or diapausing?
+                # Event 3.3 old nymph to adult: previttelogenic or diapausing?
                 if (vec.ind[2] == 2) {
-                    # old nymph stage
-                    # add to DD
+                    # Old nymph stage.
+                    # add to dd.
                     vec.ind[3] <- vec.ind[3] + dd.temp
                     if (vec.ind[3] >= (200 + opt$adult_accum)) {
-                        # from old to adult, DD requirement met
+                        # From old to adult, dd requirement met.
                         current.gen <- vec.ind[1]
                         if (vec.ind[5] == 0) {
-                            # non-diapausing adult -- previttelogenic
+                            # Non-diapausing adult -- previttelogenic.
                             vec.ind <- c(current.gen, 3, 0, 0, 0)
                         }
                         else {
-                            # diapausing 
+                            # Diapausing.
                             vec.ind <- c(current.gen, 5, 0, 0, 1)
                         }
                     }
                     else {
-                        # add 1 day in current stage
+                        # Add 1 day in current stage.
                         vec.ind[4] <- vec.ind[4] + 1
                     }
                     vec.mat[i,] <- vec.ind
                 }
 
-                # event 4 growing of diapausing adult (unimportant, but still necessary)## 
+                # Event 4 growing of diapausing adult (unimportant, but still necessary).
                 if (vec.ind[2] == 5) {
                     vec.ind[3] <- vec.ind[3] + dd.temp
                     vec.ind[4] <- vec.ind[4] + 1
                     vec.mat[i,] <- vec.ind
                 }
-            } # else if it is still alive
-        } # end of the individual bug loop
+            } # Else if it is still alive.
+        } # End of the individual bug loop.
 
-        # find how many died
+        # Find how many died.
         n.death <- length(death.vec)
         if (n.death > 0) {
             vec.mat <- vec.mat[-death.vec, ]
         }
-        # remove record of dead
-        # find how many new born  
+        # Remove record of dead.
+        # Find how many new born.
         n.newborn <- length(birth.vec[,1])
         vec.mat <- rbind(vec.mat, birth.vec)
-        # update population size for the next day
+        # Update population size for the next day.
         n <- n - n.death + n.newborn 
 
-        # aggregate results by day
+        # Aggregate results by day.
         tot.pop <- c(tot.pop, n) 
-        # egg
+        # Egg.
         s0 <- sum(vec.mat[,2] == 0)
-        # young nymph
+        # Young nymph.
         s1 <- sum(vec.mat[,2] == 1)
-        # old nymph
+        # Old nymph.
         s2 <- sum(vec.mat[,2] == 2)
-        # previtellogenic
+        # Previtellogenic.
         s3 <- sum(vec.mat[,2] == 3)
-        # vitellogenic
+        # Vitellogenic.
         s4 <- sum(vec.mat[,2] == 4)
-        # diapausing
+        # Diapausing.
         s5 <- sum(vec.mat[,2] == 5)
-        # overwintering adult
+        # Overwintering adult.
         gen0 <- sum(vec.mat[,1] == 0)
-        # first generation
+        # First generation.
         gen1 <- sum(vec.mat[,1] == 1)
-        # second generation
+        # Second generation.
         gen2 <- sum(vec.mat[,1] == 2)
-        # sum of all adults
+        # Sum of all adults.
         n.adult <- sum(vec.mat[,2] == 3) + sum(vec.mat[,2] == 4) + sum(vec.mat[,2] == 5)
-        # gen.0 pop size
+        # Gen eration 0 pop size.
         gen0.pop[day] <- gen0
         gen1.pop[day] <- gen1
         gen2.pop[day] <- gen2
@@ -527,7 +524,7 @@
     }   # end of days specified in the input temperature data
 
     dd.cum <- cumsum(dd.day)
-    # collect all the outputs
+    # Collect all the outputs.
     S0.rep[,N.rep] <- S0
     S1.rep[,N.rep] <- S1
     S2.rep[,N.rep] <- S2