DB schema

DB schema has been designed using DBSchema that produces the SQL script file required to initialize the DB (create_DB_SQL) and the following ER graph. Arzana_DBSchema.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)
## Warning: package 'dplyr' was built under R version 3.4.4
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:plyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyverse)
## ── Attaching packages ───────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.0.0     ✔ readr   1.1.1
## ✔ tibble  1.4.2     ✔ purrr   0.2.5
## ✔ tidyr   0.8.1     ✔ stringr 1.3.1
## ✔ ggplot2 3.0.0     ✔ forcats 0.3.0
## Warning: package 'ggplot2' was built under R version 3.4.4
## Warning: package 'tidyr' was built under R version 3.4.4
## Warning: package 'purrr' was built under R version 3.4.4
## Warning: package 'stringr' was built under R version 3.4.4
## ── Conflicts ──────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::arrange()   masks plyr::arrange()
## ✖ purrr::compact()   masks plyr::compact()
## ✖ dplyr::count()     masks plyr::count()
## ✖ dplyr::failwith()  masks plyr::failwith()
## ✖ dplyr::filter()    masks stats::filter()
## ✖ dplyr::id()        masks plyr::id()
## ✖ dplyr::lag()       masks stats::lag()
## ✖ dplyr::mutate()    masks plyr::mutate()
## ✖ dplyr::rename()    masks plyr::rename()
## ✖ dplyr::summarise() masks plyr::summarise()
## ✖ dplyr::summarize() masks plyr::summarize()
library(googlesheets)
## Warning: package 'googlesheets' was built under R version 3.4.4
suppressMessages(library(dplyr))

# URL del tabellone https://docs.google.com/spreadsheets/d/1Wh0gII8TdrOAcPP4iOK3idmK_BEcZF_35xsoaQobTuU/edit#gid=607028096
input.gs <- 
  "FormsInserimentoDati_Arzana2018_2"  %T>%
  gs_ls %>%
  gs_title
## Sheet successfully identified: "FormsInserimentoDati_Arzana2018_2"
input.gs %>%
  gs_ws_ls

for(s in c("Intestazione", "Scheda_1", "Scheda_2", "Rotelle"  )) {
  assign(s ,   gs_read(input.gs, ws = s, locale = readr::locale(decimal_mark = ",")))
}
## 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_integer(),
##   specie = col_character(),
##   d_130 = col_integer(),
##   h_ipso = col_double(),
##   lung_atterrato = col_double(),
##   peso_ramaglia = col_integer(),
##   fascine = col_character()
## )
## Accessing worksheet titled 'Scheda_1'.
## Parsed with column specification:
## cols(
##   id_fusto_campione = col_integer(),
##   progressivo_foglio = col_integer(),
##   distanza_suolo = col_double(),
##   diam_sezione = col_integer(),
##   id_asta_secondaria = col_character(),
##   stato_palco = col_character(),
##   numero_rami = col_integer(),
##   diam_ramo_grosso = col_integer()
## )
## Accessing worksheet titled 'Scheda_2'.
## Parsed with column specification:
## cols(
##   id_fusto_campione = col_integer(),
##   progressivo_foglio = col_integer(),
##   id_asta_secondaria = col_character(),
##   dist_da_biforcazione = col_double(),
##   diam_sezione = col_integer(),
##   id_asta_liv_inf = col_character()
## )
## Accessing worksheet titled 'Rotelle'.
## Parsed with column specification:
## cols(
##   id_fusto_campione = col_integer(),
##   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()
## )
Rotelle_gs <- Rotelle
rm(Rotelle)

Intestazione <- Intestazione %>% 
  fill(complesso)

Scheda_1 <- Scheda_1 %>% 
  fill(id_fusto_campione, progressivo_foglio)

Scheda_2 <- Scheda_2 %>% 
  fill(id_fusto_campione, progressivo_foglio, id_asta_secondaria)

Linear interpolation of data missing in diam_sez in Scheda_2

# 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)
## Warning: package 'bindrcpp' was built under R version 3.4.4
# Interpolation function

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


# Interpolation

Scheda_2 <- Scheda_2 %>%
  cbind(d1 = lag(Scheda_2$diam_sezione),
        d2 = lead(Scheda_2$diam_sezione),
        h1 = lag(Scheda_2$dist_da_biforcazione),
        h2 = lead(Scheda_2$dist_da_biforcazione)) %>%
  mutate(diam_sez_interp = linterp(dist_da_biforcazione, h1, d1, h2, d2)) %>%
  mutate(diam_sezione = ifelse(is.na(diam_sezione), round(diam_sez_interp, digits = 0), diam_sezione)) %>%
  select(-d1, d2, h1, h2, diam_sez_interp)

Create DB tables

# Table "Campagne"

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


# Table "Rilievi"

Rilievi <- Intestazione %>%
  mutate(data = replace(data, id_fusto_campione == 57, "25/07/18")) %>%  # Data mancante in scheda attribuita per logica
  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 = replace(data, is.na(data), "25/07/18" ), 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 %>%
  mutate(data = replace(data, id_fusto_campione == 57, "25/07/18")) %>%  # Data mancante in scheda attribuita per logica
  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
      ) %>%
  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, lung_atterrato, 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, 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)) %>%
  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)) %>%
  select(-ID_fustoCampione)
## Joining, by = "ID_fustoCampione"
# 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)
## Joining, by = "KeyID"
Palchi <- Palchi %>%
  select(KeyID, stato, numeroRami, diamRamoGrosso, distSuolo, ID_asta)


# 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")

Populating DB in SQLite and connecting

library(DBI)
library(RSQLite)
## Warning: package 'RSQLite' was built under R version 3.4.4
dbFileName <- "2018Arzana_FustiCampione.sqlite"
if (file.exists(dbFileName)) file.remove(dbFileName)
## [1] TRUE
syCommand <- paste("sqlite3", dbFileName, "<", "Arzana_DBSchema.sql")
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)
  Sys.sleep(1)
  }
## [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"
# dbDisconnect(dbAdF)