computing onset date of snowmelt in R [closed]

Question

I have daily temperature in this format starting from 1950 to 2017 Data

I need to compute snowmelt onset date which is defined as as the the first day when daily temperature is above 0 C, following the last five-day period between March and May, when the daily temperature is below 0 C. My codes so far:

  df1<-read.csv("temp.csv")
  require(dplyr)
  # applying the condition to check each temperature value
  df1$boolean<- ifelse(df1$temp<0.0 , 1, 0)

  #computing the total sum < 0 and the start and end date
  snow<-df1 %>%
  mutate(boolean = ifelse(is.na(boolean), 0, boolean)) %>%
  group_by(group = cumsum(c(0, diff(boolean) != 0))) %>%
   filter(boolean == 1 & n() > 1) %>%
   summarize("Start Date"=min(as.character(date)),
        "End Date"=max(as.character(date)),
        "Length of Run"=n()) %>%
   ungroup() %>%
  select(-matches("group"))
colnames(snow)[3] <- 'length'

# subset length that greater >5
obs<-subset(snow,length >=5)

The codes above give me partial solution ( if further manually edit I will get ideal solution to match my definition) I am only interested in one onset date for each year. I need some further guidance on how I can edit this code to compute onset date based on definition above.

I have number of locations so manually editing this would not be ideal solution. Your help would be appreciated

Answer 1

We have assumed in (1) that the melt day must occur in Mar, Apr or May and in (2) that only the 5 subzero days occur in Mar, Apr, May but the melt day could occur in June, say.

1) Define df2 which is df1 plus additional columns: month, year and code where code is 0 if the date is not in Mar, Apr, May and is otherwise 1 if temp < 0 and 2 if temp >= 0.

Now using df2 run rollapplyr on code returning TRUE if the most recent 6 dates have codes 1, 1, 1, 1, 1, 2 and otherwise FALSE. Take the TRUE rows and only keep the last in each year. Right join that to a data frame of all years in order to generate NAs in the output for any missing years.

library(zoo)

df2 <- df1 %>%
    mutate(Date = as.Date(Date), month = as.numeric(format(Date, "%m")), 
           year = as.numeric(format(Date, "%Y")),
           code = (month %in% 3:5) * ((temp < 0) + 2 * (temp >= 0)),
           OK = rollapplyr(code, 6, identical, c(1, 1, 1, 1, 1, 2), fill = FALSE))

df2 %>%
       filter(OK) %>%
       filter(!duplicated(year, fromLast = TRUE)) %>%
       right_join(unique(df2["year"]), by = "year") %>%
       select(year, Date)

giving:

   year       Date
1  1950 1950-05-24
2  1951 1951-05-21
3  1952 1952-05-28
4  1953 1953-05-15
5  1954 1954-05-28
6  1955 1955-05-14
7  1956 1956-05-27
8  1957 1957-05-17
9  1958 1958-05-21
10 1959       <NA>
11 1960 1960-05-26
12 1961 1961-05-16
13 1962 1962-05-19
14 1963 1963-05-13
15 1964 1964-05-27
16 1965 1965-05-20
17 1966 1966-05-26
18 1967 1967-05-26
19 1968 1968-05-27
20 1969 1969-05-30
21 1970 1970-05-21

2) In (1) we assumed that the melt onset day must be in Mar, Apr or May but here we assume that only the subzero days lie in that range and the melt onset day may extend further out.

Calculations are the same as in (1) except that the codes are now such that 1 indicates a subzero temperature in Mar, Apr or May, 2 indicates any temp above zero any time (not just in Mar, Apr and May) and 0 is anything else. We collapse the codes into a character string (one character per date) and use a regular expression on it to look for a substring of 5 ones followed by anything until we get to the next 2. We process the rest as in (1) except now we don't need the join since there will always be a melt onset day. Without the join we can represent this now as a single pipeline.

df1 %>%
    mutate(Date = as.Date(Date), month = as.numeric(format(Date, "%m")), 
           year = as.numeric(format(Date, "%Y")),
           code = (month %in% 3:5) * (temp < 0) + 2 * (temp >= 0),
           OK = { g <- gregexpr("1{5}.*?2", paste(code, collapse = ""))[[1]]
                  seq_along(code) %in% (g + attr(g, "match.length") - 1) }) %>%
    filter(OK) %>%
    filter(!duplicated(year, fromLast = TRUE)) %>%
    select(year, Date)

giving:

   year       Date
1  1950 1950-05-24
2  1951 1951-06-01
3  1952 1952-05-28
4  1953 1953-05-15
5  1954 1954-05-28
6  1955 1955-05-14
7  1956 1956-05-27
8  1957 1957-05-17
9  1958 1958-05-21
10 1959 1959-06-02
11 1960 1960-05-26
12 1961 1961-05-16
13 1962 1962-05-19
14 1963 1963-06-01
15 1964 1964-05-27
16 1965 1965-05-20
17 1966 1966-05-26
18 1967 1967-05-26
19 1968 1968-05-27
20 1969 1969-05-30
21 1970 1970-05-21