-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathrol_chill.R
183 lines (159 loc) · 5.72 KB
/
rol_chill.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
# Code creates variables:
# wash_chill_hours
# kyoto_chill_hours
# lies_chill_hours
# vanc_chill_hours
library(tidyverse)
library(rnoaa)
source("hours_below.R")
# function takes df and calculates total chill hours for each year
get_total <- function(df) {
x <- df
x$total_hours <- NA
for (i in 2:nrow(x)) {
if (x$month[i] == 1) {
current_year <- x$year[i]
prev_year <- x$year[i - 1]
dec_index <- which(x$month == 12 & x$year == prev_year)
if (length(dec_index) > 0) {
x$total_hours[i] <- x$cum_hours_below[i] + x$cum_hours_below[dec_index]
}
}
}
return(x)
}
# Washington DC ####
chill.wash <- ghcnd_search(stationid = "USW00013743",
#refresh = TRUE,
var = c("tmax", "tmin"))
chill.wash.join <-
left_join(chill.wash$tmax, chill.wash$tmin, by = c("id", "date")) %>%
filter(!is.na(tmax) & !is.na(tmin)) %>%
mutate(month = lubridate::month(date)) %>%
mutate(year = parse_number(format(date, "%Y"))) %>%
group_by(year, month) %>%
nest() %>%
mutate(row_num = map(data, nrow)) %>%
unnest(row_num) %>%
filter(row_num == 31, month == 12 | month == 1) %>%
mutate(chill_sum = map(data, hours_below)) %>%
unnest(chill_sum)
#nrow(chill.wash.join)
wash_chill_hours <- get_total(chill.wash.join) %>%
ungroup() %>%
filter(month == 1) %>%
select(year, data, chill_hours = total_hours)
# Kyoto ####
chill.kyoto <- ghcnd_search(stationid = "JA000047759",
#refresh = TRUE,
var = c("tmax", "tmin"))
chill.kyoto.join <-
left_join(chill.kyoto$tmax, chill.kyoto$tmin, by = c("id", "date")) %>%
filter(!is.na(tmax) & !is.na(tmin)) %>%
mutate(month = lubridate::month(date)) %>%
mutate(year = parse_number(format(date, "%Y"))) %>%
group_by(year, month) %>%
nest() %>%
mutate(row_num = map(data, nrow)) %>%
unnest(row_num) %>%
filter(row_num == 31, month == 12 | month == 1) %>%
mutate(chill_sum = map(data, hours_below)) %>%
unnest(chill_sum)
#nrow(chill.wash.join)
kyoto_chill_hours <- get_total(chill.kyoto.join) %>%
ungroup() %>%
filter(month == 1) %>%
select(year, data, chill_hours = total_hours)
# Liestal-Weideli (Switzerland) ####
chill.lies <- ghcnd_search(stationid = "SZ000001940",
#refresh = TRUE,
var = c("tmax", "tmin"))
chill.lies.join <-
left_join(chill.lies$tmax, chill.lies$tmin, by = c("id", "date")) %>%
filter(!is.na(tmax) & !is.na(tmin)) %>%
mutate(month = lubridate::month(date)) %>%
mutate(year = parse_number(format(date, "%Y"))) %>%
group_by(year, month) %>%
nest() %>%
mutate(row_num = map(data, nrow)) %>%
unnest(row_num) %>%
filter(row_num == 31, month == 12 | month == 1) %>%
mutate(chill_sum = map(data, hours_below)) %>%
unnest(chill_sum)
#nrow(chill.wash.join)
lies_chill_hours <- get_total(chill.lies.join) %>%
ungroup() %>%
filter(month == 1) %>%
select(year, data, chill_hours = total_hours)
# Vancouver ####
chill.vanc <- ghcnd_search(stationid = "CA001108447",
#refresh = TRUE,
var = c("tmax", "tmin"))
chill.vanc.join <-
left_join(chill.vanc$tmax, chill.vanc$tmin, by = c("id", "date")) %>%
filter(!is.na(tmax) & !is.na(tmin)) %>%
mutate(month = lubridate::month(date)) %>%
mutate(year = parse_number(format(date, "%Y"))) %>%
group_by(year, month) %>%
nest() %>%
mutate(row_num = map(data, nrow)) %>%
unnest(row_num) %>%
filter(row_num == 31, month == 12 | month == 1) %>%
mutate(chill_sum = map(data, hours_below)) %>%
unnest(chill_sum)
#nrow(chill.wash.join)
vanc_chill_hours <- get_total(chill.vanc.join) %>%
ungroup() %>%
filter(month == 1) %>%
select(year, data, chill_hours = total_hours)
### Join all
chills <-
tibble(location = "washingtondc", wash_chill_hours ) |>
bind_rows(tibble(location = "liestal", lies_chill_hours )) |>
bind_rows(tibble(location = "kyoto", kyoto_chill_hours )) |>
bind_rows(tibble(location = "vancouver", vanc_chill_hours) )
# junk ####
x <- chill.lies.join
x$total_hours <- c(0, diff(x$year))
x$total_hours[x$month == 1] <-
ifelse(x$total_hours[x$month == 1] == 1,
x$cum_hours_below[x$total_hours == 1 & x$month == 1] +
x$cum_hours_below[],
x$cum_hours_below[x$month == 1])
x$total_hours[x$month == 12] <- NA
x<- chill.lies.join[2:length(row.names(chill.lies.join)), ]
x$total_hours <- rep(x$cum_hours_below[c(TRUE, FALSE)] + x$cum_hours_below[c(FALSE, TRUE)], each = 2)
x$total_hours
x <- chill.lies.join
x <- x %>% mutate(adj_year = ifelse(month == 12, year + 1, year))
x$total_hours <- c(0, diff(x$year))
x.wide <- x %>% pivot_wider(names_from = month, values_from = cum_hours_below)
# x <- chill.lies.join
# x$total_hours[x$month == 1] <-
# ifelse(x$total_hours[x$month == 1] == 1,
# x$cum_hours_below[x$total_hours == 1 & x$month == 1] +
# ,
# x$cum_hours_below[x$month == 1])
# x$total_hours[x$month == 12] <- NA
x <- chill.lies.join
x$total_hours <- NA
for (i in 2:nrow(x)) {
if (x$month[i] == 1) {
current_year <- x$year[i]
prev_year <- x$year[i - 1]
dec_index <- which(x$month == 12 & x$year == prev_year)
if (length(dec_index) > 0) {
x$total_hours[i] <- x$cum_hours_below[i] + x$cum_hours_below[dec_index]
}
}
}
# x <- df
# x$total_hours <- c(0, diff(x$year))
# x$total_hours[x$month == 1] <-
# ifelse(x$total_hours[x$month == 1] == 1,
# x$cum_hours_below[x$total_hours == 1] +
# x$cum_hours_below[x$month == 12 & x$year[x$month == 12] %in%
# (x$year[x$month == 1 & x$total_hours == 1] - 1)],
# x$cum_hours_below[x$month == 1])
# x$total_hours[x$month == 12] <- NA
# return(x)