insect_phenology_model: insect_phenology

comparison insect_phenology_model.R @ 85:8f5c05be4efe draft

Uploaded

author	greg
date	Wed, 22 Nov 2017 13:02:16 -0500
parents	0c807f99a816
children	522fe34a1dfc

comparison

equal deleted inserted replaced

-:1863d847749b
+:8f5c05be4efe
 opt <- args$options
 parse_input_data = function(input_file, num_rows) {
 # Read in the input temperature datafile into a data frame.
 temperature_data_frame <- read.csv(file=input_file, header=T, strip.white=TRUE, sep=",")
-if (dim(temperature_data_frame)[2] == 6) {
+num_columns <- dim(temperature_data_frame)[2]
+if (num_columns == 6) {
 # The input data has the following 6 columns:
 # LATITUDE, LONGITUDE, DATE, DOY, TMIN, TMAX
+# Set the column names for access when adding daylight length..
+colnames(temperature_data_frame) <- c("LATITUDE","LONGITUDE", "DATE", "DOY", "TMIN", "TMAX")
 # Add a column containing the daylight length for each day.
-temperature_data_frame <- add_daylight_length(temperature_data_frame, num_rows)
+temperature_data_frame <- add_daylight_length(temperature_data_frame, num_columns, num_rows)
-}
+# Reset the column names with the additional column for later access.
-# Return the temperature_data_frame.
+colnames(temperature_data_frame) <- c("LATITUDE","LONGITUDE", "DATE", "DOY", "TMIN", "TMAX", "DAYLEN")
-temperature_data_frame
+}
-}
+return(temperature_data_frame)
+}
-add_daylight_length = function(temperature_data_frame, num_rows) {
+add_daylight_length = function(temperature_data_frame, num_columns, num_rows) {
 # Return a vector of daylight length (photoperido profile) for
 # the number of days specified in the input temperature data
 # (from Forsythe 1995).
 p = 0.8333
-latitude <- temperature_data_frame[1, 1]
+latitude <- temperature_data_frame$LATITUDE[1]
 daylight_length_vector <- NULL
 for (i in 1:num_rows) {
 # Get the day of the year from the current row
 # of the temperature data for computation.
-doy <- temperature_data_frame[i, 4]
+doy <- temperature_data_frame$DOY[i]
 theta <- 0.2163108 + 2 * atan(0.9671396 * tan(0.00860 * (doy - 186)))
 phi <- asin(0.39795 * cos(theta))
 # Compute the length of daylight for the day of the year.
 daylight_length_vector[i] <- 24 - (24 / pi * acos((sin(p * pi / 180) + sin(latitude * pi / 180) * sin(phi)) / (cos(latitude * pi / 180) * cos(phi))))
 }
 # Append daylight_length_vector as a new column to temperature_data_frame.
-temperature_data_frame[, 7] <- daylight_length_vector
+temperature_data_frame[, num_columns+1] <- daylight_length_vector
-# Return the temperature_data_frame.
+return(temperature_data_frame)
-temperature_data_frame
 }
 get_temperature_at_hour = function(latitude, temperature_data_frame, row, num_days) {
 # Base development threshold for Brown Marmolated Stink Bug
 # insect phenology model.
 # TODO: Pass insect on the command line to accomodate more
 # the just the Brown Marmolated Stink Bub.
 threshold <- 14.17
-# Input temperature currently has the following columns.
-# # LATITUDE, LONGITUDE, DATE, DOY, TMIN, TMAX
 # Minimum temperature for current row.
-dnp <- temperature_data_frame[row, 5]
+dnp <- temperature_data_frame$TMIN[row]
 # Maximum temperature for current row.
-dxp <- temperature_data_frame[row, 6]
+dxp <- temperature_data_frame$TMAX[row]
 # Mean temperature for current row.
 dmean <- 0.5 * (dnp + dxp)
 # Initialize degree day accumulation
 dd <- 0
 if (dxp < threshold) {
 # Initialize hourly temperature.
 T <- NULL
 # Initialize degree hour vector.
 dh <- NULL
 # Daylight length for current row.
-y <- temperature_data_frame[row, 7]
+y <- temperature_data_frame$DAYLEN[row]
 # Darkness length.
 z <- 24 - y
 # Lag coefficient.
 a <- 1.86
 # Darkness coefficient.
 }
 }
 }
 dd <- sum(dh) / 24
 }
-return=c(dmean, dd)
+return(c(dmean, dd))
-return
 }
 dev.egg = function(temperature) {
 dev.rate= -0.9843 * temperature + 33.438
-return = dev.rate
+return(dev.rate)
-return
 }
 dev.young = function(temperature) {
 n12 <- -0.3728 * temperature + 14.68
 n23 <- -0.6119 * temperature + 25.249
 dev.rate = mean(n12 + n23)
-return = dev.rate
+return(dev.rate)
-return
 }
 dev.old = function(temperature) {
 n34 <- -0.6119 * temperature + 17.602
 n45 <- -0.4408 * temperature + 19.036
 dev.rate = mean(n34 + n45)
-return = dev.rate
+return(dev.rate)
-return
 }
 dev.emerg = function(temperature) {
 emerg.rate <- -0.5332 * temperature + 24.147
-return = emerg.rate
+return(emerg.rate)
-return
 }
 mortality.egg = function(temperature) {
 if (temperature < 12.7) {
 mort.prob = 0.8
 mort.prob = 0.8 - temperature / 40.0
 if (mort.prob < 0) {
 mort.prob = 0.01
 }
 }
-return = mort.prob
+return(mort.prob)
-return
 }
 mortality.nymph = function(temperature) {
 if (temperature < 12.7) {
 mort.prob = 0.03
 }
 else {
 mort.prob = temperature * 0.0008 + 0.03
 }
-return = mort.prob
+return(mort.prob)
-return
 }
 mortality.adult = function(temperature) {
 if (temperature < 12.7) {
 mort.prob = 0.002
 }
 else {
 mort.prob = temperature * 0.0005 + 0.02
 }
-return = mort.prob
+return(mort.prob)
-return
 }
 temperature_data_frame <- parse_input_data(opt$input, opt$num_days)
-latitude <- temperature_data_frame[1, 1]
+# All latitude values are the same,
+# so get the value from the first row.
+latitude <- temperature_data_frame$LATITUDE[1]
 cat("Number of days: ", opt$num_days, "\n")
 # 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
+# Loop through replications.
 for (N.rep in 1:opt$replications) {
 # During each replication start with 1000 individuals.
 # TODO: user definable as well?
 n <- 1000
 # Generation, Stage, DD, T, Diapause.
 gen2.pop <- rep(0, opt$num_days)
 S0 <- S1 <- S2 <- S3 <- S4 <- S5 <- rep(0, opt$num_days)
 g0.adult <- g1.adult <- g2.adult <- rep(0, opt$num_days)
 N.newborn <- N.death <- N.adult <- rep(0, opt$num_days)
 dd.day <- rep(0, opt$num_days)
 # All the days included in the input temperature dataset.
 for (row in 1:opt$num_days) {
 # Get the integer day of the year for the current row.
-doy <- temperature_data_frame[row, 4]
+doy <- temperature_data_frame$DOY[row]
 # Photoperiod in the day.
-photoperiod <- temperature_data_frame[row, 7]
+photoperiod <- temperature_data_frame$DAYLEN[row]
 temp.profile <- get_temperature_at_hour(latitude, temperature_data_frame, row, opt$num_days)
 mean.temp <- temp.profile[1]
 dd.temp <- temp.profile[2]
 dd.day[row] <- dd.temp
 # Trash bin for death.
 death.vec <- NULL
 # Newborn.
 birth.vec <- NULL
 # All individuals.
 for (i in 1:n) {
 # Find individual record.
 vec.ind <- vec.mat[i,]
 # First of all, still alive?
 # 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.
 if (vec.ind[2] == 4 && vec.ind[1] == 0 && mean.temp > 10) {
 # Vittelogenic stage, overwintering generation.
 if (vec.ind[4] == 0) {
 # Just turned in vittelogenic stage.
 new.vec <- t(matrix(new.vec, nrow=5))
 # Group with total eggs laid in that day.
 birth.vec <- rbind(birth.vec, new.vec)
 }
 }
+# Event 2 oviposition -- for generation 1.
-# Event 2 oviposition -- for gen 1.
 if (vec.ind[2] == 4 && vec.ind[1] == 1 && mean.temp > 12.5 && doy < 222) {
 # Vittelogenic stage, 1st generation
 if (vec.ind[4] == 0) {
 # Just turned in vittelogenic stage.
 n.birth=round(runif(1, 2 + opt$min_clutch_size, 8 + opt$max_clutch_size))
 new.vec <- t(matrix(new.vec, nrow=5))
 # 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).
 if (vec.ind[2] == 0) {
 # Egg stage.
 # Add to dd.
 # 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).
 if (vec.ind[2] == 1) {
 # young nymph stage.
 # add to dd.
 vec.ind[3] <- vec.ind[3] + dd.temp
 # 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?
 if (vec.ind[2] == 2) {
 # Old nymph stage.
 # add to dd.
 vec.ind[3] <- vec.ind[3] + dd.temp
 # 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).
 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.
 # Find how many died.
 n.death <- length(death.vec)
 if (n.death > 0) {
 vec.mat <- vec.mat[-death.vec, ]
 }
 }
 # Data analysis and visualization can currently
 # plot only within a single calendar year.
 # TODO: enhance this to accomodate multiple calendar years.
-start_date <- temperature_data_frame[1, 3]
+start_date <- temperature_data_frame$DATE[1]
-end_date <- temperature_data_frame[opt$num_days, 3]
+end_date <- temperature_data_frame$DATE[opt$num_days]
 n.yr <- 1
 day.all <- c(1:opt$num_days * n.yr)
 # mean value for adults

Mercurial > repos > greg > insect_phenology_model

comparison insect_phenology_model.R @ 85:8f5c05be4efe draft