`[> `> > `library(shiny)
library(shinyWidgets)
library(leaflet)
library(tidyverse)
library(lubridate)
library(shinybusy)
library(readr)
nom_lien <- function(id_station, annee){
df_stations <- read_rds("df_stations.rds")
j = which(df_stations$id == id_station)
nom <- paste(df_stations$name.en[j], annee)
print(id_station)
print(annee)
return(nom)
> > > > }
ui <- bootstrapPage(
> > > > ##---------------------------------------------------------------
Interface --
> > > > ##---------------------------------------------F------------------
add_busy_spinner(spin = "radar", margins = c(10, 20)), # Logo de chargement
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"), # Carte
absolutePanel(id='nomappli',top = 0, left=70,img(src = 'EDFMeteostat.png',height = 68.35, width = 397.5),
downloadButton("dl_aide", "Aide"),
downloadButton("dl_rapport", "Rapport Ms-Pro")),# Logo
absolutePanel(id='parametres',class='panel panel-default' ,top = 10, right = 10, # Panneau au premier plan par dessus la carte
width = "auto", fixed = TRUE, draggable = TRUE,
p(),
p(strong("Extraction de données météos au pas horaire")),
pickerInput("pays", label = "Pays", # Menu déroulant sélection pays
choices = df_conversion_ISO_dispo[[3]],
selected = "France Metropole - FR Metro", #sélection par défaut france métropole
> > > > #multiple = TRUE,
options = list(`live-search` = TRUE)),
checkboxInput("chexkbox_recent", label = "Avec anciennes stations (arretées depuis plus d'un an)", value = FALSE), #choix données récentes
pickerInput("annee", label = "Choix d'année d'extraction",
choices = c(year(Sys.Date()),
year(Sys.Date() %m-% years(1)),
year(Sys.Date() %m-% years(2)),
year(Sys.Date() %m-% years(3)),
year(Sys.Date() %m-% years(4)),
year(Sys.Date() %m-% years(5)),
year(Sys.Date() %m-% years(6)),
year(Sys.Date() %m-% years(7)),
year(Sys.Date() %m-% years(8)),
year(Sys.Date() %m-% years(9)),
year(Sys.Date() %m-% years(10)),
year(Sys.Date() %m-% years(11)),
year(Sys.Date() %m-% years(12)),
year(Sys.Date() %m-% years(13)),
year(Sys.Date() %m-% years(14)),
year(Sys.Date() %m-% years(15)),
year(Sys.Date() %m-% years(16)),
year(Sys.Date() %m-% years(17)),
year(Sys.Date() %m-% years(18)),
year(Sys.Date() %m-% years(19)),
year(Sys.Date() %m-% years(20)),
year(Sys.Date() %m-% years(21)),
year(Sys.Date() %m-% years(22))
> > > > ),
selected = year(Sys.Date() %m-% years(1))
> > > > ),
p(),
p(strong('Calcul des DJU :')),
sliderInput("slider_chauf", label = "Température de consigne chauffage (°C)", min = 15, max = 25, value = 18),
sliderInput("slider_clim", label = "Température de consigne climatisation (°C)", min = 15, max = 25, value = 18),
actionButton("export", label = "Exporter"),
p(),
> > > > )
> > > > )
server <- function(input, output, session) { # -------------SERVER------------------------------------------
function(fichier_meteo,id_station,annee){
> > > > ##---------------------------------------------------------------
Fonction extraction des données --
> > > > ##---------------------------------------------------------------
Objectif :
renvoyer vers l'application principale les données utilisés pour générer les fichiers excel
df_stations <- read_rds("df_stations.rds")
date_debut <- as.Date(paste(annee, '-01-01', sep = ''))
date_fin <- as.Date(paste(annee, '-12-31', sep = ''))
df_meteo <- fichier_meteo
colnames(df_meteo) <- c('Date_', 'Heure', 'Temp','dwp','HR','prcp','neige','dirvt','vitvt','maxvt','patm','tsoleil','coco')
ligne_station = which(df_stations[[1]]==id_station) # positionnement de la station dans le fichier id_station
df_meteo <- filter(df_meteo,Date_ >= date_debut, Date_<= date_fin) #filtration entre date début et fin
> > > > #mise de l'heure dans la date
dt_dates <- data.frame(as.POSIXct(paste(type.convert(df_meteo[[1]], as.is = TRUE),type.convert(df_meteo[[2]], as.is = TRUE), ":00", sep=""), format="%Y-%m-%d %H:%M", tz="UTC"))
> > > > #Changement de la date en date locale
dt_dates[[2]] <- lubridate::with_tz(dt_dates[[1]], tzone = df_stations[ligne_station,4])
df_meteo$Date_ <- dt_dates[[1]]
df_meteo$Heure <- dt_dates[[2]]
colnames(df_meteo)<-c('Date_UTC', 'Date_Locale', 'Temp(deg C)','pt_rosee(deg C)','HR(%)','precipitations(mm)','neige(mm)','dirvt(degre)','vitvt(km/h)','maxvt(km/m)','Patm alt=0 (hPa)','tsoleil(min)','code_condition_meteo')
saveRDS(df_meteo, 'df_meteo_Angers_2018_8564lignes.rds')
list_verif <- verif_fichier(df_meteo, annee, df_stations[ligne_station,4]) # Appel de la verification du fichier
df_meteo <- list_verif[[1]]
> > > > ##----------------------------------------------------------------
FICHIER OPRO --
> > > > ##----------------------------------------------------------------
df_opro <- data.frame(df_meteo$Date_Locale,df_meteo$Temp,df_meteo$HR,df_meteo$vitvt)
> > > > ##--------------------------------------------------------------------
creation des noms fichiers en fonction des stations pays dates --
> > > > ##--------------------------------------------------------------------
j=which(df_stations$id == id_station)
nom_fichier <- paste('Meteo_OPro_',df_stations$name.en[j],'_',df_stations$country[j],'_',type.convert(format(date_debut,'%d-%m-%y'),as.is = TRUE),'_',type.convert(format(date_fin,'%d-%m-%y'), as.is=TRUE),'.xlsx', sep='')
nom_fichier_tout <- paste('Meteo_tout_',df_stations$name.en[j],'_',df_stations$country[j],'_',type.convert(format(date_debut,'%d-%m-%y'),as.is = TRUE),'_',type.convert(format(date_fin,'%d-%m-%y'), as.is=TRUE),'.xlsx', sep='')
nom_fichier <- paste('Meteo_OPro_',df_stations$name.en[j],'_',df_stations$country[j],'_',annee,'.csv', sep='')
nom_fichier_tout <- paste('Meteo_tout_',df_stations$name.en[j],'_',df_stations$country[j],'_',annee,'.csv', sep='')
nom_fichier_changements <- paste('Valeurs_meteos_dupliquees_',df_stations$name.en[j],'_',df_stations$country[j],'_',annee,'.csv', sep='')
> > > > #Réectriture du fichier meteo avec les deux premières colonnes date UTC et date locale
df_meteo$Date_Locale <- lubridate::with_tz(df_meteo$Date_UTC, tzone = df_stations[ligne_station,4])
df_meteo$Date_UTC <- force_tz(df_meteo$Date_UTC, tzone = Sys.timezone()) #Forcage du changement de fuseau horaire pour qu'il n'y ai pas d'autoconversion dans le fichier excel
df_meteo$Date_Locale <- force_tz(df_meteo$Date_Locale, tzone = Sys.timezone())
return(list(nom_fichier,nom_fichier_tout,df_opro,df_meteo,list_verif,nom_fichier_changements))
> > > > }
> > > > #maj_stations()
valeurs <- reactiveValues() #liste pour mettre en mémoire des variables "globales"
> > > > ##------------------------------------------------------------------------
Filtration des stations à afficher en fonction du pays sélectionné --
> > > > ##------------------------------------------------------------------------
filteredData <- reactive({
df_filtr_stations <- df_stations
if (input$chexkbox_recent == FALSE){ # case à cocher si données < à 1 an
df_filtr_stations <- filter(df_filtr_stations , inventory.hourly.end >Sys.Date() %m-% years(1))
> > > > }
if (input$pays == 'France Metropole - FR Metro'){ # Centrage sur la france
filter(df_filtr_stations , country == 'FR', timezone == 'Europe/Paris')
else {
l<-which(df_conversion_ISO_dispo[[3]]==input$pays) # Prend la ligne qui correspond au pays choisi
filter(df_filtr_stations, country == df_conversion_ISO_dispo[l,2]) #Filtration en fonction du code ISO du pays
return(filter(df_filtr_stations, country == df_conversion_ISO_dispo[l,2])) #Filtration en fonction du code ISO du pays
> > > > }
> > > > })
> > > > ##---------------------------------------------------------------
Click station --
> > > > ##---------------------------------------------------------------
observe({ #Stockage de l'identifiant d'une station dans la liste "valeurs" quand l'utilisateur clique sur un marker
click<-input$map_marker_click
if(is.null(click))
return()
valeurs$id <- click$id
> > > > })
> > > > ##---------------------------------------------------------------
CARTE --
> > > > ##---------------------------------------------------------------
> > > > #Affichage de la carte
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng = 2.2137, lat = 46.2276, zoom = 6) %>% # Centrage sur la France
addMarkers(data = stations,
lng = ~location.longitude,
lat = ~location.latitude,
label = ~name.en,
popup = ~popuptext,
layerId = ~id)
> > > > })
Chargement du fichier meteo --
data_meteo <- reactive({
inFile <- input$file
if (is.null(inFile)){
return(NULL)
> > > > }
print(paste("Chemin du fichier sélectionné :", inFile$datapath)) # Affiche le chemin du fichier sélectionné
df_meteo <- fread(inFile$datapath)
print("Le fichier a été lu avec succès.") # Vérifie si le fichier a été lu correctement
> > > > #return(df_meteo)
> > > > #saveRDS(df_meteo,'df_meteo_test_tl_fichier.rds')
return(df_meteo)
> > > > })
> > > > ##----------------------------------------------------------------
Click du bouton "exporter" --
> > > > ##----------------------------------------------------------------
observeEvent(input$export, {
if (is.null(valeurs$id)){ #message d'erreur si exporter sans avoir sélectionné de station
showModal(modalDialog(
> > > > "Pas de station sélectionnée, cliquez sur une station pour la sélectionner.",
footer = modalButton("Retour"),
> > > > ))
return()
> > > > }
showModal(modalDialog(
title = NULL,
p(strong("1 - Cliquer sur ce lien :",
tags$a(href = nom_lien(valeurs$id, input$annee), paste(nom_lien(valeurs$id, input$annee))),
> > > > )),
p("2 - Si le lien n'a pas fonctionné, copiez le lien dans votre navigateur internet"),
p("Exemple nom : melun-2021-07153.csv.gz "),
p(a(nom_lien(valeurs$id,input$annee), href= paste("https://bulk.meteostat.net/v2/hourly/",input$annee,"/",valeurs$id,".csv.gz", sep=""), target="_blank")),
p(strong("3 - Cliquer sur 'Parcourir' et sélectionner le fichier tout juste téléchargé")),
fileInput("file", label = NULL, buttonLabel = 'Parcourir', accept = ".csv.gz"),
p(strong('4 - Cliquer sur "Lancer le traitement"')),
actionButton('actionbutton_analyse','Lancer le traitement'),
footer = modalButton("Retour"),
p(),
p("Conseil : Supprimer le fichier téléchargé après l'exportation")
> > > > ))
Appel de la fonction extraction à l'intérieur de observeEvent
resultats_extraction <- extraction(data_meteo(), valeurs$id, input$annee)
Affichage des résultats
nom_fichier <- resultats_extraction[[1]]
nom_fichier_tout <- resultats_extraction[[2]]
df_opro <- resultats_extraction[[3]]
df_meteo <- resultats_extraction[[4]]
list_verif <- resultats_extraction[[5]]
nom_fichier_changements <- resultats_extraction[[6]]
Vérification des résultats
print(nom_fichier)
print(nom_fichier_tout)
print(head(df_opro))
print(head(df_meteo))
print(list_verif)
print(nom_fichier_changements)
> > > > })
> > > > }
> > > > ##----------------------------------------------------------------
Lancement de l'application --
> > > > ##----------------------------------------------------------------
shinyApp(ui = ui, server = server)
> > > `
**when I click on the link generated by the application, it displays 'not found.' It seems that the link is not leading to the expected destination or resource. I'm encountering this issue and need assistance in troubleshooting and resolving it****`