我有一个数据框,代表一条河流的两年每日温度时间序列。对于这条河,我想知道一年中的哪一天(doy):
当我尝试计算 2 时,我遇到了错误,因为代码有多个TRUE答案可供选择。我想知道TRUE如果有多个TRUE答案,如何使代码与第一个答案一致。
示例数据集
library(ggplot2)
library(lubridate)
library(dplyr)
library(dataRetrieval)
siteNumber <- "01417500"
parameterCd <- "00010" # water temperature
statCd <- "00003" # mean
startDate <- "2015-01-01"
endDate <- "2016-12-31"
dat <- readNWISdv(siteNumber, parameterCd, startDate, endDate, statCd=statCd)
dat <- dat[,c(2:4)]
colnames(dat)[3] <- "temperature"
# Visually inspect the time series
ggplot(data = dat, aes(x = Date, y = temperature)) +
geom_point() +
theme_bw()
Run Code Online (Sandbox Code Playgroud)
1 和 2 的代码,其中 2 有问题,因为有多个TRUE语句可供选择
dat %>%
mutate(year = year(Date),
doy = yday(Date)) %>%
group_by(year) %>%
mutate(gt_10 = temperature >= 10, # greater than or equal to 10 degrees
lt_10 = temperature <= 10, # less than or equal to 10 degrees
peak_doy = doy[which.max(temperature)], # what doy is max temperature
below_peak = doy < peak_doy, # is the observed doy less than the peak temperature doy
after_peak = doy > peak_doy, # is the observed doy greater than the peak temperature doy
test_above = ave(gt_10, cumsum(!gt_10), FUN = cumsum), # counts number of days above 10 degree threshold
test_below = ave(lt_10, cumsum(!lt_10), FUN = cumsum)) %>% # counts number of days below 10 degree threshold
summarise(first_above_10_sustained = doy[below_peak == T & test_above == 14]-13, # answer to 1
first_below_10_sustained = doy[after_peak == T & test_below == 14]-13) # answer to 2
Run Code Online (Sandbox Code Playgroud)
after_peak == T的时间(即)以及温度连续 14 天低于 10 阈值的时间(即test_below == 14)。这test_below == 14就是错误所在,因为这种情况发生了多次。是的,您可以将连续天数的阈值更改为大于 14 的某个值,但这不是重点。TRUE如果有多个答案,如何让代码接受第一个TRUE答案?我在这里有一个类似的问题,但我的答案仅在没有多个TRUE答案可供选择时才有效。
我在这里会使用一些技巧:
rleid此列的 ,它将对高于或低于 10 度阈值的所有连续天进行分组。rleid将是当年温度持续 > 10 度的日期df <- dat %>%
mutate(year = year(Date)) %>%
group_by(year) %>%
mutate(max_temp = max(temperature)) %>%
ungroup() %>%
mutate(above_ten = temperature >= 10,
run = factor(data.table::rleid(above_ten))) %>%
group_by(run) %>%
mutate(sustained_hi = max(temperature) == max(max_temp)) %>%
ungroup() %>%
mutate(year = year(Date - months(6))) %>%
group_by(year) %>%
mutate(min_temp = min(temperature)) %>%
group_by(run) %>%
mutate(sustained_lo = min(temperature) == min(min_temp)) %>%
mutate(group = ifelse(sustained_hi, 'High',
ifelse(sustained_lo, 'Low',
'Unsustained'))) %>%
select(site_no, Date, temperature, group, run)
Run Code Online (Sandbox Code Playgroud)
这导致:
df
#> # A tibble: 731 x 5
#> # Groups: run [27]
#> site_no Date temperature group run
#> <chr> <date> <dbl> <chr> <fct>
#> 1 01417500 2015-01-01 0.7 Low 1
#> 2 01417500 2015-01-02 1.1 Low 1
#> 3 01417500 2015-01-03 1 Low 1
#> 4 01417500 2015-01-04 2.5 Low 1
#> 5 01417500 2015-01-05 2 Low 1
#> 6 01417500 2015-01-06 0.3 Low 1
#> 7 01417500 2015-01-07 0.2 Low 1
#> 8 01417500 2015-01-08 0.2 Low 1
#> 9 01417500 2015-01-09 0.3 Low 1
#> 10 01417500 2015-01-10 0.3 Low 1
#> # ... with 721 more rows
#> # i Use `print(n = ...)` to see more rows
Run Code Online (Sandbox Code Playgroud)
我们可以通过这样的绘图看到结果:
ggplot(df, aes(x = Date, y = temperature, color = group)) +
geom_point() +
scale_color_manual(limits = c('High', 'Unsustained', 'Low'),
values = c('orange', 'gray', 'steelblue')) +
theme_bw()
Run Code Online (Sandbox Code Playgroud)
我们可以通过执行以下操作获得持续高温/低温的开始和结束日期的一个不错的小数据框:
df %>%
filter(group != 'Unsustained') %>%
group_by(run) %>%
summarize(Date = c(first(Date), last(Date)),
Event = paste('Sustained', first(group), c('Start', 'End'))) %>%
ungroup() %>%
select(-run)
#> # A tibble: 10 x 2
#> Date Event
#> <date> <chr>
#> 1 2015-01-01 Sustained Low Start
#> 2 2015-04-28 Sustained Low End
#> 3 2015-04-29 Sustained High Start
#> 4 2015-07-16 Sustained High End
#> 5 2015-11-08 Sustained Low Start
#> 6 2016-03-31 Sustained Low End
#> 7 2016-05-18 Sustained High Start
#> 8 2016-10-09 Sustained High End
#> 9 2016-10-23 Sustained Low Start
#> 10 2016-12-31 Sustained Low End
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
64 次 |
| 最近记录: |