inst/shiny-apps/visu-summary/server.R

In remymoine/PTS-R-package: Reshape and Parameters for Time Series analyses

library(ggplot2)
library(plotly)
library(RPTS)
library(cowplot)
library(lubridate)
library(shiny)

server <-function(input, output) {


  # Mise en forme des données chargées par le lien
  dataInput<-reactive({

    req(input$file, input$sep, input$Dcol, input$Pcol, input$tz, input$order,input$skip)

    f<-as.character(input$file$datapath)

    data<-time_rawshape(file=f,
                        sep=input$sep,
                        skip=input$skip,
                        Dcol=input$Dcol,
                        Pcol=input$Pcol,
                        tz=input$tz,
                        order=input$order)
    data
  })

  # Download

  output$downloadtable<-downloadHandler(
    filename = function() {paste(input$table_name, ".csv", sep="")},
    content = function(file) {write.table(dataInput(), file ,sep=";",dec=".")})


  # Affichage des données mises en forme
  tab<-reactive({
    data<-dataInput()
    tab<-as.data.frame(data)
    tab$Dates<-as.character(tab$Dates)
    tab})

  output$rawshape <- renderDataTable({tab()},options = list(pageLength = 10))

  # Résumé des données temporelles

  # Aggrégation mensuelle
  Agm <- reactive({
    data<-dataInput()
    tmp<-time_agpar(data,Dcol=1,Pcol=2,resolution="month")
    tmp
  })

  # Aggrégation annuelle
  Agy <- reactive({
    data<-dataInput()
    tmp<-time_agpar(data,Dcol=1,Pcol=2,resolution="year")
    tmp
  })

  # Aggrégation journalière
  Agd <- reactive({
    data<-dataInput()
    tmp<-time_agpar(data,Dcol=1,Pcol=2,resolution="day")
    tmp
  })

  # Graphique de l'aggrégation Journalière
  output$graphagd<-renderPlotly({

    Agd<-Agd()
    Agd$Date<-as.POSIXct(Agd$Date,tz="UTC")

    plot1<-ggplot(Agd,aes(x=Date,y=Av,group=1))+
      geom_ribbon(aes(ymin=Mi,ymax=Ma),alpha=0.5,col="grey")+
      geom_ribbon(aes(ymin=Q1,ymax=Q3),alpha=0.5,fill="blue")+
      geom_line()+
      scale_x_datetime(date_breaks = "1 month")+
      xlab("Dates")+
      ylab("Températures Journalières (°C)")+
      theme(axis.text.x = element_text(angle=45,hjust=1),
            axis.text.y = element_text(face="bold"),
            panel.background = element_rect(fill="white"),
            panel.grid.major.x = element_line(color="grey"),
            panel.grid.major.y = element_line(color="grey"))

    plot1<-ggplotly(plot1)
    plot1
  })

  # Graphique de l'aggrégation Mensuelle
  output$graphagm<-renderPlotly({

    Agm<-Agm()
    Agm$Date<-as.POSIXct(Agm$Date,tz="UTC")

    plot1<-ggplot(Agm,aes(x=Date,y=Av,group=1))+
      geom_ribbon(aes(ymin=Mi,ymax=Ma),alpha=0.5,col="grey")+
      geom_ribbon(aes(ymin=Q1,ymax=Q3),alpha=0.5,fill="blue")+
      geom_line()+
      scale_x_datetime(date_breaks = "1 month")+
      xlab("Dates")+
      ylab("Températures Mensuelles (°C)")+
      theme(axis.text.x = element_text(angle=45,hjust=1),
            axis.text.y = element_text(face="bold"),
            panel.background = element_rect(fill="white"),
            panel.grid.major.x = element_line(color="grey"),
            panel.grid.major.y = element_line(color="grey"))

    plot1<-ggplotly(plot1)
    plot1
  })



  # Graphique de l'aggrégation journalière inter-annuelle
  output$graphagdxy<-renderPlotly({

    Agd<-Agd()

    plot1<-ggplot(Agd,aes(x=Day,y=Av))+
      geom_ribbon(aes(ymin=Mi,ymax=Ma,fill=as.factor(Year)),alpha=0.25)+
      geom_line(linetype="dashed",aes(y=Q1,col=as.factor(Year)))+
      geom_line(linetype="dashed",aes(y=Q3,col=as.factor(Year)))+
      geom_line(linetype="solid",aes(col=as.factor(Year)))+
      scale_x_discrete(limits=as.integer(seq(0,365,10)))+
      scale_fill_brewer(palette="Set1")+
      scale_color_brewer(palette="Set1")+
      xlab("Jours Juliens")+
      ylab("Températures Journalières (°C)")+
      theme(axis.text.x = element_text(angle=45,hjust=1),
            axis.text.y = element_text(face="bold"),
            panel.background = element_rect(fill="white"),
            panel.grid.major.x = element_line(color="grey"),
            panel.grid.minor.x = element_line(color="grey"),
            panel.grid.major.y = element_line(color="grey"),
            legend.position='b')

    plot<-ggplotly(plot1)%>%layout(legend = list(orientation= 'h',y=-0.1))
    plot
  })

  # Graphique de l'aggrégation Mensuelle inter-annuelle
  output$graphagmxy<-renderPlotly({

    Agm<-Agm()
    plot1<-ggplot(Agm,aes(x=Month,y=Av))+
      geom_ribbon(aes(ymin=Mi,ymax=Ma,fill=as.factor(Year)),alpha=0.25)+
      geom_line(linetype="dashed",aes(y=Q1,col=as.factor(Year)))+
      geom_line(linetype="dashed",aes(y=Q3,col=as.factor(Year)))+
      geom_line(linetype="solid",aes(col=as.factor(Year)))+
      scale_fill_brewer(palette="Set1")+
      scale_color_brewer(palette="Set1")+
      scale_x_discrete(limits=as.integer(c(1:12)))+
      xlab("Mois")+
      ylab("Températures Journalières (°C)")+
      theme(axis.text.x = element_text(angle=45,hjust=1),
            axis.text.y = element_text(face="bold"),
            panel.background = element_rect(fill="white"),
            panel.grid.major.x = element_line(color="grey"),
            panel.grid.minor.x = element_line(color="grey"),
            panel.grid.major.y = element_line(color="grey"),
            legend.position='b')

    plot<-ggplotly(plot1)%>%layout(legend = list(orientation= 'h',y=-0.1))
    plot
  })



# GFDD calcul

  GFDD<-reactive({
    Agd<-Agd()
    gfdd<-temp_gfdd(Agd,Dcol=1,Pcol="Av",
                    start=as.character(input$dategdd[1]),end=as.character(input$dategdd[2]),
                    igt = input$igt , sft=input$sft)
    gfdd
  })

  #Graphiques des GDD
  output$graphgdd<-renderPlotly({
    gfdd<-GFDD()
    plot<-ggplot(gfdd,aes(x=Date,y=GDD)) + geom_line(col="red")
    plot
    })

  #Graphiques des FDD
  output$graphfdd<-renderPlotly({
    gfdd<-GFDD()
    plot<-ggplot(gfdd,aes(x=Date,y=FDD)) + geom_line(col="blue")

    plot
  })


}