inst/shiny-apps/lupa-summary/server.R
In remymoine/Lupa: Lupa
library(shiny)
library(sf)
library(Lupa)
library(dplyr)
library(sf)
library(ggplot2)
library(knitr)
server <-function(input, output) {
# Sélection de l'aire géographique ####
Parc_area <- reactive({
req(input$Parc)
dplyr::filter(area_parc,GEST_SITE %in% input$Parc)
})
# Formatage des dates ####
d_sel_min <- reactive({
req(input$d_sel_min)
lubridate::as_date(input$d_sel_min, format = "%Y-%m-%d", tz = NULL)
})
d_sel_max <- reactive({
req(input$d_sel_max)
lubridate::as_date(input$d_sel_max, format = "%Y-%m-%d", tz = NULL)
})
# Calcul de la période de référence ####
d_sel_min_ref <- reactive({
lubridate::as_date(d_sel_min(), format = "%Y-%m-%d", tz = NULL) - lubridate::years(x = 1)
})
d_sel_max_ref <- reactive({
lubridate::as_date(d_sel_max(), format = "%Y-%m-%d", tz = NULL) - lubridate::years(x = 1)
})
# Constat ####
constat <- reactive({
req(
input$constat,
input$eleveur_c,
input$commune_c,
input$date_c,
input$nb_anim_tot_c,
input$nb_vict_c,
input$X_c,
input$Y_c
)
Parc_area <- Parc_area()
##Import du fichier brut
constat <- readr::read_csv2(
file = input$constat$datapath,
col_names = TRUE)
##"Sélection des variables d'intérêt
sel_constat <- c(
input$eleveur_c,
input$commune_c,
input$date_c,
input$nb_anim_tot_c,
input$nb_vict_c,
input$X_c,
input$Y_c
)
##Intégration géographique
tmp <- sf::st_as_sf(
constat[,sel_constat],
coords = c(X=6,Y=7),
crs = 2154)
tmp <- sf::st_transform(tmp,2154)
#"Formatage des variables
names(tmp) <- c("eleveur","commune","date","nb_anim_tot","nb_vict","geometry")
tmp$date <- lubridate::as_date(tmp$date, format = "%d/%m/%y", tz = NULL)
##Tri des données
### conserve les données dans la période fixée
data_pts <- dplyr::filter(tmp, date >= d_sel_min() & date <= d_sel_max())
### retire les observations non rattachées à des éleveurs
sel <- which(data_pts$eleveur %in% NA)
data_pts <- data_pts[-sel,]
##Augmentation du jeu de données
###création d'une variable insee issue du code insee contenu dans le champ
###commune
data_pts$insee <- stringr::str_extract(
string = data_pts$commune,
pattern = "(?<=\\()[:digit:]{5}(?=\\))"
)
###création des variable de prédicats géographiques avec
###intersection de l'aire d'adhésion
data_pts$aa <- sf::st_intersects(data_pts, Parc_area[1,], sparse = FALSE)
###intersection de la zone coeur
data_pts$zc <- sf::st_intersects(data_pts, Parc_area[2,], sparse = FALSE)
### concaténation dans une variable "type"
data_pts[which(data_pts$aa == TRUE),"type"] <- "2_AA"
data_pts[which(data_pts$zc == TRUE),"type"] <- "1_ZC"
data_pts[which(data_pts$aa == FALSE & data_pts$zc == FALSE),"type"] <- "3_DPT"
###création de la variable attaque
data_pts$attaque <- rep(1, nrow(data_pts))
### jointure avec les communes
data_pts<- dplyr::right_join(area_com, data_pts, by = "insee")
constat0 <- sf::st_as_sf(data_pts)
constat0 <- sf::st_transform(constat0,2154)
constat0
})
# Référence ####
reference <- reactive({
req(
input$reference,
input$eleveur_r,
input$commune_r,
input$date_r,
input$nb_anim_tot_r,
input$nb_vict_r,
input$X_r,
input$Y_r
)
Parc_area <- Parc_area()
constat<-readr::read_csv2(
file = input$reference$datapath,
col_names = TRUE)
sel_constat <- c(
input$eleveur_r,
input$commune_r,
input$date_r,
input$nb_anim_tot_r,
input$nb_vict_r,
input$X_r,
input$Y_r
)
tmp <- sf::st_as_sf(
constat[,sel_constat],
coords = c(X=6,Y=7),
crs = 2154)
tmp <- sf::st_transform(tmp,2154)
names(tmp) <- c("eleveur","commune","date","nb_anim_tot","nb_vict","geometry")
tmp$date <- lubridate::as_date(tmp$date, format = "%d/%m/%y", tz = NULL)
tmp <- dplyr::filter(
tmp,
lubridate::year(date) < lubridate::year(d_sel_min()) &
lubridate::month(date) >= lubridate::month(d_sel_min()) &
lubridate::month(date) <= lubridate::month(d_sel_max()) &
lubridate::day(date) >= lubridate::day(d_sel_min()) &
lubridate::day(date) <= lubridate::day(d_sel_max())
)
sel <- which(tmp$eleveur %in% NA)
data_pts <- tmp[-sel,]
data_pts$insee <- stringr::str_extract(
string = data_pts$commune,
pattern = "(?<=\\()[:digit:]{5}(?=\\))"
)
data_pts$aa <- sf::st_intersects(data_pts, Parc_area[1,], sparse = FALSE)
data_pts$zc <- sf::st_intersects(data_pts, Parc_area[2,], sparse = FALSE)
data_pts[which(data_pts$aa == TRUE),"type"] <- "2_AA"
data_pts[which(data_pts$zc == TRUE),"type"] <- "1_ZC"
data_pts[which(data_pts$aa == FALSE & data_pts$zc == FALSE),"type"] <- "3_DPT"
data_pts$attaque <- rep(1, nrow(data_pts))
data_pts <- dplyr::right_join(area_com, data_pts, by = "insee")
reference0 <- sf::st_as_sf(data_pts)
reference0 <- sf::st_transform(reference0,2154)
reference0
})
# Concaténation####
constetref <- reactive({
constetref <- rbind(constat(), reference())
constetref$annee <- lubridate::year(constetref$date)
constetref <- sf::st_as_sf(constetref)
constetref <- sf::st_transform(constetref, 2154)
constetref
})
# Valeurs de référence attaques ####
## ZC
zc_txt_att_base <- reactive({
tmp <- aggregate(data = constetref(), attaque ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "1_ZC")
tmp2
})
zc_txt_att_nb <- reactive({
tmp2 <- zc_txt_att_base()
paste(tmp2[nrow(tmp2),3]," attaques en zone coeur en ",tmp2[nrow(tmp2),1],sep = "")
})
zc_txt_att_evol <- reactive({
tmp2 <- zc_txt_att_base()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = "")
)
})
## AA
aa_txt_att_base <- reactive({
tmp <- aggregate(data = constetref, attaque ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "2_AA")
tmp2
})
aa_txt_att_evol <- reactive({
tmp2 <- aa_txt_att_base()
paste(tmp2[nrow(tmp2),3]," attaques en aire d'adhésion en ",tmp2[nrow(tmp2),1],sep = "")
})
aa_txt_att_nb <- reactive({
tmp2 <- aa_txt_att_base()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = ""))
})
# Valeurs de référence victimes ####
## ZC
zc_txt_att_base_ref <- reactive({
tmp <- aggregate(data = constetref(), nb_vict ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "1_ZC")
tmp2
})
zc_txt_att_nb_ref <- reactive({
tmp2 <- zc_txt_att_base_ref()
paste(tmp2[nrow(tmp2),3]," attaques en zone coeur en ",tmp2[nrow(tmp2),1],sep = "")
})
zc_txt_att_evol_ref <- reactive({
tmp2 <- zc_txt_att_base_ref()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = "")
)
})
## AA
aa_txt_att_base_ref <- reactive({
tmp <- aggregate(data = constetref(), nb_vict ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "2_AA")
tmp2
})
aa_txt_att_evol_ref <- reactive({
tmp2 <- aa_txt_att_base_ref()
paste(tmp2[nrow(tmp2),3]," attaques en aire d'adhésion en ",tmp2[nrow(tmp2),1],sep = "")
})
aa_txt_att_nb_ref <- reactive({
tmp2 <- aa_txt_att_base_ref()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = ""))
})
# Evolution nb_attaques####
output$barplot_att_tot <- renderPlot({
ggplot(
data = constetref(),
aes(
x = as.character(annee),
y = attaque,
fill = type)
) +
geom_bar(position = "stack", stat = "identity") +
xlab("Année") +
ylab("Nombre d'attaques") +
scale_fill_manual(
name = "Localisation des attaques",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 45, hjust = 1)
)
})
# Evolution nb_victimes####
output$barplot_vict_tot <- renderPlot({
ggplot(
data = constetref(),
aes(
x = as.character(annee),
y = nb_vict,
fill = type)
) +
geom_bar(position = "stack", stat = "identity") +
xlab("Année") +
ylab("Nombre de victimes") +
scale_fill_manual(
name = "Localisation des victimes",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 45, hjust = 1)
)
})
# Données Comparaison intercommunale ####
comp_intercom <- reactive({
dplyr::filter(
constetref(),
type != "3_DPT" & annee >= lubridate::year(d_sel_min_ref())
)
})
# Barplot att_com ####
output$barplot_att_com <- renderPlot({
data <- comp_intercom()
tmp <- aggregate(data = data, attaque ~ commune + type + annee, sum)
ggplot(
data = tmp,
aes(x = commune, y = attaque, fill = type )) +
geom_col(position = "stack") +
xlab("Communes") +
ylab("Nombre d'attaques") +
scale_fill_manual(
name = "Localisation des attaques",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
facet_grid(annee ~ .) +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1),
strip.text.y = element_text(size = 15)
)
},height = 750)
# Barplot vict_com ####
output$barplot_vict_com <- renderPlot({
data <- comp_intercom()
tmp <- aggregate(data = data, nb_vict ~ commune + type + annee, sum)
ggplot(
data = tmp,
aes(x = commune, y = nb_vict, fill = type )) +
geom_col(position = "stack") +
xlab("Communes") +
ylab("Nombre de victimes") +
scale_fill_manual(
name = "Localisation des victimes",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
facet_grid(annee ~ .) +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1),
strip.text.y = element_text(size = 15)
)
}, height = 750)
# Map att_com ####
output$map_att_com <- renderPlot({
Parc_area <- Parc_area()
tmp <- aggregate(
data = dplyr::filter(
constat(),
type != "3_DPT"),
attaque ~ insee,
sum)
tmp2 <- dplyr::left_join(tmp, area_com, by = "insee")
tmp2 <- sf::st_as_sf(tmp2)
ggplot() +
geom_sf(
data = tmp2,
aes(fill = attaque)
) +
geom_sf(
data = Parc_area[2,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1.5) +
geom_sf(
data = Parc_area[1,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1,
linetype = "dashed") +
scale_fill_gradient(name = "Nombre de victimes par communes" ,low = "lightgrey", high = "red") +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1)
)
}, height = 750)
# Map vict_com ####
output$map_vict_com <- renderPlot({
Parc_area <- Parc_area()
tmp <- aggregate(
data = dplyr::filter(
constat(),
type != "3_DPT"),
nb_vict ~ insee,
sum)
tmp2 <- dplyr::left_join(tmp, area_com, by = "insee")
tmp2 <- sf::st_as_sf(tmp2)
ggplot() +
geom_sf(
data = tmp2,
aes(fill = nb_vict)
) +
geom_sf(
data = Parc_area[2,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1.5) +
geom_sf(
data = Parc_area[1,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1,
linetype = "dashed") +
scale_fill_gradient(name = "Nombre de victimes par communes" ,low = "lightgrey", high = "red") +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1)
)
}, height = 750)
# Rapport téléchargeable ####
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = "report.pdf",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "Presentation.Rmd")
file.copy("Presentation.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(
area_com = area_com,
Parc = input$Parc,
d_sel_min = input$d_sel_min,
d_sel_max = input$d_sel_max,
constat = constat(),
Parc_area = Parc_area(),
constetref = constetref(),
comp_intercom = comp_intercom()
)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
#####
}
remymoine/Lupa documentation built on Aug. 5, 2020, 12:07 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(shiny)
library(sf)
library(Lupa)
library(dplyr)
library(sf)
library(ggplot2)
library(knitr)
server <-function(input, output) {
# Sélection de l'aire géographique ####
Parc_area <- reactive({
req(input$Parc)
dplyr::filter(area_parc,GEST_SITE %in% input$Parc)
})
# Formatage des dates ####
d_sel_min <- reactive({
req(input$d_sel_min)
lubridate::as_date(input$d_sel_min, format = "%Y-%m-%d", tz = NULL)
})
d_sel_max <- reactive({
req(input$d_sel_max)
lubridate::as_date(input$d_sel_max, format = "%Y-%m-%d", tz = NULL)
})
# Calcul de la période de référence ####
d_sel_min_ref <- reactive({
lubridate::as_date(d_sel_min(), format = "%Y-%m-%d", tz = NULL) - lubridate::years(x = 1)
})
d_sel_max_ref <- reactive({
lubridate::as_date(d_sel_max(), format = "%Y-%m-%d", tz = NULL) - lubridate::years(x = 1)
})
# Constat ####
constat <- reactive({
req(
input$constat,
input$eleveur_c,
input$commune_c,
input$date_c,
input$nb_anim_tot_c,
input$nb_vict_c,
input$X_c,
input$Y_c
)
Parc_area <- Parc_area()
##Import du fichier brut
constat <- readr::read_csv2(
file = input$constat$datapath,
col_names = TRUE)
##"Sélection des variables d'intérêt
sel_constat <- c(
input$eleveur_c,
input$commune_c,
input$date_c,
input$nb_anim_tot_c,
input$nb_vict_c,
input$X_c,
input$Y_c
)
##Intégration géographique
tmp <- sf::st_as_sf(
constat[,sel_constat],
coords = c(X=6,Y=7),
crs = 2154)
tmp <- sf::st_transform(tmp,2154)
#"Formatage des variables
names(tmp) <- c("eleveur","commune","date","nb_anim_tot","nb_vict","geometry")
tmp$date <- lubridate::as_date(tmp$date, format = "%d/%m/%y", tz = NULL)
##Tri des données
### conserve les données dans la période fixée
data_pts <- dplyr::filter(tmp, date >= d_sel_min() & date <= d_sel_max())
### retire les observations non rattachées à des éleveurs
sel <- which(data_pts$eleveur %in% NA)
data_pts <- data_pts[-sel,]
##Augmentation du jeu de données
###création d'une variable insee issue du code insee contenu dans le champ
###commune
data_pts$insee <- stringr::str_extract(
string = data_pts$commune,
pattern = "(?<=\\()[:digit:]{5}(?=\\))"
)
###création des variable de prédicats géographiques avec
###intersection de l'aire d'adhésion
data_pts$aa <- sf::st_intersects(data_pts, Parc_area[1,], sparse = FALSE)
###intersection de la zone coeur
data_pts$zc <- sf::st_intersects(data_pts, Parc_area[2,], sparse = FALSE)
### concaténation dans une variable "type"
data_pts[which(data_pts$aa == TRUE),"type"] <- "2_AA"
data_pts[which(data_pts$zc == TRUE),"type"] <- "1_ZC"
data_pts[which(data_pts$aa == FALSE & data_pts$zc == FALSE),"type"] <- "3_DPT"
###création de la variable attaque
data_pts$attaque <- rep(1, nrow(data_pts))
### jointure avec les communes
data_pts<- dplyr::right_join(area_com, data_pts, by = "insee")
constat0 <- sf::st_as_sf(data_pts)
constat0 <- sf::st_transform(constat0,2154)
constat0
})
# Référence ####
reference <- reactive({
req(
input$reference,
input$eleveur_r,
input$commune_r,
input$date_r,
input$nb_anim_tot_r,
input$nb_vict_r,
input$X_r,
input$Y_r
)
Parc_area <- Parc_area()
constat<-readr::read_csv2(
file = input$reference$datapath,
col_names = TRUE)
sel_constat <- c(
input$eleveur_r,
input$commune_r,
input$date_r,
input$nb_anim_tot_r,
input$nb_vict_r,
input$X_r,
input$Y_r
)
tmp <- sf::st_as_sf(
constat[,sel_constat],
coords = c(X=6,Y=7),
crs = 2154)
tmp <- sf::st_transform(tmp,2154)
names(tmp) <- c("eleveur","commune","date","nb_anim_tot","nb_vict","geometry")
tmp$date <- lubridate::as_date(tmp$date, format = "%d/%m/%y", tz = NULL)
tmp <- dplyr::filter(
tmp,
lubridate::year(date) < lubridate::year(d_sel_min()) &
lubridate::month(date) >= lubridate::month(d_sel_min()) &
lubridate::month(date) <= lubridate::month(d_sel_max()) &
lubridate::day(date) >= lubridate::day(d_sel_min()) &
lubridate::day(date) <= lubridate::day(d_sel_max())
)
sel <- which(tmp$eleveur %in% NA)
data_pts <- tmp[-sel,]
data_pts$insee <- stringr::str_extract(
string = data_pts$commune,
pattern = "(?<=\\()[:digit:]{5}(?=\\))"
)
data_pts$aa <- sf::st_intersects(data_pts, Parc_area[1,], sparse = FALSE)
data_pts$zc <- sf::st_intersects(data_pts, Parc_area[2,], sparse = FALSE)
data_pts[which(data_pts$aa == TRUE),"type"] <- "2_AA"
data_pts[which(data_pts$zc == TRUE),"type"] <- "1_ZC"
data_pts[which(data_pts$aa == FALSE & data_pts$zc == FALSE),"type"] <- "3_DPT"
data_pts$attaque <- rep(1, nrow(data_pts))
data_pts <- dplyr::right_join(area_com, data_pts, by = "insee")
reference0 <- sf::st_as_sf(data_pts)
reference0 <- sf::st_transform(reference0,2154)
reference0
})
# Concaténation####
constetref <- reactive({
constetref <- rbind(constat(), reference())
constetref$annee <- lubridate::year(constetref$date)
constetref <- sf::st_as_sf(constetref)
constetref <- sf::st_transform(constetref, 2154)
constetref
})
# Valeurs de référence attaques ####
## ZC
zc_txt_att_base <- reactive({
tmp <- aggregate(data = constetref(), attaque ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "1_ZC")
tmp2
})
zc_txt_att_nb <- reactive({
tmp2 <- zc_txt_att_base()
paste(tmp2[nrow(tmp2),3]," attaques en zone coeur en ",tmp2[nrow(tmp2),1],sep = "")
})
zc_txt_att_evol <- reactive({
tmp2 <- zc_txt_att_base()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = "")
)
})
## AA
aa_txt_att_base <- reactive({
tmp <- aggregate(data = constetref, attaque ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "2_AA")
tmp2
})
aa_txt_att_evol <- reactive({
tmp2 <- aa_txt_att_base()
paste(tmp2[nrow(tmp2),3]," attaques en aire d'adhésion en ",tmp2[nrow(tmp2),1],sep = "")
})
aa_txt_att_nb <- reactive({
tmp2 <- aa_txt_att_base()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = ""))
})
# Valeurs de référence victimes ####
## ZC
zc_txt_att_base_ref <- reactive({
tmp <- aggregate(data = constetref(), nb_vict ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "1_ZC")
tmp2
})
zc_txt_att_nb_ref <- reactive({
tmp2 <- zc_txt_att_base_ref()
paste(tmp2[nrow(tmp2),3]," attaques en zone coeur en ",tmp2[nrow(tmp2),1],sep = "")
})
zc_txt_att_evol_ref <- reactive({
tmp2 <- zc_txt_att_base_ref()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = "")
)
})
## AA
aa_txt_att_base_ref <- reactive({
tmp <- aggregate(data = constetref(), nb_vict ~ annee + type,sum)
tmp2 <- dplyr::filter(tmp, type == "2_AA")
tmp2
})
aa_txt_att_evol_ref <- reactive({
tmp2 <- aa_txt_att_base_ref()
paste(tmp2[nrow(tmp2),3]," attaques en aire d'adhésion en ",tmp2[nrow(tmp2),1],sep = "")
})
aa_txt_att_nb_ref <- reactive({
tmp2 <- aa_txt_att_base_ref()
test <- 1-(tmp2[nrow(tmp2)-1,3]/tmp2[nrow(tmp2),3])
ifelse(
test = test>0,
yes = paste("augmentation de ",abs(round(test*100,2)),"%", sep = ""),
no = paste("diminution de ",abs(round(test*100,2)),"%", sep = ""))
})
# Evolution nb_attaques####
output$barplot_att_tot <- renderPlot({
ggplot(
data = constetref(),
aes(
x = as.character(annee),
y = attaque,
fill = type)
) +
geom_bar(position = "stack", stat = "identity") +
xlab("Année") +
ylab("Nombre d'attaques") +
scale_fill_manual(
name = "Localisation des attaques",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 45, hjust = 1)
)
})
# Evolution nb_victimes####
output$barplot_vict_tot <- renderPlot({
ggplot(
data = constetref(),
aes(
x = as.character(annee),
y = nb_vict,
fill = type)
) +
geom_bar(position = "stack", stat = "identity") +
xlab("Année") +
ylab("Nombre de victimes") +
scale_fill_manual(
name = "Localisation des victimes",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 45, hjust = 1)
)
})
# Données Comparaison intercommunale ####
comp_intercom <- reactive({
dplyr::filter(
constetref(),
type != "3_DPT" & annee >= lubridate::year(d_sel_min_ref())
)
})
# Barplot att_com ####
output$barplot_att_com <- renderPlot({
data <- comp_intercom()
tmp <- aggregate(data = data, attaque ~ commune + type + annee, sum)
ggplot(
data = tmp,
aes(x = commune, y = attaque, fill = type )) +
geom_col(position = "stack") +
xlab("Communes") +
ylab("Nombre d'attaques") +
scale_fill_manual(
name = "Localisation des attaques",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
facet_grid(annee ~ .) +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1),
strip.text.y = element_text(size = 15)
)
},height = 750)
# Barplot vict_com ####
output$barplot_vict_com <- renderPlot({
data <- comp_intercom()
tmp <- aggregate(data = data, nb_vict ~ commune + type + annee, sum)
ggplot(
data = tmp,
aes(x = commune, y = nb_vict, fill = type )) +
geom_col(position = "stack") +
xlab("Communes") +
ylab("Nombre de victimes") +
scale_fill_manual(
name = "Localisation des victimes",
values = c("red","forestgreen","grey"),
labels = c("Zone coeur", "Aire d'adhésion", "Département(s)"))+
facet_grid(annee ~ .) +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1),
strip.text.y = element_text(size = 15)
)
}, height = 750)
# Map att_com ####
output$map_att_com <- renderPlot({
Parc_area <- Parc_area()
tmp <- aggregate(
data = dplyr::filter(
constat(),
type != "3_DPT"),
attaque ~ insee,
sum)
tmp2 <- dplyr::left_join(tmp, area_com, by = "insee")
tmp2 <- sf::st_as_sf(tmp2)
ggplot() +
geom_sf(
data = tmp2,
aes(fill = attaque)
) +
geom_sf(
data = Parc_area[2,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1.5) +
geom_sf(
data = Parc_area[1,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1,
linetype = "dashed") +
scale_fill_gradient(name = "Nombre de victimes par communes" ,low = "lightgrey", high = "red") +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1)
)
}, height = 750)
# Map vict_com ####
output$map_vict_com <- renderPlot({
Parc_area <- Parc_area()
tmp <- aggregate(
data = dplyr::filter(
constat(),
type != "3_DPT"),
nb_vict ~ insee,
sum)
tmp2 <- dplyr::left_join(tmp, area_com, by = "insee")
tmp2 <- sf::st_as_sf(tmp2)
ggplot() +
geom_sf(
data = tmp2,
aes(fill = nb_vict)
) +
geom_sf(
data = Parc_area[2,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1.5) +
geom_sf(
data = Parc_area[1,],
col = data_parc$col[data_parc$nom == input$Parc],
fill = NA,
size = 1,
linetype = "dashed") +
scale_fill_gradient(name = "Nombre de victimes par communes" ,low = "lightgrey", high = "red") +
theme(
panel.background = element_blank(),
panel.grid.major = element_line(linetype = "dashed", colour = "black"),
legend.position = "top",
legend.direction = "horizontal",
legend.text = element_text(size = 15),
legend.title = element_text(size = 18),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18),
axis.text.x = element_text(angle = 60, hjust = 1)
)
}, height = 750)
# Rapport téléchargeable ####
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = "report.pdf",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "Presentation.Rmd")
file.copy("Presentation.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(
area_com = area_com,
Parc = input$Parc,
d_sel_min = input$d_sel_min,
d_sel_max = input$d_sel_max,
constat = constat(),
Parc_area = Parc_area(),
constetref = constetref(),
comp_intercom = comp_intercom()
)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
#####
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.