r语言 - 根据值'moving window'范围和比例对表进行分类？

Question

我有一个森林林分的数据集，每个数据集包含几个不同年龄和体积的树层。结合体积和年龄数据，我想将林分分类为even-或uneven-aged。如果超过80%的体积被分配给相隔20年的年龄层，则认为森林是even-aged。我想知道如何实现"相隔20年"的条件？ 我可以很容易地计算出单个树层(strat)的体积和份额。但是如何检查"他们分开了多少年"呢?是某种移动的窗户吗?

虚拟的例子:

# investigate volume by age classes?
library(dplyr)
df <- data.frame(stand = c("id1", "id1", "id1", "id1", 
'id2', 'id2', 'id2'),
strat = c(1,2,3,4,
1,2,3),
v = c(4,10,15,20,
11,15,18),
age = c(5,10,65,80,
10,15,20))
# even age  = if more of teh 80% of volume is allocated in layers in 20 years range
df %>% 
group_by(stand) %>% 
mutate(V_tot = sum(v)) %>% 
mutate(V_share = v/V_tot*100)

预期结果:

stand strat     v   age V_tot V_share quality
<fct> <dbl> <dbl> <dbl> <dbl>   <dbl>
1 id1       1     4     5    49    8.16 uneven-aged
2 id1       2    10    10    49   20.4  uneven-aged
3 id1       3    15    65    49   30.6  uneven-aged
4 id1       4    20    80    49   40.8  uneven-aged #* because age classes 65 and 80, even less then 20 years apart have only 70% of total volume
5 id2       1    11    10    44   25    even-aged
6 id2       2    15    15    44   34.1  even-aged
7 id2       3    18    20    44   40.9  even-aged

Answer 1

有趣的问题，我想我有一个解决方案使用runner包

df %>% 
group_by(stand) %>% 
mutate(
V_tot = sum(v),
V_share = v/V_tot*100,
test = sum_run(
V_share,
k = 20L,
idx = age,
na_rm = TRUE,
na_pad = FALSE
),
quality = if_else(any(test >= 80), 'even-aged', 'uneven-aged')
) %>%
select(-test)

Answer 2

另一个实现移动平均线的tidyverse解决方案:

library(tidyverse)
df <- structure(list(stand = c("id1", "id1", "id1", "id1", "id2", "id2", "id2"), strat = c(1, 2, 3, 4, 1, 2, 3), v = c(4, 10, 15, 20, 11, 15, 18), age = c(5, 10, 65, 80, 10, 15, 20), V_tot = c(49, 49, 49, 49, 44, 44, 44), V_share = c(8.16326530612245, 20.4081632653061, 30.6122448979592, 40.8163265306122, 25, 34.0909090909091, 40.9090909090909)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -7L))
df %>% 
group_by(stand) %>% 
mutate(range20 = map_dbl(age, ~ sum(V_share[which(abs(age - .x) <= 20)])),
quality = ifelse(any(range20 > 80), "even-aged", "uneven-aged"))
#> # A tibble: 7 × 8
#> # Groups:   stand [2]
#>   stand strat     v   age V_tot V_share range20 quality    
#>   <chr> <dbl> <dbl> <dbl> <dbl>   <dbl>   <dbl> <chr>      
#> 1 id1       1     4     5    49    8.16    28.6 uneven-aged
#> 2 id1       2    10    10    49   20.4     28.6 uneven-aged
#> 3 id1       3    15    65    49   30.6     71.4 uneven-aged
#> 4 id1       4    20    80    49   40.8     71.4 uneven-aged
#> 5 id2       1    11    10    44   25      100   even-aged  
#> 6 id2       2    15    15    44   34.1    100   even-aged  
#> 7 id2       3    18    20    44   40.9    100   even-aged

^{由reprex包(v2.0.1)在2021-09-08创建}