Блог

У меня есть наборы данных лесных насаждений, каждый из которых содержит несколько слоев деревьев разного возраста и объема. Я хочу классифицировать стенды как even- или uneven-aged , объединив данные об объеме и возрасте. Лес считается even-aged , если более 80% объема распределено по возрастным классам с разницей в 20 лет. Интересно, как реализовать условие «с разницей в 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
    
 

Другое 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
 

^{Создано 2021-09-08 пакетом reprex (v2.0.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)