Intro

Data collected measuring the felled sample trees has been registered in spreadsheets that replicate tally forms. The procedure transferd the measurements to a relational dababase. Data are read from the sheets, completed, verified and reshaped into tables corresponding to DB tables. The (empty) DB is generated and then populated.

Schema of the DataBase

The schema of the DB has been designed using DBSchema. The program produces a graphical representation of the schema and the SQL script file required to initialize the DB (create_DB_SQL) 2018Arzana_FustiCampione DB schema

Access to GoogleSheet

Data tally procedures and forms are presented in this document: PROTOCOLLO DI RILIEVO CANALI ESCA_V2.pdf Data have been acquired through GoogleSheet tables that reproduced forms used in the forest.

library(plyr)
library(dplyr)
library(tidyverse)
library(magrittr)
library(googlesheets)
# getwd()
source("ReadDataFromGSheet.R")
## Worksheets feed constructed with public visibility
## Accessing worksheet titled 'Intestazione'.
## Parsed with column specification:
## cols(
##   complesso = col_character(),
##   data = col_character(),
##   rilevatori = col_character(),
##   id_gradone = col_character(),
##   progr_gradone = col_character(),
##   id_fusto_campione = col_double(),
##   specie = col_character(),
##   d_130 = col_double(),
##   h_ipso = col_double(),
##   lung_atterrato = col_double(),
##   peso_ramaglia = col_double(),
##   fascine = col_character()
## )
## Accessing worksheet titled 'Scheda_2'.
## Parsed with column specification:
## cols(
##   id_fusto_campione = col_double(),
##   progressivo_foglio = col_double(),
##   id_asta_secondaria = col_character(),
##   dist_da_biforcazione = col_double(),
##   diam_sezione = col_double(),
##   id_asta_liv_inf = col_character()
## )
## Accessing worksheet titled 'Rotelle'.
## Parsed with column specification:
## cols(
##   id_fusto_campione = col_double(),
##   peso_rotelle = col_double(),
##   dist_rot_id0 = col_double(),
##   dist_rot_id1 = col_double(),
##   dist_rot_id2 = col_double(),
##   dist_rot_id3 = col_double(),
##   dist_rot_id4 = col_double(),
##   dist_rot_id5 = col_double(),
##   dist_rot_id6 = col_double()
## )
## Accessing worksheet titled 'Scheda_1'.
## [1] READ **** File name: FustiCampione_Arzana2018_InserimentoDati - updated: 2019-01-28 10:41:46

Completing missing data

# Completing missing date
## Data mancante in scheda attribuita per logica
Intestazione <- Intestazione %>%
  mutate(data = replace(data, id_fusto_campione == 57, "25/07/18"))

# Linear interpolation of data missing in diam_sez in Scheda_2

## Interpolation function
linterp <- function(h, h1, d1, h2, d2) d1 - (h-h1)*(d1-d2)/(h2-h1)

## Sort Scheda_2 for linear interpolation of NA in diam_sezione
Scheda_2 <- arrange(Scheda_2, id_fusto_campione, id_asta_secondaria, dist_da_biforcazione)

## Interpolation
Scheda_2 <- Scheda_2 %>%
  mutate(d1 =  lag(diam_sezione),
         d2 = lead(diam_sezione),
         h1 =  lag(dist_da_biforcazione),
         h2 = lead(dist_da_biforcazione),
         diam_sez_interp = linterp(dist_da_biforcazione, h1, d1, h2, d2),
         diam_sezione = 
           ifelse(is.na(diam_sezione), diam_sez_interp, diam_sezione)) %>%
  select(-d1, -d2, -h1, -h2, -diam_sez_interp)

Prepare DB tables

# Table "Campagne"
Campagne <- tribble(
  ~ID_Campagna, ~ComplessoForestale, ~SitoDiOsservazione,
  1,  "Perdas-Monte Idolo", "Canali Esca")

# Table "Rilievi"
Rilievi <- Intestazione %>%
  group_by(data) %>%
  summarise() %>%
  ungroup() %>%
  mutate(dataRilievo = as.Date(data, format="%d/%m/%y"))
## In order to count the number of "Rilievi" piping interrupted
Rilievi <- Rilievi %>%
  mutate(ID_Campagna = Campagne[1,]$ID_Campagna, ID_Rilievo = paste0(Campagne$ID_Campagna, "_", 1:nrow(Rilievi))) %>%
  select(ID_Rilievo, ID_Campagna, dataRilievo)

# Table "Rilevatori"
Rilevatori <- tribble(
  ~ID_Rilevatore, ~Cognome, ~Nome, ~Affiliazione,
  "MRUMTT", "Mura", "Matteo",  "NFS",
  "PCCMTT", "Piccolo", "Matteo", "NFS",
  "LAIPRI", "Lai", "Piero", "Forestas",                      
  "MLSTTV", "Melis", "Ottavio", "Forestas",
  "MCLMRA", "Muceli", "Mauro", "NFS",
  "BBICRS", "Ibba", "Cristian", "CFVA",
  "MRNMRA", "Marongiu", "Mauro", "Forestas")

# Table "Squadre"
Squadre <- Intestazione %>%
  select(data, rilevatori) %>%
  mutate(data = as.Date(data, format="%d/%m/%y")) %>%
  unique %>% 
  separate(rilevatori, c("Rilevatore1", "Rilevatore2", "Rilevatore3", "Rilevatore4", "Rilevatore5", "Rilevatore6"),
           remove = T, sep = ", ", fill = "right") %>%
  gather(starts_with("Rilevatore"), key = "id_ril", value = "Cognome") %>%
  select(-id_ril) %>%
  mutate(Cognome = replace(Cognome, Cognome == "Mereu", NA)) %>%
  filter(!is.na(Cognome)) %>%
  unique %>%
  right_join(select(Rilevatori, ID_Rilevatore, Cognome),.) %>%
  select(-Cognome) %>%
  right_join(select(Rilievi, ID_Rilievo, dataRilievo), .,
             by = c("dataRilievo" = "data")) %>%
  select(-dataRilievo)
## Joining, by = "Cognome"
# Table "Specie" - ID_Specie from EPPO (https://data.eppo.int/)
Specie <- tribble(
  ~ID_Specie, ~nomeScientifico, ~nomeItaliano, ~species,
  "PIURA", "Pinus radiata, D.Don", "pino di Monterey", "Monterey pine",
  "PIUPL", "Pinus pinaster, Aiton", "pino marittimo", "maritime pine")

# Table "FustiCampioneEtAdF"
FustiCampioneEtAdF <- Intestazione %>%
  full_join(select(Rotelle_gs, id_fusto_campione, peso_rotelle)) %>%
  rename(
    ID_fustoCampione = id_fusto_campione,
    ID_gradone = id_gradone,
    Prog_gradone = progr_gradone,   
    pesoFrescoRamaglia = peso_ramaglia,
    pesoRotelle = peso_rotelle,
    lunghezzaAbbattuto = lung_atterrato
      ) %>%
  mutate(dataRilievo = as.Date(data, format="%d/%m/%y")) %>%
  full_join(select(Rilievi, dataRilievo, ID_Rilievo)) %>%
  add_column(KeyID = paste0(.$ID_Rilievo, "_", .$ID_fustoCampione), .before = 1) %>%
  select(-c(complesso, data, rilevatori, fascine)) %>%
  mutate(ID_specie = map_chr(specie, ~switch(., R = "PIURA", M = "PIUPL", -1))) %>%
  select(-c(specie, dataRilievo)) %>%
  select(KeyID, ID_Rilievo, ID_fustoCampione, ID_gradone, Prog_gradone,
         ID_specie, d_130, h_ipso, lunghezzaAbbattuto, pesoFrescoRamaglia, pesoRotelle)
## Joining, by = "id_fusto_campione"
## Joining, by = "dataRilievo"
# Table "ProfiliFustiPrincipali"
ProfiliFustiPrincipali <- Scheda_1 %>%
  filter(!is.na(diam_sezione)) %>%
  rename(distSuolo = distanza_suolo, d_sez = diam_sezione) %>%
  right_join(select(FustiCampioneEtAdF, KeyID, ID_fustoCampione), .,
             by = c("ID_fustoCampione" = "id_fusto_campione")) %>%
  arrange(KeyID, distSuolo) %>%
  ddply(.(KeyID), mutate, ID_sez = seq_along(KeyID)) %>% # Da verificare se usare il mutate
  select(KeyID, distSuolo, d_sez) %>%
  distinct(KeyID, distSuolo, .keep_all = T)

# Table "ProfiliFustiSecondari"
ProfiliFustiSecondari <- Scheda_2 %>%
  select(id_fusto_campione, progressivo_foglio, id_asta_secondaria, dist_da_biforcazione, diam_sezione) %>%
  right_join(select(FustiCampioneEtAdF, KeyID, ID_fustoCampione), .,
             by = c("ID_fustoCampione" = "id_fusto_campione")) %>%
  select(KeyID, id_asta_secondaria, dist_da_biforcazione, diam_sezione) %>%
  rename(ID_asta = id_asta_secondaria,
         distanzaBiforcazione = dist_da_biforcazione,
         diametro = diam_sezione)

# Table "Palchi"
Palchi <- filter(Scheda_1, is.na(diam_sezione)) %>%
  select(stato_palco, numero_rami, diam_ramo_grosso, distanza_suolo, id_fusto_campione, id_asta_secondaria) %>%
  rename(stato = stato_palco,
         numeroRami = numero_rami,
         distSuolo = distanza_suolo,
         diamRamoGrosso = diam_ramo_grosso,
         ID_fustoCampione = id_fusto_campione,
         ID_asta = id_asta_secondaria) %>%
  inner_join(select(FustiCampioneEtAdF, ID_fustoCampione, KeyID),.) %>%
  ddply(.(KeyID), mutate, ID_palco = seq_along(KeyID)) %>% # Da verificare se usare il mutate
  select(-ID_fustoCampione)
## Joining, by = "ID_fustoCampione"
# Table "Rotelle"
Rotelle <- Rotelle_gs %>%
  select(-peso_rotelle) %>%
  inner_join(select(FustiCampioneEtAdF, KeyID, ID_fustoCampione),., by = c(ID_fustoCampione = "id_fusto_campione"))

if (nrow(Rotelle) != nrow(Rotelle_gs)) stop("si perdono rotelle")

Rotelle <- Rotelle %>%
  select(-ID_fustoCampione) %>%
  gather(starts_with("dist_rot_id"), key = "rotella_num", value = "distSuolo") %>%
  mutate(cls_h = str_sub(rotella_num, 12)) %>%
  select(-rotella_num) %>%
  arrange(KeyID, distSuolo)

Rotelle <- Rotelle %>%
  select(KeyID, cls_h, distSuolo)

# Table "ClassiAltezza"
ClassiAltezza <-  tribble(
  ~cls_h, ~classe_altezza,
  0, "base",
  1, "50cm",
  2, "dbh",
  3, "1/4h_circa",
  4, "1/2h",
  5, "2/3h",
  6, "5/6h")

Completing DB tables

## Check for trees without any indication in "stato"
Palchi %>%
  filter(is.na(stato)) %>%
  select(KeyID) %>%
  unique %>%
  nrow
## [1] 57
## Selection of the first row of each tree where "stato" is NA, and set it as "X"
Palchi <- Palchi %>%
  group_by(KeyID) %>%
  mutate(stato = replace(stato, min(distSuolo) & is.na(stato), "X")) %>%
  fill(stato)

Palchi <- Palchi %>%
  group_by(KeyID) %>%
  fill(stato)

## Selection of trees without stato indication (set to NA)
noStato <- Palchi %>%
  select(KeyID) %>%
  unique() %>%
  setdiff(filter(Palchi, stato != "X") %>% select(KeyID) %>% unique) %>%
  add_column(newStato = "not_avail")

Palchi <- Palchi %>%
  full_join(noStato) %>%
  mutate(stato = replace(stato, newStato == "not_avail", NA)) %>%
  select(-newStato) %>% 
  select(KeyID, ID_palco, stato, numeroRami, diamRamoGrosso, distSuolo, ID_asta)
## Joining, by = "KeyID"

Creating and populating DB in SQLite

library(DBI)
library(RSQLite)

dbFileName <- "2018Arzana_FustiCampione.sqlite"

if (file.exists(dbFileName)) cat("ERROR: SQLite file exists and has not been overwritten!\n To produce a new SQLite file delete the old one \n") else
  {
  syCommand <- paste("sqlite3", dbFileName, "<", "DB_Schema_Arzana2018.sql")
  # Create SQLite DB file using the given schema
  system(syCommand)
  
  tablesList <-  c("Specie",
                   "Campagne",
                   "Rilevatori",
                   "Rilievi",
                   "Squadre",
                   "FustiCampioneEtAdF",
                   "ProfiliFustiPrincipali",
                   "Palchi",
                   "ProfiliFustiSecondari",
                   "ClassiAltezza",
                   "Rotelle")
  
  dbAdF <- dbConnect(RSQLite::SQLite(), dbFileName)
  
  for (tab in tablesList) {
    print(paste("writing table", tab))
    RSQLite::dbWriteTable(dbAdF, tab, get(tab), append = T)
# Populate the (empty) DB tables (Order of tables has to respect external keys)
    Sys.sleep(1)
    }
  dbDisconnect(dbAdF)
  cat(format(Sys.time(), '%B %d, %Y - %H:%M:%S'))
  }
## [1] "writing table Specie"
## [1] "writing table Campagne"
## [1] "writing table Rilevatori"
## [1] "writing table Rilievi"
## [1] "writing table Squadre"
## [1] "writing table FustiCampioneEtAdF"
## [1] "writing table ProfiliFustiPrincipali"
## [1] "writing table Palchi"
## [1] "writing table ProfiliFustiSecondari"
## [1] "writing table ClassiAltezza"
## [1] "writing table Rotelle"
## Gennaio 31, 2019 - 09:33:56