load data and test

README.Rmd

+---
+title: "README"
+author: "Isabelle Boulangeat"
+date: "25/01/2021"
+output:
+  html_document:
+    keep_md: yes
+    variant: markdown_github
+editor_options:
+  chunk_output_type: console
+always_allow_html: true
+---
+
+```{r setup, include=FALSE}
+library(knitr)
+# library(kableExtra)
+knitr::opts_chunk$set(echo = TRUE)
+# library(Jmisc)
+library(tidyr)
+sapply(list.files("R_fct"), function(x)source(paste0("R_fct/",x)))
+data = readRDS("data.rds")
+```
+
+```{r ,fig=TRUE}
+dat_h_veg = merge(data$h, data$sites[,c("id_site", "ref_typoveg")], by.x = "ref_site", by.y ="id_site")
+
+str(dat_h_veg)
+summary(dat_h_veg$hmean)
+
+
+#==============================
+## H variation par milieu ##
+#===============================
+
+library(dplyr)
+# library(reshape)
+library(tidyr)
+library(ggplot2)
+dat_long <- dat_h_veg %>%
+ select(hmean, hmad, ref_typoveg) %>%
+ drop_na() %>%
+ group_by(ref_typoveg) %>%
+ summarize(hauteur=mean(hmean), var_inter=mad(hmean), var_intra = mean(hmad)) %>%
+ gather(stat, value, hauteur:var_intra)
+
+ggplot(dat_long, aes(fill=stat, x=ref_typoveg, y=value)) +
+  geom_bar(position = "dodge", stat = "identity") +
+  facet_wrap(~stat, ncol = 1, scales = "free")
+```
+
+

README.md

-# as_biomass
+---
+title: "README"
+author: "Isabelle Boulangeat"
+date: "25/01/2021"
+output:
+  html_document:
+    keep_md: yes
+    variant: markdown_github
+editor_options:
+  chunk_output_type: console
+always_allow_html: true
+---
+
+
+
+
+```r
+dat_h_veg = merge(data$h, data$sites[,c("id_site", "ref_typoveg")], by.x = "ref_site", by.y ="id_site")
+
+str(dat_h_veg)
+```
+
+```
+## 'data.frame':	1368 obs. of  8 variables:
+##  $ ref_site       : chr  "BELRIV01" "BELRIV01" "BELRIV01" "BELRIV01" ...
+##  $ ref_releve     : chr  "BELRIV01_L1_18_09_2019" "BELRIV01_L1_07_08_2017" "BELRIV01_L1_14_06_2017" "BELRIV01_L2_23_07_2019" ...
+##  $ hmean          : num  6.4 7.55 10.11 8.96 6.79 ...
+##  $ hsd            : num  5.09 5.75 5.86 6.17 4.48 ...
+##  $ hmad           : num  5.93 5.93 5.56 7.78 4.45 ...
+##  $ date_releve    : Date, format: "2019-09-18" "2017-08-07" ...
+##  $ ref_observateur: chr  "IRS_CT" "IRS_GL" "IRS_GL" "IRS_CT" ...
+##  $ ref_typoveg    : chr  "QUE" "QUE" "QUE" "QUE" ...
+```
+
+```r
+summary(dat_h_veg$hmean)
+```
+
+```
+##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
+##   0.500   3.872   6.319   8.394  10.581  45.675     160
+```
+
+```r
+#==============================
+## H variation par milieu ##
+#===============================
+
+library(dplyr)
+```
+
+```
+## 
+## Attaching package: 'dplyr'
+```
+
+```
+## The following objects are masked from 'package:stats':
+## 
+##     filter, lag
+```
+
+```
+## The following objects are masked from 'package:base':
+## 
+##     intersect, setdiff, setequal, union
+```
+
+```r
+# library(reshape)
+library(tidyr)
+library(ggplot2)
+dat_long <- dat_h_veg %>%
+ select(hmean, hmad, ref_typoveg) %>%
+ drop_na() %>%
+ group_by(ref_typoveg) %>%
+ summarize(hauteur=mean(hmean), var_inter=mad(hmean), var_intra = mean(hmad)) %>%
+ gather(stat, value, hauteur:var_intra)
+```
+
+```
+## `summarise()` ungrouping output (override with `.groups` argument)
+```
+
+```r
+ggplot(dat_long, aes(fill=stat, x=ref_typoveg, y=value)) +
+  geom_bar(position = "dodge", stat = "identity") +
+  facet_wrap(~stat, ncol = 1, scales = "free")
+```
+
+![](README_files/figure-html/unnamed-chunk-1-1.png)<!-- -->
+
 

R_fct/database_import.r

+
+config.db.siddt <- function(){
+
+require(RPostgreSQL)
+
+#### Parametre ####
+db_host     <<- "siddt.grenoble.irstea.priv"
+db_name     <<- "basedtm"
+db_user     <<- "isabelle_boulangeat"
+db_pw       <<- "isabelle"
+
+#### Connexion a la BDD ####
+
+# Déclaration du driver a utiliser
+drv <<- dbDriver("PostgreSQL")
+
+#Préparation de la chaine de connexion
+con <<- dbConnect(drv,
+                  dbname = db_name ,
+                  host = db_host,
+                  port = "5432",
+                  user = db_user,
+                  password=db_pw)
+
+#Declaration de l'encodage courant (souvent différent de la base qui est en UTF 8)
+#postgresqlpqExec(con, "SET client_encoding = 'windows-1252'");
+postgresqlpqExec(con, "SET client_encoding = 'UTF-8'")
+return("connected")
+}
+
+#==============================================================
+
+import_from_db <- function(){
+
+  require(dplyr)
+
+  sql_biomass_h <- "SELECT * FROM sentinelle.biomasse_occurences"
+  data_biomass_h <- dbGetQuery(con, sql_biomass_h)
+
+  data_h = data_biomass_h %>% group_by(ref_releve) %>% summarize(hmean=mean(hauteur), hsd=sd(hauteur), hmad = mad(hauteur))
+  # str(data_h)
+  # tail(data_h)
+
+  sql_biomass_rel <- "SELECT * FROM sentinelle.biomasse_releves"
+  data_biomass_rel <- dbGetQuery(con, sql_biomass_rel)
+
+  # str(data_biomass_rel)
+
+  data_h_all = merge(data_h, data_biomass_rel[,c("id_releve", "date_releve", "ref_observateur")], by.x="ref_releve", by.y = "id_releve")
+  # str(data_h_all)
+
+  data_h_all$ref_site = unlist(lapply(data_h_all$ref_releve, function(x)strsplit(x, "_")[[1]][1]))
+
+  dbGetQuery(con, "DROP TABLE chabli.biomasse_h")
+
+  # sql_biomass_h_save <- "CREATE TABLE chabli.biomasse_h (
+  #   ref_releve text,
+  #   hmean real,
+  #   hvar real,
+  #   hmad real
+  #   )"
+  # dbGetQuery(con, sql_biomass_h_save)
+  #
+  dbWriteTable(con, name=c("chabli", "biomasse_h"), value=data_h_all, append=FALSE, row.names=FALSE)
+
+  sql_biomass_site <- "SELECT * FROM sentinelle.biomasse_sites"
+  data_biomass_site <- dbGetQuery(con, sql_biomass_site)
+
+  # str(data_biomass_site)
+
+  saveRDS(data_h_all, file="data_h.rds")
+  saveRDS(data_biomass_site, file="data_sites.rds")
+  return(list(h = data_h_all, sites = data_biomass_site))
+}

workflow.r

+sapply(list.files("R_fct"), function(x)source(paste0("R_fct/",x)))
+#==============================
+## Import data from database ##
+#===============================
+
+require(RPostgreSQL)
+config.db.siddt()
+data=import_from_db()
+
+saveRDS(data, "data.rds")
+
+#==============================
+## dataframe ##
+#===============================
+head(data$sites)
+
+dat_h_veg = merge(data$h, data$sites[,c("id_site", "ref_typoveg")], by.x = "ref_site", by.y ="id_site")
+
+str(dat_h_veg)
+summary(dat_h_veg$hmean)
+
+
+#==============================
+## H variation par milieu ##
+#===============================
+
+library(dplyr)
+# library(reshape)
+library(tidyr)
+library(ggplot2)
+dat_long <- dat_h_veg %>%
+ select(hmean, hmad, ref_typoveg) %>%
+ drop_na() %>%
+ group_by(ref_typoveg) %>%
+ summarize(hauteur=mean(hmean), var_inter=mad(hmean), var_intra = mean(hmad)) %>%
+ gather(stat, value, hauteur:var_intra)
+
+ggplot(dat_long, aes(fill=stat, x=ref_typoveg, y=value)) +
+  geom_bar(position = "dodge", stat = "identity") +
+  facet_wrap(~stat, ncol = 1, scales = "free")
+
+#==============================
+## H boxplots ##
+#===============================
+
+#==============================
+## H series ##
+#===============================
+
+pl <- ggplot(dat_h_veg, aes(x = date_releve, y = hmean)) +
+  geom_line(aes(color = ref_site), show.legend = FALSE) +
+  facet_wrap(~ref_typoveg)
+
+pl + theme(legend.position = "none")