Skip to content
This repository was archived by the owner on Oct 13, 2022. It is now read-only.
This repository was archived by the owner on Oct 13, 2022. It is now read-only.

RMevents_sample does not capture preceding rain events #64

@lukeloken

Description

@lukeloken

I noticed that RMevents_sample does not correctly include rain for the period immediately preceding the start times. The bug appears if the first row of the precipitation dataframe beginRow has a calculated time difference greater than ieSec. If so, the code will not allow for rain preceding the start time to contribute to the rain totals. I updated the function and the code below should fix the issue.

I also changed the df argument so the initial data.frame is not overwritten on the first line. This makes it easier to diagnose issues.

startRainRow <- max(which(subdf$timediff>ieSec))

RMevents_sample <- function(df.orig,
                            ieHr=6,
                            rain="rain",
                            time="pdate",
                            dfsamples,
                            bdate="bpdate",
                            edate="epdate"){
  df <- df.orig
  df <- rbind(df[1,],df[df[,rain]>0,])
  timediff <- difftime(df[2:(nrow(df)),time],df[1:(nrow(df)-1),time],units="secs")
  timediff_min <- difftime(df[2:(nrow(df)),time],df[1:(nrow(df)-1),time],units="mins")
  df$timediff <- c(NA,timediff)
  df$timediff_min <- c(NA, timediff_min)
  #  dfsamples$Braindate <- dfsamples$bpdate
  #  dfsamples$Eraindate <- dfsamples$epdate
  
  ieSec <- ieHr * 3600 # compute interevent period in seconds to use with POSIX
  rainDepth <- numeric()
  startRainDates <- numeric()
  endRainDates <- numeric()
  tipsbystorm <- data.frame()
  
  rain_timezone <- lubridate::tz(df[,time])
  
  # for (i in 1:27){
    for (i in 1:nrow(dfsamples)){
      beginRow <- max(which(df[, time] < dfsamples[i, bdate])) + 1
      # this fails if you have an event that preceeds the rain record
    if(i ==1 & is.infinite(beginRow)) {
      startRainDates <- NA
      endRainDates <- NA
      rainDepth <- NA
      event <- 0
      next
    }
    
    if (i > 1 & is.infinite(beginRow)) {
      startRainDates <- c(startRainDates, NA)
      endRainDates <- c(endRainDates, NA)
      rainDepth <- c(rainDepth, NA)
      next
    }
    
    endRow <- max(which(df[,time]<dfsamples[i,edate]))
    subdf <- df[c(1:(beginRow-1)),]
    
    if (length(which(subdf$timediff>ieSec)) > 0) {
    startRainRow <- max(which(subdf$timediff>ieSec))
    } else {startRainRow = 1}
    
    # if end of last precedding storm is beyond ieSec use sample start time
    # Otherwise use the start of the last preceeding storm
    if (difftime(dfsamples[i,bdate], max(subdf[,time]), units = "secs") > ieSec) {
      BD <- df[beginRow,time]
    } else {
      BD <- subdf[startRainRow,time]
    }
    subdf2 <- df[c(startRainRow:endRow),]
    
    if(sum(subdf2[,rain] > 0) > 0) {
      ED <- subdf2[max(which(subdf2[,rain] > 0)), time]
      
      if(ED < BD) ED <- BD + 60
      
    } else {
      ED <- BD + 60
    }
    eventRows <- which(df.orig[,time] >= BD & df.orig[, time] <= ED)
    eventRows_tips <- which(df[,time] >= BD & df[, time] <= ED)
    
    eventRain <- ifelse(length(eventRows) > 0, sum(df.orig[eventRows, rain]), 0)
    rainDepth <- c(rainDepth, eventRain)
    
    # get data frame of all rain from this event, add event id column
    sub_tips <- df[eventRows_tips, ]
    
    startRainDates[i] <- BD
    endRainDates[i] <- ED
    
    if(i == 1) {

      if (nrow(sub_tips) > 0) {
        event <- 1
      } else {
        event <- 0
      }
      if (nrow(sub_tips) > 0){
        sub_tips$event <- event
      }
      tipsbystorm <- sub_tips
    } else {

      
      if (nrow(sub_tips) > 0) {
        event <- event + 1
      } else {
        event <- event
      }
      if (nrow(sub_tips) > 0){
        sub_tips$event <- event
      }
      
      tipsbystorm <- rbind(tipsbystorm, sub_tips)
    }
  }
  
  dfsamples$StartDate <- as.POSIXct(startRainDates, origin = '1970-01-01', tz = rain_timezone)
  dfsamples$EndDate <- as.POSIXct(endRainDates, origin = '1970-01-01', tz = rain_timezone)
  dfsamples$rain <- rainDepth
  dfsamples$stormnum <- 1:nrow(dfsamples)
  
  dfsamples <- dfsamples[,c('stormnum', 'StartDate', 'EndDate', 'rain')]
  timeInterval <- min(timediff_min, na.rm = T)
  tipsbystorm <- tipsbystorm[,c(rain, time, 'timediff_min', 'event')]
  names(tipsbystorm)[3] <- 'dif_time'
  
  out <- list(dfsamples, dfsamples, tipsbystorm, timeInterval)
  names(out) <- c('storms2', 'storms', 'tipsbystorm', 'timeInterval')
  
  return(out)
}

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions