Le informazioni sono archiviate (nello standard adottato da Giulia Rinaldini) utilizzando una cartella per località contenete un tabellone XLSX per ogni AdS
Dall’analisi dell’elenco delle cartelle si ricava la lista delle ‘zone o località’ oltre al codice identificativo, la lettera che ho aggiunto alla fine del nome delle cartelle
source_path <- "/Users/ro/GoogleDrive2/DocumentiGDuniss/02-RICERCA/laMarca/ConcGOdouglasia/OutputDiR/RecuperoRilieviAdS_Rinaldini/RACCOLTA_originali"
# Tabellone condiviso su Google drive
# https://docs.google.com/spreadsheets/d/1-2qcNq5d0aw9GW0rh6fouRF_VfgtrUYcRh4ikRDEIg8/
# _____________
localita <-
tibble(cartella = dir(source_path)) %>%
mutate(cartella = trimws(cartella),
areaGeografica_localita = substring(cartella, 1, str_length(cartella)-2),
id_loc = substring(cartella, str_length(cartella)))
if(with(localita, length(id_loc) != length(unique(id_loc)))) {
stop(
"Il primo carattere del nome della cartella viene utilizzato come 'id_loc'
e deve quindi essere univoco!")
}
localita %>%
select(id_loc, areaGeografica_localita, cartella) %>%
arrange(areaGeografica_localita) %>%
kable(row.names = T)| id_loc | areaGeografica_localita | cartella | |
|---|---|---|---|
| 1 | C | Casentino | Casentino_C |
| 2 | M | Mugello | Mugello_M |
| 3 | T | Pistoia | Pistoia_T |
| 4 | P | Podernovo | Podernovo_P |
| 5 | A | Prato | Prato_A |
| 6 | V | Vallombrosa | Vallombrosa_V |
Recupero elenco tabelloni presenti nelle cartelle/località.
file_list <- tibble()
for (d in localita$cartella) {
fl <- dir(paste0(source_path,'/', d))
file_list <- rbind(file_list,
tibble(cartella = d,
file_name = fl))
}
file_list <- arrange(file_list, cartella, file_name)Dall’analisi delle righe di intestazione dei fogli principali si recuperano i dati relativi alle ‘CampagneRilieviDendrometrici’:
1 - foglio:
# inizializzazione output
aree_di_saggio <- tibble()
for(i in 1:nrow(file_list)) {
cartella <- file_list[i, "cartella"][[1]]
file_name <- file_list[i,"file_name"][[1]]
xlsx <- paste(source_path, cartella, file_name, sep='/')
# accesso all'area delle intestazioni
intestazioni <-
read_xlsx(xlsx, sheet = 1, range = "A2:A8", col_names = F, col_types = "text")
aree_di_saggio <-
rbind(aree_di_saggio,
tibble(id_loc =
localita$id_loc[which(localita$cartella==cartella)][[1]],
file_name = file_name,
# catalogazione righe di intestazione
toponimi = intestazioni$X__1[1],
dimensioni = intestazioni$X__1[2],
rilevatori = intestazioni$X__1[3],
data_rilievo = intestazioni$X__1[4],
TOT_PIANTE = intestazioni$X__1[5],
TipoPiedilista = intestazioni$X__1[6]
)
)
}
# estrazione dati salienti
t <- unlist(aree_di_saggio[,2])
ep <- str_locate(t, "Particella")[,2]
sa <- str_locate(t, "Ads")[,1]
# identificativo della particella forestale (riferita al 'Complesso forestale', specificato in 'Cartelle')
aree_di_saggio$n_particella <- trimws(substring(t, ep+1, sa-1))
e <- str_locate(t, "Ads")[,2]
# identificativo dell'Area di Saggio (nella Località, con quelche doppione!)
aree_di_saggio$id_ads <- substring(t, e+2, e+2)
# numero di fusti (da utilizzare come verifica!)
aree_di_saggio$n_tot_fusti <- str_extract(aree_di_saggio$TOT_PIANTE, "\\d+")
aree_di_saggio %>%
kable(row.names = T)| id_loc | file_name | toponimi | dimensioni | rilevatori | data_rilievo | TOT_PIANTE | TipoPiedilista | n_particella | id_ads | n_tot_fusti | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | C | Particella C12 Ads B ORIGINALE.xlsx | Particella n°. C12 /Ads B Località Chiusi della Verna | DIMENSIONI AREA: 50x80 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 05-05-2017 | TOTALE 101 PIANTE | Ø | C12 | B | 101 |
| 2 | C | Particella C59 Ads C ORIGINALE.xlsx | Particella n°. C59 /Ads C Località Chiusi della Verna | SUPERFICIE AREA: 5000 m2 | Rilevatori: Giulia Rinaldini, Lucio Lasagni | Data: 10-05-2017 | TOTALE 135 PIANTE | Ø | C59 | C | 135 |
| 3 | C | Particella C8 Ads A ORIGINALE.xlsx | Particella n°. C8 /Ads A Località Chiusi della Verna | DIMENSIONI AREA: 50x100 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 28-04-2017 | TOTALE 126 PIANTE | Ø | C8 | A | 126 |
| 4 | M | Particella 25 Ads A ORIGINALE.xlsx | Particella n°. 25 /Ads A Località Moscheta | DIMENSIONI AREA: 90x60 (-200 m2 della strada) | Rilevatori: Giulia Rinaldini, Claudia Capponi, Andrea Pacciani, Annamaria Ronconi | Data: 23-05-2017 | TOTALE 179 PIANTE | Ø | 25 | A | 179 |
| 5 | M | Particella 39 Ads C ORIGINALE.xlsx | Particella n°. 39 /Ads C Località Monte Pratone-Acqua Buona | DIMENSIONI AREA: 50x100 | Rilevatori: Giulia Rinaldini, Stefano Balestri | Data: 13-06-2017 | TOTALE 293 PIANTE | Ø | 39 | C | 293 |
| 6 | M | Particella 72 Ads B ORIGINALE.xlsx | Particella n°. 72 /Ads B Località Le Pratelle | DIMENSIONI AREA: 40x60 | Rilevatori: Giulia Rinaldini, Stefano Balestri, Marco Grazzini | Data: 24-05-2017 | TOTALE 180 PIANTE | Ø | 72 | B | 180 |
| 7 | T | Particella 245 Ads A ORIGINALE.xlsx | Particella n°. 245 /Ads A Località Montelungo | DIMENSIONI AREA: 50x100 | Rilevatori: Giulia Rinaldini, Unione dei comuni montani di Pistoia | Data: 15-05-2017 | TOTALE 118 PIANTE | Ø | 245 | A | 118 |
| 8 | T | Particella 349 Ads C ORIGINALE.xlsx | Particella n°. 349 /Ads C Località Falsereni | DIMENSIONI AREA: 50x100 | Rilevatori: Giulia Rinaldini, Andrea Pacciani, Unione comuni | Data: 06-06-2017 | TOTALE 75 PIANTE | Ø | 349 | C | 75 |
| 9 | T | Particella 449 Ads B ORIGINALE.xlsx | Particella n°. 449 /Ads B Località Ponte Rigoli | DIMENSIONI AREA: 50x100 | Rilevatori: Giulia Rinaldini, Claudia Capponi | Data: 16-05-2017 | TOTALE 168 PIANTE | Ø | 449 | B | 168 |
| 10 | P | Particella 32 Ads A.xlsx | Particella n°. 32/Ads A Località Podernovo | DIMENSIONI AREA: 40x120 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 18-04-2017 | TOTALE 115 PIANTE | Specie | 32 | A | 115 |
| 11 | P | Particella 32 Ads B.xlsx | Particella n°. 32/Ads B Località Podernovo | DIMENSIONI AREA: 50x100 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 18-04-2017 | TOTALE 127 PIANTE | Specie | 32 | B | 127 |
| 12 | P | Particella 32 Ads C.xlsx | Particella n°. 32/Ads C Località Podernovo | DIMENSIONI AREA: 60x80 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 18-04-2017 | TOTALE 119 PIANTE | Specie | 32 | C | 119 |
| 13 | P | Particella 32 Ads D.xlsx | Particella n°. 32/Ads D Località Podernovo | DIMENSIONI AREA: 60x80 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 20-04-2017 | TOTALE 121 PIANTE | Specie | 32 | D | 121 |
| 14 | P | Particella 32 Ads E.xlsx | Particella n°. 32/Ads E Località Podernovo | DIMENSIONI AREA: 50x100 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 20-04-2017 | TOTALE 122 PIANTE | Specie | 32 | E | 122 |
| 15 | P | Particella 32 Ads F.xlsx | Particella n°. 32/Ads F Località Podernovo | DIMENSIONI AREA: 60x80 | Rilevatori: Andrea Pacciani, Giulia Rinaldini | Data: 20-04-2017 | TOTALE 111 PIANTE | Specie | 32 | F | 111 |
| 16 | A | Particella 90 Ads A ORIGINALE.xlsx | Particella n°. 90 /Ads A1 Località Faggione | DIMENSIONI AREA: 50x50 | Rilevatori: David Pozzi, Giulia Rinaldini | Data: 12-05-2017 | TOTALE 112 PIANTE | Ø | 90 | A | 112 |
| 17 | V | Particella 323 Ads A ORIGINALE.xlsx | Particella n°.323 /Ads A Località Vallombrosa | DIMENSIONI AREA: 50x100 | Rilevatori: Giulia Rinaldini, Ilaria Zorzi, Damiano Cilio, Damiano Polidori, Ginevra Manzo, Sara Rosi, Riccardo Scapigliati, Lapo Azzini | Data: 11-07-2017 | TOTALE 165 PIANTE | Ø | 323 | A | 165 |
| 18 | V | Particella 382 Ads B ORIGINALE.xlsx | Particella n°.382 /Ads B Località Vallombrosa | DIMENSIONI AREA: 50x50 | Rilevatori: Giulia Rinaldini, Ilaria Zorzi, Damiano Cilio, Ginevra Manzo | Data: 14-07-2017 | TOTALE 131 PIANTE | Ø | 382 | B | 131 |
| 19 | V | Particella 383 Ads C ORIGINALE.xlsx | Particella n°. 383/Ads C Località Vallombrosa | DIMENSIONI AREA: 50x50 | Rilevatori: Giulia Rinaldini, Ilaria Zorzi, Damiano Cilio, Ginevra Manzo | Data: 14-07-2017 | TOTALE 62 PIANTE | Ø | 383 | C | 62 |
# inizializzazione output
dbh_tally <- tibble()
for(i in 1:nrow(aree_di_saggio)) {
cartella <- localita %>%
filter(id_loc == aree_di_saggio$id_loc[i]) %>%
select(cartella) %>%
unlist()
file_name <- aree_di_saggio$file_name[i][[1]]
xlsx <- paste(source_path, cartella, file_name, sep='/')
# recupero area dati del cavallettamento
cav <- read_xlsx(xlsx, sheet = 1,
range = cell_limits(c(7, 1), c(NA, NA)),
col_names = T, col_types = "text") %>%
select(-starts_with("X_"), -starts_with("descr")) %>%
rename(d_130 = 'Ø' ) %>%
filter(!is.na(d_130) & !is.na(as.numeric.na.resistent(d_130)))
# standardizzazione struttura (in funzione della struttura in ORIGINALE)
if(aree_di_saggio$TipoPiedilista[i] == "Ø") {
cav <- cav %>% gather("specie", "freq", 2:length(.))
} else {
cav <- cav %>%
rename(specie = Specie, freq = "TOT PIANTE")
}
dbh_tally <- cav %>%
filter(!is.na(as.numeric.na.resistent(freq))) %>%
transmute(id_loc = aree_di_saggio$id_loc[i],
id_ads = aree_di_saggio$id_ads[i],
specie = specie,
d_130 = as.numeric(d_130),
freq = as.numeric( freq)) %>%
# accodamento ai dati già recuperati da altri rilievi
rbind(dbh_tally, .)
}
dbh_tally$sp <- substr(dbh_tally$specie, 1, 3)
if(!with(dbh_tally, length(unique(specie)) == length(unique(sp))))
stop("PROBLEMA: le prime tre lettere del nome di specie non forniscono un codice univoco!")
specie <- dbh_tally %>%
select(sp, specie) %>%
unique()
dbh_tally <- dbh_tally %>%
select(id_loc, id_ads, specie = sp, d_130, freq)
dbh_tally %>%
group_by(id_loc, id_ads) %>%
summarise(n_trees = sum(freq)) %>%
full_join(select(localita,
id_loc, cartella)) %>%
full_join(select(aree_di_saggio,
id_loc, id_ads, n_tot_fusti, file_name)) %>%
filter(n_trees != n_tot_fusti) %>%
kable()## Joining, by = "id_loc"## Joining, by = c("id_loc", "id_ads")id_loc id_ads n_trees cartella n_tot_fusti file_name ——- ——- ——– ——— ———— ———-
# Dopo aver collezionato tutte le tabelle 'Curva ipsometrica'
# analizzando la colonna X__1, si ricavano le specie segnalate
# sh <- tibble(x =unique(height_tally$X__1)) %>%
# filter(!is.na(x) &
# substr(x,1,2) != 'n°' &
# is.na(as.numeric(x))) %>%
# mutate(sp = str_to_lower(substring(x, 1, 3))) %>%
# rename(specie_h = x)
sh <- tribble(
~specie_h, ~sp,
"Douglasia", "dou",
"Pino nero", "pin",
"Abete bianco", "abe",
"Faggio", "fag")
# inizializza tabella di output
height_tally <- tibble()
for(i in 1:nrow(aree_di_saggio)) {
cartella <- localita %>%
filter(id_loc == aree_di_saggio$id_loc[i]) %>%
select(cartella) %>%
unlist()
file_name <- aree_di_saggio$file_name[i][[1]]
xlsx <- paste(source_path, cartella, file_name, sep='/')
# accesso: cartella, file, foglio.numero (sn)
sn <- which(str_detect(excel_sheets(xlsx),
fixed("Curva ipsometrica",
ignore_case = T)))
# se esiste uno (ed un solo) foglio 'Curva ipsometrica', ALLORA:
if(length(sn)==1) {
# recupera area dati
height_tally <- read_xlsx(xlsx, sheet = sn,
range = cell_cols(1:4),
col_names = F, col_types = "text") %>%
transmute(id_loc = aree_di_saggio$id_loc[i],
id_ads = aree_di_saggio$id_ads[i],
# recupera informazioni sulla SPECIE
specie_h = ifelse(X__1 %in% sh$specie_h, X__1, NA),
d_130 = X__3,
heigth = X__4) %>%
filter((is.na(specie_h) | !str_detect(specie_h, 'n°'))) %>%
filter(!is.na(specie_h) | !is.na(d_130)) %>%
# espandi info sulla SPECIE a tutte le righe vuote sottostanti
fill(specie_h) %>%
mutate(d_130 = as.numeric.na.resistent(d_130),
heigth = as.numeric.na.resistent(heigth)) %>%
filter(!is.na(heigth)) %>%
# accoda alle aree info già acquisite
bind_rows(height_tally)
} else {
# OPPURE stampa un messaggio per avvisare che non sono stati recuperate altezze
print(paste0(sn, " = num.fogli 'Curva ipsometrica' presenti in ",aree_di_saggio$id_loc[i]," - '",aree_di_saggio$file_name[i],"'"))
}
}## [1] " = num.fogli 'Curva ipsometrica' presenti in P - 'Particella 32 Ads A.xlsx'"
## [1] " = num.fogli 'Curva ipsometrica' presenti in P - 'Particella 32 Ads B.xlsx'"
## [1] " = num.fogli 'Curva ipsometrica' presenti in P - 'Particella 32 Ads C.xlsx'"
## [1] " = num.fogli 'Curva ipsometrica' presenti in P - 'Particella 32 Ads D.xlsx'"
## [1] " = num.fogli 'Curva ipsometrica' presenti in P - 'Particella 32 Ads E.xlsx'"
## [1] " = num.fogli 'Curva ipsometrica' presenti in P - 'Particella 32 Ads F.xlsx'"height_tally <- height_tally %>%
# adotta la codifica di specie del cavallettamento
left_join(sh) %>%
# e completa con DOUGLASIA quando la specie non è specificata
mutate(sp = ifelse(is.na(specie_h), "dou", sp)) %>%
select(-specie_h)## Joining, by = "specie_h"height_tally %$%
table(paste(id_loc,id_ads,sep='-'), sp,useNA = "ifany") %>%
kable()| abe | dou | fag | pin | |
|---|---|---|---|---|
| A-A | 8 | 28 | 0 | 0 |
| C-A | 10 | 12 | 0 | 14 |
| C-B | 0 | 31 | 0 | 0 |
| C-C | 0 | 31 | 0 | 0 |
| M-A | 0 | 29 | 0 | 0 |
| M-B | 0 | 31 | 0 | 0 |
| M-C | 0 | 34 | 0 | 0 |
| T-A | 0 | 32 | 0 | 0 |
| T-B | 0 | 31 | 0 | 0 |
| T-C | 0 | 21 | 0 | 0 |
| V-A | 0 | 34 | 0 | 0 |
| V-B | 0 | 15 | 14 | 0 |
| V-C | 0 | 17 | 0 | 0 |
library(googlesheets)
source("Functions/access2DB_GR.R", echo=F, verbose=F)
replace_ws("Cartelle", localita, DataBase)
replace_ws("Specie", specie, DataBase)
replace_ws("CampagneRilieviDendrometrici", aree_di_saggio, DataBase)
replace_ws("Cavallettamento", dbh_tally, DataBase)
replace_ws("RilieviIpsometrici", height_tally, DataBase)