Catalogo aree dimostrative

Stands %>%
  select(id_ads, sup_m_quadri, anno_0, 
         ComplessoForestale, UdS, Particella, NOTE_SELVICOLTURA) %>%
  arrange(id_ads) %>%
  kable(row.names = T,
        caption = "Catalogo aree: dati identificativi")
Catalogo aree: dati identificativi
id_ads sup_m_quadri anno_0 ComplessoForestale UdS Particella NOTE_SELVICOLTURA
1 A-A 3300 1964 Acquerino-Luogomano A_090 90 NA
2 C-A 5000 1962 Alpe di Catenaia C008_01 C8 sfollo leggero (1986), diradamenti (1995-2010)
3 C-B 4000 1961 Alpe di Catenaia C012_02 C12 sfollo medio (1986), diradamenti (1995, 2004, 2011)
4 C-C 5000 1969 Alpe di Catenaia C059_01 C59 sfollo leggero, diradamenti (1995, 2008, 2016)
5 G-A 20852 1974 NA #N/A 25-1 NA
6 M-A 5200 1962 Giogo Casaglia B 025_001 25 NA
7 M-B 2400 1977 Giogo Casaglia B 072_008 72 NA
8 M-C 5000 1972 Giogo Casaglia A 039_003 39 NA
9 P-A 4800 1965 Podernovo 32a 32 NA
10 P-B 5000 1965 Podernovo 32a 32 diradamento geometrico 1 fila su tre circa (1984), diradamento selettivo nel 1994 circa 40% piante vive, diradamento selettivo (30%) nel 2003 e nel 2010 (30%).
11 P-C 4800 1965 Podernovo 32a 32 NA
12 P-D 4800 1965 Podernovo 32a 32 NA
13 P-E 5000 1965 Podernovo 32a 32 diradamento geometrico 1 fila su tre circa (1984), diradamento selettivo nel 1994 circa 40% piante vive, diradamento selettivo (30%) nel 2003 e nel 2010 (30%).
14 P-F 4800 1965 Podernovo 32a 32 NA
15 P-G 1000 1965 Podernovo #N/A 33 Autodiradamento
16 P-H 1000 1965 Podernovo #N/A 33 Diradamento selettivo
17 P-I 1000 1965 Podernovo #N/A 33 Diradamento geometrico-selettivo
18 P-tA 750 1964 Podernovo 35a 35 NA
19 P-tB 625 1955 Podernovo 35d 35 NA
20 P-tC 625 1955 Podernovo 35d 35 NA
21 T-A 5000 1942 Foreste Pistoiesi 245 245 NA
22 T-B 5000 1944 Foreste Pistoiesi A 449_002 449 NA
23 T-C 5000 1934 Foreste Pistoiesi A 349_001 349 NA
24 V-A 5000 1939 Foresta di Vallombrosa (Part323) 323 Parcella sperimentale, rimozione di eventuali piante a rischio caduta sulla strada
25 V-B 2500 1969 Foresta di Vallombrosa (Part382) 382 diradamento di tipo basso moderato, che localmente tendera’ a favorire i soggetti di faggio presenti
26 V-C 2500 1939 Foresta di Vallombrosa (Part383) 383 Parcella sperimentale, rimozione di eventuali piante a rischio caduta sulla strada

Stima di Atlezza Dominante e Site Index

Altezza Dominante (al 2017, per le specie con più di 100 f./ha) e Site Index (per la douglasia)
id_ads age sp n_dom d_dom h_dom cv.h_dom SI_MN94_50
A-A 53 abe 100.0 36.6 30.0 1.4 NA
A-A 53 dou 100.0 56.0 41.9 2.2 40.1
A-A 53 fag 6.1 NA NA NA NA
A-A 53 pin 3.0 NA NA NA NA
C-A 55 abe 44.0 NA NA NA NA
C-A 55 dou 56.0 NA NA NA NA
C-A 55 pin 100.0 42.7 31.3 1.2 NA
C-B 56 abe 20.0 NA NA NA NA
C-B 56 cas 32.5 NA NA NA NA
C-B 56 dou 100.0 61.1 42.0 1.1 38.7
C-C 48 cas 24.0 NA NA NA NA
C-C 48 cer 2.0 NA NA NA NA
C-C 48 dou 100.0 52.4 37.8 1.9 39.0
C-C 48 ont 14.0 NA NA NA NA
M-A 55 cas 76.9 NA NA NA NA
M-A 55 cer 7.7 NA NA NA NA
M-A 55 dou 100.0 55.5 39.5 3.0 36.9
M-B 40 abe 45.8 NA NA NA NA
M-B 40 dou 100.0 47.6 33.1 2.3 39.0
M-C 45 dou 100.0 48.6 30.7 2.1 33.3
M-C 45 fag 4.0 NA NA NA NA
P-A 52 dou 100.0 53.7 40.3 1.1 39.2
P-B 52 dou 100.0 56.3 41.3 1.1 40.2
P-C 52 dou 100.0 55.8 41.2 1.1 40.0
P-D 52 dou 100.0 56.6 41.4 1.1 40.3
P-E 52 dou 100.0 54.3 40.6 1.1 39.5
P-F 52 dou 100.0 51.9 39.6 1.0 38.4
T-A 75 abe 2.0 NA NA NA NA
T-A 75 dou 100.0 73.9 47.0 1.1 35.1
T-B 73 abe 6.0 NA NA NA NA
T-B 73 ace 20.0 NA NA NA NA
T-B 73 cer 24.0 NA NA NA NA
T-B 73 dou 100.0 78.4 46.7 3.0 35.5
T-B 73 fag 66.0 NA NA NA NA
T-C 83 ace 4.0 NA NA NA NA
T-C 83 dou 100.0 69.8 42.3 2.0 29.1
V-A 78 abe 26.0 NA NA NA NA
V-A 78 dou 100.0 73.1 53.1 1.3 38.8
V-A 78 tig 2.0 NA NA NA NA
V-B 48 dou 100.0 66.5 45.0 2.5 46.3
V-B 48 fag 100.0 22.1 26.9 3.1 NA
V-C 78 dou 100.0 74.9 56.0 2.5 41.0

Parametri dendrometrici di base a confronto tra douglasia e ‘altre specie’

dfx <- dbh_tally %>%
  mutate(species_g = ifelse(sp == 'dou', sp, 'oth')) %>%
  group_by(id_ads, species_g) %>%
  summarise( N = sum(freq),    G = sum(freq * d_130^2),
             N_ha = sum(n_ha), G_ha = sum(n_ha * d_130^2)) %>%
  mutate(dg =sqrt(G/N), 
         G = G * pi /40000,
         G_ha = G_ha * pi /40000) %>%
  select(id_ads, species_g, N, G, dg, N_ha, G_ha) %>%
  arrange(id_ads, species_g)

dfx %>%
  kable(digits = 1,
        caption = "Parametri dendrometrici: douglasia ('dou'), 
        altre specie ('oth')")
Parametri dendrometrici: douglasia (‘dou’), altre specie (‘oth’)
id_ads species_g N G dg N_ha G_ha
A-A dou 75 13.3 47.6 227.3 40.4
A-A oth 37 3.7 35.8 112.1 11.3
C-A dou 28 5.6 50.7 56.0 11.3
C-A oth 98 11.2 38.2 196.0 22.4
C-B dou 80 19.1 55.1 200.0 47.7
C-B oth 21 2.1 35.7 52.5 5.3
C-C dou 115 18.7 45.5 230.0 37.4
C-C oth 20 1.6 32.0 40.0 3.2
M-A dou 135 24.3 47.9 259.6 46.8
M-A oth 44 1.6 21.7 84.6 3.1
M-B dou 169 17.2 36.0 704.2 71.8
M-B oth 11 0.9 32.7 45.8 3.9
M-C dou 291 29.6 36.0 582.0 59.2
M-C oth 2 0.1 22.1 4.0 0.2
P-A dou 115 19.4 46.4 239.6 40.5
P-B dou 127 23.0 48.0 254.0 46.0
P-C dou 119 22.4 49.0 247.9 46.7
P-D dou 121 21.3 47.3 252.1 44.4
P-E dou 122 20.4 46.1 244.0 40.7
P-F dou 111 17.1 44.2 231.2 35.6
T-A dou 117 36.4 63.0 234.0 72.9
T-A oth 1 0.1 36.0 2.0 0.2
T-B dou 110 36.0 64.5 220.0 72.0
T-B oth 58 3.7 28.6 116.0 7.4
T-C dou 73 23.6 64.2 146.0 47.3
T-C oth 2 0.3 40.0 4.0 0.5
V-A dou 151 39.8 57.9 302.0 79.6
V-A oth 14 1.5 36.6 28.0 3.0
V-B dou 56 12.4 53.0 224.0 49.5
V-B oth 75 1.7 16.9 300.0 6.7
V-C dou 62 17.9 60.7 248.0 71.7

Sintesi douglasia

Altezze

hm_log <- heights %>%
  lm(data = ., height ~ log(d_130) * id_ipso)

assortments <- dbh_tally %>%
  filter(sp == "dou") %>%
  left_join(select(TallyLogs, id_ads, id_ipso)) %>%
  mutate(f_height = predict(hm_log, .))
## Joining, by = "id_ads"
assortments %>%  
  distinct(id_ads, sp, d_130, f_height) %>%
  arrange_all() %>%
  ggplot() +
  geom_line(aes(d_130, f_height, colour = id_ads))

# LOG lines are ok

acld <- 1
aclh <- 1
assortments <- assortments %>%
  mutate(dbh = plyr::round_any(d_130, acld),
         ht_r = plyr::round_any(f_height, aclh))

Vtab <- assortments %>%
  distinct(dbh, ht_r) %>%
  arrange_all()
  
load("Functions/AssortmentsVolumeTable.Rdata")
Vtab <- distinct(Vtab)  ## added just to be sure!
# source("Functions/S_getORcomputeVtab.R")

options(knitr.kable.NA = '') 

assortments %>%
  mutate(ht_r = as.numeric(ht_r)) %>%
  left_join(Vtab) %>%
  group_by(id_ads, id_ipso, sp) %>%
  summarise(N_ha.check = sum(n_ha), 
            Vtot_ha = sum(n_ha * v_tot),
            Vcrm_ha = sum(n_ha * v_corm),
            Vseg_ha = sum(n_ha * v_ass),
            Vseg_p  = 100 * Vseg_ha / Vtot_ha
            ) %>%
  full_join(dfx2, .) %>%
  select(-sp, -N_ha.check) %>%
  mutate(hg = predict(hm_log, newdata=data.frame(d_130=dg, id_ipso=id_ipso))) %>% 
  select(id_ads, SI_MN94_50, age, Gdou_p, dg, hg, d_dom, h_dom, 
         Vtot_ha, Vcrm_ha, Vseg_ha, Vseg_p) %>%
  rename('Vseg%' = Vseg_p) %>%
  kable(digits = 1, format = "html", 
        caption = "Cubatura aree dimostrative - volumi: 'tot' dendrometrico,  'crm' comometrico (svettato a 8 cm),    'seg' toppi da sega (diam. min. 25 cm)") %>%
  kable_styling(position = "c", bootstrap_options = c("striped", "condensed")) 
## Joining, by = c("dbh", "ht_r")
## Joining, by = "id_ads"
Cubatura aree dimostrative - volumi: ‘tot’ dendrometrico, ‘crm’ comometrico (svettato a 8 cm), ‘seg’ toppi da sega (diam. min. 25 cm)
id_ads SI_MN94_50 age Gdou_p dg hg d_dom h_dom Vtot_ha Vcrm_ha Vseg_ha Vseg%
M-B 39.0 40 94.9% 36.0 31.4 47.6 33.1 975.7 968.7 711.4 72.9
M-C 33.3 45 99.7% 36.0 27.3 48.6 30.7 730.2 725.5 535.2 73.3
C-C 39.0 48 92.1% 45.5 35.5 52.4 37.8 588.4 586.6 522.5 88.8
V-B 46.3 48 88% 53.0 39.5 66.5 45.0 891.2 889.3 827.2 92.8
P-A 39.2 52 100% 46.4 38.2 53.7 40.3 680.8 678.7 607.8 89.3
P-B 40.2 52 100% 48.0 38.7 56.3 41.3 786.9 784.7 712.1 90.5
P-C 40.0 52 100% 49.0 39.0 55.8 41.2 801.8 799.8 732.7 91.4
P-D 40.3 52 100% 47.3 38.5 56.6 41.4 758.5 756.3 680.7 89.7
P-E 39.5 52 100% 46.1 38.0 54.3 40.6 684.0 681.9 607.0 88.8
P-F 38.4 52 100% 44.2 37.4 51.9 39.6 584.8 582.7 507.9 86.8
A-A 40.1 53 78.2% 47.6 38.8 56.0 41.9 699.8 697.9 630.4 90.1
C-A 55 33.5% 50.7 35.2 182.6 182.2 168.8 92.5
M-A 36.9 55 93.8% 47.9 36.0 55.5 39.5 751.0 749.0 680.4 90.6
C-B 38.7 56 90.1% 55.1 40.9 61.1 42.0 865.2 863.6 817.2 94.5
T-B 35.5 73 90.6% 64.5 43.0 78.4 46.7 1423.7 1422.1 1373.2 96.4
T-A 35.1 75 99.7% 63.0 45.0 73.9 47.0 1463.7 1461.9 1408.5 96.2
V-A 38.8 78 96.4% 57.9 49.2 73.1 53.1 1713.7 1710.9 1620.1 94.5
V-C 41.0 78 100% 60.7 50.8 74.9 56.0 1598.0 1595.8 1523.8 95.4
T-C 29.1 83 98.9% 64.2 40.0 69.8 42.3 866.4 865.3 838.3 96.8 
xg <- dbh_tally %>%
  group_by(id_loc) %>%
  do(g = ggplot() +
        geom_col(aes(d_130, n_ha, color = sp)) +
        facet_grid(id_ads~.)
  ) %>%
  print(str(g[1][[1]]))
## Source: local data frame [6 x 2]
## Groups: <by row>
## 
## # A tibble: 6 x 2
##   id_loc        g
## *  <chr>   <list>
## 1      A <S3: gg>
## 2      C <S3: gg>
## 3      M <S3: gg>
## 4      P <S3: gg>
## 5      T <S3: gg>
## 6      V <S3: gg>
# non fa

for(l in unique(dbh_tally$id_loc)){
  g <- dbh_tally %>%
    filter(id_loc == l) %>%
    ggplot() +
        geom_col(aes(d_130, n_ha, color = sp)) +
        facet_grid(id_ads~.)
  print(g)
}

# fa ma non è granchè

c <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", 
       "#80b1d3", "#fdb462", "#b3de69", "#fccde5", "#d9d9d9")
c <- c("coral", "darkgoldenrod1", "#bebada", "firebrick3", 
       "#80b1d3", "sienna3", "limegreen", "lawngreen", "seagreen")
sp_l <- sort(unique(dbh_tally$sp))[rev(c(5, 1, 8, 6, 3, 4, 7, 9, 2))]
p <- NULL; for(i in 1:9) p <- 
  c(p, paste0("'",sp_l[i],"' = '",c[i],"',"))
p <- paste(p, collapse = "")
p <- paste0("c(", substr(p, 1, str_length(p)-1), ")", collapse = "")
p <- paste0("c(", p, ")", collapse = "")
cols <- eval(parse(text=p))

acld <- 5
xg <- dbh_tally %>%
  mutate(dbh = plyr::round_any(d_130, acld),
         sp = factor(sp, levels = sp_l, ordered = T)) %>%
  group_by(id_ads, sp, dbh) %>%
  summarise(n_ha = sum(n_ha)) %>%
  left_join(select(Stands, id_ads, AdS_etichetta)) %>%
  mutate(lbl =paste(id_ads,trimws(AdS_etichetta), sep=" : "))
## Joining, by = "id_ads"
for(l in unique(xg$id_ads)){
  g<- xg %>%
    filter(id_ads == l) %>%
    ggplot() +
        geom_col(position = "stack", aes(dbh, n_ha, fill = sp)) +
        scale_fill_manual(values = cols) +
        labs(x = "d_130 [cm]", y = "freqenze / ha") +
        facet_grid(~lbl)
  print(g)
}