Commit c390ea65 authored by Boulangeat Isabelle's avatar Boulangeat Isabelle
Browse files

load data and test

parent 50182941
---
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")
```
This diff is collapsed.
# 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)<!-- -->
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))
}
File added
File added
File added
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")
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment