R/shiny_oursins.R

Defines functions shiny_oursins

Documented in shiny_oursins

shiny_oursins <-
function(data,fondMaille,fondContour,fondSuppl=NULL,idDataDepart,idDataArrivee,varFlux,decalageAllerRetour=0,decalageCentroid=0,emprise="FRM",fondEtranger=NULL)
  {
    options("stringsAsFactors"=FALSE)

    # Verification des parametres
    msg_error1<-msg_error2<-msg_error3<-msg_error4<-msg_error5<-msg_error6<-msg_error7<-msg_error8<-msg_error9<-msg_error10<-msg_error11<-msg_error12<-msg_error13<-msg_error14<-msg_error15<-msg_error16<-msg_error17<-msg_error18<-msg_error19<-msg_error20 <- NULL

    if(any(class(data)!="data.frame")) msg_error1 <- "Les donnees doivent etre dans un data.frame / "
    if(any(!any(class(fondMaille) %in% "sf"),!any(class(fondMaille) %in% "data.frame"))) msg_error2 <- "Le fond de maille doit etre un objet sf / "
    if(any(!any(class(fondContour) %in% "sf"),!any(class(fondContour) %in% "data.frame"))) msg_error3 <- "Le fond de contour doit etre un objet sf / "
    if(!is.null(fondSuppl)) if(any(!any(class(fondSuppl) %in% "sf"),!any(class(fondSuppl) %in% "data.frame"))) msg_error4 <- "Le fond supplementaire doit etre un objet sf / "
    if(any(class(idDataDepart)!="character")) msg_error5 <- "Le nom de la variable de depart doit etre de type caractere / "
    if(any(class(idDataArrivee)!="character")) msg_error6 <- "Le nom de la variable d'arrivee doit etre de type caractere / "
    if(any(class(varFlux)!="character")) msg_error7 <- "Le nom de la variable doit etre de type caractere / "
    if(any(class(decalageAllerRetour)!="numeric")) msg_error8 <- "La variable decalageAllerRetour doit etre de type numerique / "
    if(any(class(decalageCentroid)!="numeric")) msg_error9 <- "La variable decalageCentroid doit etre de type numerique / "
    if(any(class(emprise)!="character")) msg_error10 <- "La valeur doit etre de type caractere ('FRM', '971', '972', '973', '974', '976' ou '999') / "

    if(length(names(data))<3) msg_error11 <- "Le tableau des donnees n'est pas conforme. Il doit contenir au minimum une variable identifiant de depart, une variable identifiant d'arrivee et la variable a representer / "
    if(length(names(fondMaille))<3) msg_error12 <- "Le fond de maille n'est pas conforme. La table doit contenir au minimum une variable identifiant, une variable libelle et la geometry / "
    if(length(names(fondContour))<3) msg_error13 <- "Le fond de contour n'est pas conforme. La table doit contenir au minimum une variable identifiant, une variable libelle et la geometry / "
    if(!is.null(fondSuppl)) if(length(names(fondSuppl))<3) msg_error14 <- "Le fond supplementaire n'est pas conforme. La table doit contenir au minimum une variable identifiant, une variable libelle et la geometry / "

    if(!any(names(data) %in% idDataDepart))  msg_error15 <- "La variable identifiant de depart n'existe pas dans la table des donnees / "
    if(!any(names(data) %in% idDataArrivee))  msg_error16 <- "La variable identifiant d'arrivee n'existe pas dans la table des donnees / "
    if(!any(names(data) %in% varFlux))  msg_error17 <- "La variable a representer n'existe pas dans la table des donnees / "
    if(!emprise %in% c("FRM","971","972","973","974","976","999")) msg_error18 <- "La variable emprise doit etre 'FRM', '971', '972', '973', '974', '976' ou '999' / "
    if(!is.null(fondEtranger)) if(any(!any(class(fondEtranger) %in% "sf"),!any(class(fondEtranger) %in% "data.frame"))) msg_error19 <- "Le fond etranger doit etre un objet sf / "
    if(!is.null(fondEtranger)) if(length(names(fondEtranger))<3) msg_error20 <- "Le fond etranger n'est pas conforme. La table doit contenir au minimum une variable identifiant, une variable libelle et la geometry / "

    if(any(!is.null(msg_error1),!is.null(msg_error2),!is.null(msg_error3),!is.null(msg_error4),
           !is.null(msg_error5),!is.null(msg_error6),!is.null(msg_error7),!is.null(msg_error8),
           !is.null(msg_error10),!is.null(msg_error11),!is.null(msg_error12),!is.null(msg_error13),
           !is.null(msg_error14),!is.null(msg_error15),!is.null(msg_error16),!is.null(msg_error17),
           !is.null(msg_error18),!is.null(msg_error19),!is.null(msg_error20)))
    {
      stop(simpleError(paste0(msg_error1,msg_error2,msg_error3,msg_error4,msg_error5,msg_error6,msg_error7,msg_error8,
                              msg_error10,msg_error11,msg_error12,msg_error13,msg_error14,msg_error15,msg_error16,msg_error17,msg_error18,msg_error19,msg_error20)))
    }

    nb_up <- reactiveValues(a=0)
    nb_down <- reactiveValues(a=0)
    ordre_analyse <- reactiveValues(a=1,b=2)
    insert_save <- reactiveValues(a=0)
    remove_carte <- reactiveValues(a=0)
    liste_fonds <- reactiveValues(a=c("analyse","maille","contour"))
    m_save_ou <- reactiveValues(a=0)

    flux_min <- reactiveValues(a=100)
    distance_max <- reactiveValues(a=300)
    flux_majeur <- reactiveValues(a=10)

    erreur_maille <- reactiveValues(a=FALSE)

    sourc <- "Source : Insee"

    names(data)[names(data)==idDataDepart] <- "CODE1"
    names(data)[names(data)==idDataArrivee] <- "CODE2"
    names(fondMaille)[1] <- "CODE"
    names(fondMaille)[2] <- "LIBELLE"
    names(fondContour)[1] <- "CODE"
    names(fondContour)[2] <- "LIBELLE"
    epsg_etranger <- NULL
    if(!is.null(fondEtranger))
    {
      names(fondEtranger)[1] <- "CODE"
      names(fondEtranger)[2] <- "LIBGEO"
      if(any(Encoding(fondEtranger$LIBGEO) %in% "latin1")){
        fondEtranger$LIBGEO<-iconv(fondEtranger$LIBGEO,"latin1","UTF-8")
      }

      if(substr(st_crs(fondEtranger)[1]$input,1,5) == "EPSG:")
      {
        epsg_etranger <- substr(st_crs(fondEtranger)[1]$input,6,9)
      }else
      {
        epsg_etranger <- st_crs(fondEtranger)[1]$input
      }

      if(is.na(epsg_etranger) | epsg_etranger=="4326")
      {
        epsg_etranger <- "3395" # Mercator
      }
    }
    if(!is.null(fondSuppl))
    {
      names(fondSuppl)[1] <- "CODE"
      names(fondSuppl)[2] <- "LIBELLE"
      if(any(Encoding(fondSuppl$LIBELLE) %in% "latin1")){
        fondSuppl$LIBELLE<-iconv(fondSuppl$LIBELLE,"latin1","UTF-8")
      }
    }

    if(any(Encoding(fondMaille$LIBELLE) %in% "latin1")){
      fondMaille$LIBELLE<-iconv(fondMaille$LIBELLE,"latin1","UTF-8")
    }
    if(any(Encoding(fondContour$LIBELLE) %in% "latin1")){
      fondContour$LIBELLE<-iconv(fondContour$LIBELLE,"latin1","UTF-8")
    }

    ui <- navbarPage("OCEANIS", id="menu",

                     theme = shinytheme("superhero"),

                     tabPanel("Carte",value="carte",
                              sidebarLayout(

                                sidebarPanel(width = 3,
                                             style = "overflow-y:scroll; min-height: 1000px; max-height: 1000px",
                                             h4(HTML("<b><font color=#95BAE2>VARIABLES</font></b>")),
                                             uiOutput("variable_flux_ou"),
                                             tags$hr(style="border: 5px solid #5182B6"), #337ab7
                                             h4(HTML("<b><font color=#95BAE2>FONDS</font></b>")),
                                             fluidRow(
                                               column(width=9, offset=0.5,
                                                      uiOutput("ordre_fonds_ou")
                                               ),
                                               column(width=1,
                                                      br(),
                                                      br(),
                                                      htmlOutput("monter_fond_ou", inline=FALSE),
                                                      htmlOutput("descendre_fond_ou", inline=FALSE)
                                               )
                                             ),
                                             uiOutput("ajout_territoire_ou"),
                                             uiOutput("ajout_reg_ou"),
                                             uiOutput("ajout_dep_ou"),
                                             tags$hr(style="border: 5px solid #5182B6"),
                                             h4(HTML("<b><font color=#95BAE2>FLUX</font></b>")),
                                             uiOutput("flux_min_ou"),
                                             uiOutput("distance_max_ou"),
                                             uiOutput("flux_majeur_ou"),
                                             uiOutput("epaisseur_trait_ou"),
                                             uiOutput("decalage_aller_retour_ou"),
                                             uiOutput("decalage_centroid_ou"),
                                             tags$hr(style="border: 5px solid #5182B6"),
                                             h4(HTML("<b><font color=#95BAE2>SAUVEGARDE</font></b>")),
                                             uiOutput("save_carte_ou"),
                                             br(),
                                             tags$div(class="dropup",
                                                      HTML('<button class="btn btn-primary dropdown-toggle" type="button" data-toggle="dropdown" aria-haspopup="true" aria-expanded="false">
                                                           Exporter en projet Qgis
                                                           <span class="caret"></span>
                                                           </button>'),
                                                      tags$ul(class="dropdown-menu",
                                                              wellPanel(
                                                                style="background: #2B3E50; width:340px",
                                                                h4("Export de la carte en projet Qgis"),
                                                                br(),
                                                                uiOutput("sortie_qgis_ou"),
                                                                br(),
                                                                uiOutput("titre1_qgis_ou"),
                                                                uiOutput("titre2_qgis_ou"),
                                                                uiOutput("source_qgis_ou"),
                                                                tags$head(tags$style(HTML('#export_qgis_ou_id{background-color:#337ab7}'))),
                                                                uiOutput("export_qgis_ou")
                                                              )
                                                      )
                                                      ),
                                             br(),
                                             uiOutput("aide_image_ou"),
                                             br()
                                ),
                                mainPanel(
                                  tags$head(
                                    tags$style(HTML(".leaflet-container { background: #AFC9E0; }"))
                                  ),
                                  tabsetPanel(id="onglets_ou",
                                              tabPanel(title=HTML("<b>Carte</b>"),value="carte",
                                                       leafletOutput("mymap_ou",width="112%",height = 950)
                                              ),
                                              tabPanel(title=HTML(paste0("<b>Donn","\u00e9","es</b>")),value="donnees",
                                                       h5("S\u00e9lectionnez une ou plusieurs lignes pour ensuite les visualiser sur la carte."),
                                                       DT::dataTableOutput("mydonnees_ou",width="112%",height = 950)),
                                              tabPanel(title=HTML("<b>Maille</b>"),value="maille",
                                                       h5("S\u00e9lectionnez une ou plusieurs lignes pour ensuite les visualiser sur la carte."),
                                                       DT::dataTableOutput("mymaille_ou",width="112%",height = 950)),
                                              tabPanel(title=HTML("<b>Contour</b>"),value="contour",
                                                       h5("S\u00e9lectionnez une ou plusieurs lignes pour ensuite les visualiser sur la carte."),
                                                       DT::dataTableOutput("mycontour_ou",width="112%",height = 950))
                                  )
                                )
                     )
                     )
                     )

    server <- function(input, output, session) {

      #################
      #Onglet Carte
      #################

      #Charge les donnees et fonds en memoire et affiche les widgets adequats dans le sidePanel de l'onglet "Carte"
      observe({

        # VARIABLES

        output$variable_flux_ou <- renderUI({
          selectInput("variable_flux_ou_id", label=h5("Variable des flux (en volume)"), choices = varFlux, selected = varFlux)
        })

        # FONDS

        output$ordre_fonds_ou <- renderUI({
          selectInput("ordre_fonds_ou_id", label=h5("Modifier l'ordre des fonds"), choices = liste_fonds$a, multiple=TRUE, selectize=FALSE, selected = "analyse")
        })
        output$monter_fond_ou <- renderUI({
          actionButton("monter_fond_ou_id", label="", icon=icon("arrow-up"))
        })
        output$descendre_fond_ou <- renderUI({
          actionButton("descendre_fond_ou_id", label="", icon=icon("arrow-down"))
        })

        output$ajout_territoire_ou <- renderUI({
          checkboxInput("ajout_territoire_ou_id", label = "Afficher le fond des territoires",
                        value = if(is.null(fondSuppl)) FALSE else TRUE)
        })
        output$ajout_reg_ou <- renderUI({
          checkboxInput("ajout_reg_ou_id", label = "Afficher le fond des r\u00e9gions",
                        value = FALSE)
        })
        output$ajout_dep_ou <- renderUI({
          checkboxInput("ajout_dep_ou_id", label = "Afficher le fond des d\u00e9partements",
                        value = FALSE)
        })

        # FLUX

        output$flux_min_ou <- renderUI({
          numericInput("flux_min_ou_id", label = h5("Seuil de flux minimal"), value=flux_min$a, step=10)
        })

        output$distance_max_ou <- renderUI({
          numericInput("distance_max_ou_id", label = h5("Seuil de distance maximale (km)"), value=distance_max$a, step=10)
        })

        output$flux_majeur_ou <- renderUI({
          numericInput("flux_majeur_ou_id", label = h5("Nombre de flux majeurs"), value=flux_majeur$a, step=1)
        })

        output$epaisseur_trait_ou <- renderUI({
          sliderInput("epaisseur_trait_ou_id", label = h5(paste0("Epaisseur des traits")), value=2, min=1, max=5, step=1, ticks = TRUE)
        })

        output$decalage_aller_retour_ou <- renderUI({
          numericInput("decalage_aller_retour_ou_id", label = h5(paste0("D","\u00e9","calage des lignes allers-retours (km)")), value=decalageAllerRetour, step=1)
        })

        output$decalage_centroid_ou <- renderUI({
          numericInput("decalage_centroid_ou_id", label = h5(paste0("D","\u00e9","calage des lignes du centroid (km)")), value=decalageCentroid, step=1)
        })

        # SAUVEGARDE

        output$save_carte_ou <- renderUI({
          actionButton("save_carte_ou_id", label=HTML("<font size=3>Sauvegarder la carte dans un onglet</font>"), style="color:#FFFFFF; background-color:#DF691A")
        })

        output$entrees_qgis_ou <- renderUI({
          actionButton("entrees_qgis_ou_id", label="Exporter en projet Qgis")
        })

        output$sortie_qgis_ou <- renderUI({
          tags$div(class="input-group",
                   HTML('<input type="text" id="sortie_qgis_ou_id" class="form-control" placeholder="Nom du projet" aria-describedby="sortie_qgis_ou_id">
                        <span class="input-group-addon" id="sortie_qgis_ou_id">.qgs</span>'))
        })

        output$titre1_qgis_ou <- renderUI({
          textInput("titre1_qgis_ou_id", label = h5("Titre informatif"), value = "", placeholder= "Facultatif")
        })

        output$titre2_qgis_ou <- renderUI({
          textInput("titre2_qgis_ou_id", label = h5("Titre descriptif"), value = "", placeholder= "Facultatif")
        })

        output$source_qgis_ou <- renderUI({
          textInput("source_qgis_ou_id", label = h5("Source de la carte"), value = sourc)
        })

        output$aide_image_ou <- renderUI({
          tags$div(class="dropup",
                   HTML(paste0('<button class="btn btn-primary dropdown-toggle" type="button" data-toggle="dropdown">
                               <i class="fa fa-book fa-fw" aria-hidden="true"></i>
                               Proc','\u00e9','dure pour capture d\'','\u00e9','cran
                               <span class="caret"></span>
                               </button>')),
                   tags$ul(class="dropdown-menu",
                           wellPanel(
                             style="background: #2B3E50; width:340px",
                             div(
                               HTML("<font size=2>Deux possibilit\u00e9s :</font>"),
                               br(),
                               br(),
                               strong(HTML("<font size=3>Par l'Outil Capture</font>")),
                               br(),
                               HTML("<font size=2>1- Ouvrir un logiciel de capture (Outil Capture de Windows par exemple).</font>"),
                               br(),
                               HTML(paste0("<font size=2>2- S\u00e9lectionner la zone \u00e0 capturer.</font>")),
                               br(),
                               HTML("<font size=2>3- Enregistrer l'image ou copier la dans le presse-papier.</font>"),
                               br(),
                               br(),
                               strong(HTML(paste0("<font size=3>Par impression d'","\u00e9","cran</font>"))),
                               br(),
                               HTML("<font size=2>1- Appuyer sur la touche clavier \"Impr ecran\".</font>"),
                               br(),
                               HTML("<font size=2>2- Ouvrir un logiciel de retouche image (Paint par exemple).</font>"),
                               br(),
                               HTML("<font size=2>3- Coller l'image et l'enregistrer au format voulu (.jpg, .png, .bmp).</font>")
                             )
                           )
                   )
                   )
        })
        })

      # Pour modifier l'ordre des fonds
      observeEvent(list(input$monter_fond_ou_id,input$descendre_fond_ou_id),{

        if(as.numeric(input$monter_fond_ou_id)==0 & as.numeric(input$descendre_fond_ou_id)==0) return(NULL)
        ordre <- c()

        if(as.numeric(input$monter_fond_ou_id)>nb_up$a)
        {
          ordre <- c(2,3)
          nb_up$a <- nb_up$a+1
        }
        if(as.numeric(input$descendre_fond_ou_id)>nb_down$a)
        {
          ordre <- c(1,2)
          nb_down$a <- nb_down$a+1
        }

        if(is.null(input$ordre_fonds_ou_id)) pos_select <- 0 else pos_select <- which(liste_fonds$a==input$ordre_fonds_ou_id)

        if(pos_select>0)
        {
          if(pos_select==ordre[1]) liste_fonds$a <- liste_fonds$a[c(2,1,3)]
          if(pos_select==ordre[2]) liste_fonds$a <- liste_fonds$a[c(1,3,2)]

          updateSelectInput(session, "ordre_fonds_ou_id",
                            choices = liste_fonds$a,
                            selected = input$ordre_fonds_ou_id
          )
        }
      },ignoreInit = TRUE)


      flux_min_ou <- reactive({

        if(is.null(input$flux_min_ou_id)) return(flux_min$a)

        return(input$flux_min_ou_id)
      })

      distance_max_ou <- reactive({

        if(is.null(input$distance_max_ou_id)) return(distance_max$a)

        return(input$distance_max_ou_id)
      })

      flux_majeur_ou <- reactive({

        if(is.null(input$flux_majeur_ou_id)) return(flux_majeur$a)

        return(input$flux_majeur_ou_id)
      })

      # Pour exporter la carte en projet Qgis

      output$export_qgis_ou <- renderUI({
        downloadButton("downloadProjetQgis_ou", label="Exporter")
      })

      output$downloadProjetQgis_ou <- downloadHandler(contentType = "zip",
                                                      filename = function(){
                                                        paste0(input$sortie_qgis_ou_id,".zip")
                                                      },
                                                      content = function(file){
                                                        owd <- setwd(tempdir())
                                                        on.exit(setwd(owd))
                                                        
                                                        rep_sortie <- dirname(file)
                                                        
                                                        dir.create("layers",showWarnings = F)
                                                        
                                                        files <- EXPORT_PROJET_QGIS_OU(file)
                                                        
                                                        zip::zip(zipfile = paste0("./",basename(file)),
                                                                 files = files,
                                                                 mode = "cherry-pick")
                                                      }
      )

      # Pour exporter la carte en projet Qgis
      EXPORT_PROJET_QGIS_OU <- function(file)
      {
        showModal(modalDialog(HTML("<i class=\"fa fa-spinner fa-spin fa-2x fa-fw\"></i> <font size=+1>Export du projet Qgis en cours...</font> "), size="m", footer=NULL, style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"))

        sortie <- input$sortie_qgis_ou_id
        
        files <- c("layers", paste0(sortie,".qgs"))
        
        rep_sortie <- dirname(file)

        # fond_flux <- st_sf(analyse_ou()[[1]])
        fond_flux <- analyse_apres_filtre_ou()[[1]]
        fond_flux <- st_transform(fond_flux, crs= as.numeric(code_epsg_ou()))

        fond_maille <- st_transform(fondMaille, crs= as.numeric(code_epsg_ou()))
        fond_contour <- st_transform(fondContour, crs= as.numeric(code_epsg_ou()))
        if(!is.null(fondSuppl) && input$ajout_territoire_ou_id) fond_territoire <- st_transform(fond_territoire_ou(), crs= as.numeric(code_epsg_ou()))
        if(input$ajout_dep_ou_id) fond_departement <- st_transform(fond_departement_ou(), crs= as.numeric(code_epsg_ou()))
        if(input$ajout_reg_ou_id) fond_region <- st_transform(fond_region_ou(), crs= as.numeric(code_epsg_ou()))
        fond_france <- st_transform(fond_habillage_ou()[[1]], crs= as.numeric(code_epsg_ou()))
        fond_pays <- st_transform(fond_habillage_ou()[[2]], crs= as.numeric(code_epsg_ou()))

        suppressWarnings(st_write(fond_flux, paste0(rep_sortie,"/layers/fond_flux.shp"), delete_dsn = TRUE, quiet = TRUE))
        suppressWarnings(st_write(fond_maille, paste0(rep_sortie,"/layers/fond_maille.shp"), delete_dsn = TRUE, quiet = TRUE))
        suppressWarnings(st_write(fond_contour,paste0(rep_sortie,"/layers/fond_contour.shp"), delete_dsn = TRUE, quiet = TRUE))
        if(exists("fond_territoire")) if(!is.null(fond_territoire)) suppressWarnings(st_write(fond_territoire, paste0(rep_sortie,"/layers/fond_territoire.shp"), delete_dsn = TRUE, quiet = TRUE))
        if(exists("fond_departement")) if(!is.null(fond_departement)) suppressWarnings(st_write(fond_departement, paste0(rep_sortie,"/layers/fond_departement.shp"), delete_dsn = TRUE, quiet = TRUE))
        if(exists("fond_region")) if(!is.null(fond_region)) suppressWarnings(st_write(fond_region,paste0(rep_sortie,"/layers/fond_region.shp"), delete_dsn = TRUE, quiet = TRUE))
        suppressWarnings(st_write(fond_france,paste0(rep_sortie,"/layers/fond_france.shp"), delete_dsn = TRUE, quiet = TRUE))
        if(exists("fond_pays")) if(!is.null(fond_pays)) suppressWarnings(st_write(fond_pays,paste0(rep_sortie,"/layers/fond_pays.shp"), delete_dsn = TRUE, quiet = TRUE))

        chemin_fonds <- rep_sortie
        titre1 <- paste0(input$titre1_qgis_ou_id,"\n")
        titre2 <- input$titre2_qgis_ou_id
        source <- input$source_qgis_ou_id
        annee <- format(Sys.time(), format = "%Y")
        variable_a_representer <- varFlux

        l <- c()
        
        l <- c(l,"fond_flux")
        
        l <- c(l,"fond_france","fond_contour","fond_maille")
        
        if(exists("fond_territoire")) l <- c(l,"fond_territoire")
        if(exists("fond_departement")) l <- c(l,"fond_departement")
        if(exists("fond_region")) l <- c(l,"fond_region")
        
        if(exists("fond_pays")) l <- c(l,"fond_pays")

        export_projet_qgis_oursins(l,rep_sortie,sortie,titre1,titre2,source,2,"#303030",annee)

        removeModal()

        showModal(modalDialog(HTML(paste0("<font size=+1>Le projet Qgis a \u00e9t\u00e9 cr","\u00e9","ee.</font>")), size="m", footer=NULL, easyClose = TRUE, style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"))

        return(files)
      }

      code_epsg_ou <- reactive({
        code_epsg <- switch(emprise,
                            "FRM"="2154",# Lambert 93
                            "971"="5490",# UTM 20 N
                            "972"="5490",# UTM 20 N
                            "973"="2972",# UTM 22 N
                            "974"="2975",# UTM 40 S
                            "976"="4471",# UTM 38 S
                            "999"=epsg_etranger)
        return(code_epsg)
      })

      analyse_ou <- reactive({
        req(input$decalage_aller_retour_ou_id,input$decalage_centroid_ou_id)

        suppressWarnings(test_k_oursins <- try(k_oursins(fondMaille,names(fondMaille)[1],data,"CODE1","CODE2",varFlux,input$decalage_aller_retour_ou_id,input$decalage_centroid_ou_id),silent=TRUE))

        if(!class(test_k_oursins) %in% "try-error")
        {
          analyse<-k_oursins(fondMaille,names(fondMaille)[1],data,"CODE1","CODE2",varFlux,input$decalage_aller_retour_ou_id,input$decalage_centroid_ou_id)
        }else
        {
          showModal(modalDialog(HTML(paste0("<font size=+1>La maille ne correspond pas au niveau g\u00e9ographique du fichier de donn","\u00e9","es.<br><br>Veuillez svp choisir une maille adapt","\u00e9","e ou modifier le fichier de donn","\u00e9","es.</font>")), size="l", footer=NULL, easyClose = TRUE, style = "color: #fff; background-color: #DF691A; border-color: #2e6da4")) #337ab7
          erreur_maille$a <- TRUE
          return(NULL)
        }

        if(is.null(analyse))
        {
          showModal(modalDialog(HTML(paste0("<font size=+1>La maille ne correspond pas au niveau g\u00e9ographique du fichier de donn","\u00e9","es.<br><br>Veuillez svp choisir une maille adapt","\u00e9","e ou modifier le fichier de donn","\u00e9","es.</font>")), size="l", footer=NULL, easyClose = TRUE, style = "color: #fff; background-color: #DF691A; border-color: #2e6da4")) #337ab7
          erreur_maille$a <- TRUE
          return(NULL)
        }

        analyse_WGS84 <- st_transform(analyse[[1]],crs=4326)

        return(list(analyse[[1]],analyse_WGS84))
      })

      fond_habillage_ou <- reactive({

        if(emprise=="FRM")
        {
          fond_pays <- st_transform(sf_paysm(),crs=4326)
          fond_france <- st_transform(sf_fram(),crs=4326)
        }else if(emprise!="999")
        {
          if(emprise=="971")
          {
            fond_france <- st_transform(sf_reg01(),crs=4326)
            fond_pays <- fond_france
          }
          if(emprise=="972")
          {
            fond_france <- st_transform(sf_reg02(),crs=4326)
            fond_pays <- fond_france
          }
          if(emprise=="973")
          {
            fond_france <- st_transform(sf_reg03(),crs=4326)
            fond_pays <- st_transform(sf_pays973(),crs=4326)
          }
          if(emprise=="974")
          {
            fond_france <- st_transform(sf_reg04(),crs=4326)
            fond_pays <- fond_france
          }
          if(emprise=="976")
          {
            fond_france <- st_transform(sf_reg06(),crs=4326)
            fond_pays <- fond_france
          }
        }else if(emprise=="999")
        {
          fond_france <- st_transform(fondEtranger,crs=4326)
          fond_pays <- fond_france
        }else{}

        return(list(fond_france,fond_pays))
      })

      fond_contour_maille_ou <- reactive({

        test_contour <- try(st_transform(fondContour,crs=4326), silent = TRUE)
        test_maille <- try(st_transform(fondMaille,crs=4326), silent = TRUE)

        if(any(list(class(test_contour),class(test_maille)) %in% "try-error"))
        {
          showModal(modalDialog(HTML(paste0("<font size=+1>Une erreur est survenue dans la cr","\u00e9","ation du territoire.<br><br>Veuillez svp v\u00e9rifier vos donn","\u00e9","es et les variables choisies.</font>")), size="m", footer=NULL, easyClose = TRUE, style = "color: #fff; background-color: #DF691A; border-color: #2e6da4"))
          erreur_maille$a <- TRUE
          return(NULL)
        }else
        {
          contour_WGS84 <- st_transform(fondContour,crs=4326)
          maille_WGS84 <- st_transform(fondMaille,crs=4326)
        }

        return(list(contour_WGS84,maille_WGS84))
      })

      list_bbox_ou <- reactive({
        req(fond_contour_maille_ou())

        list_bbox <- list(c(st_bbox(fond_contour_maille_ou()[[1]])[1],st_bbox(fond_contour_maille_ou()[[1]])[3]),c(st_bbox(fond_contour_maille_ou()[[1]])[2],st_bbox(fond_contour_maille_ou()[[1]])[4]))
        return(list_bbox)
      })

      fond_territoire_ou <- reactive({

        if(!is.null(fondSuppl))
        {
          fond_territoire <- st_transform(fondSuppl,crs=4326)
          return(fond_territoire)
        }else
        {
          return(NULL)
        }
      })

      fond_region_ou <- reactive({
        fond_region <- st_transform(sf_regm(),crs=4326)
        return(fond_region)
      })

      fond_departement_ou <- reactive({
        fond_departement <- st_transform(sf_depm(),crs=4326)
        return(fond_departement)
      })

      fond_select_donnees_ou <- reactive({
        req(analyse_apres_filtre_ou())
        fond_donnees <- analyse_apres_filtre_ou()[[1]][input$mydonnees_ou_rows_selected,]
        return(fond_donnees)
      })

      fond_select_maille_ou <- reactive({
        req(fond_contour_maille_ou())

        fond_maille <- fond_contour_maille_ou()[[2]][as.data.frame(fond_contour_maille_ou()[[2]])[,"CODE"] %in% as.data.frame(fondMaille)[input$mymaille_ou_rows_selected,"CODE"],]
        return(fond_maille)
      })

      fond_select_contour_ou <- reactive({
        req(fond_contour_maille_ou())

        fond_contour <- fond_contour_maille_ou()[[1]][as.data.frame(fond_contour_maille_ou()[[1]])[,"CODE"] %in% as.data.frame(fondContour)[input$mycontour_ou_rows_selected,"CODE"],]
        return(fond_contour)
      })

      analyse_apres_filtre_ou <- reactive({
        req(analyse_ou(),flux_majeur_ou(),distance_max_ou(),flux_min_ou())

        if(flux_majeur_ou()>nrow(analyse_ou()[[2]]))
        {
          nb_flux_majeur <- nrow(analyse_ou()[[2]])
        }else
        {
          nb_flux_majeur <- flux_majeur_ou()
          if(nb_flux_majeur<1) nb_flux_majeur <- 1
        }

        analyse_WGS84_list <- split(analyse_ou()[[2]],factor(analyse_ou()[[2]]$CODE1))
        analyse_WGS84_1 <- data.frame()
        aa <- lapply(1:length(analyse_WGS84_list), function(x) analyse_WGS84_1 <<- rbind(analyse_WGS84_1,as.data.frame(analyse_WGS84_list[[x]])[rev(order(as.data.frame(analyse_WGS84_list[[x]])[,varFlux]))[c(1:nb_flux_majeur)],]))
        analyse_WGS84_1 <- analyse_WGS84_1[!is.na(analyse_WGS84_1[,varFlux]),]

        analyse_WGS84_list <- split(analyse_ou()[[2]],factor(analyse_ou()[[2]]$CODE2))
        analyse_WGS84_2 <- data.frame()
        aa <- lapply(1:length(analyse_WGS84_list), function(x) analyse_WGS84_2 <<- rbind(analyse_WGS84_2,as.data.frame(analyse_WGS84_list[[x]])[rev(order(as.data.frame(analyse_WGS84_list[[x]])[,varFlux]))[c(1:nb_flux_majeur)],]))
        analyse_WGS84_2 <- analyse_WGS84_2[!is.na(analyse_WGS84_2[,varFlux]),]

        analyse_WGS84 <- unique(rbind(analyse_WGS84_1,analyse_WGS84_2))

        analyse_WGS84 <- st_as_sf(analyse_WGS84)

        analyse_WGS84 <- analyse_WGS84[as.vector(st_length(analyse_WGS84))<=distance_max_ou()*1000,]

        analyse_WGS84 <- analyse_WGS84[as.data.frame(analyse_WGS84)[,varFlux]>=flux_min_ou(),]

        analyse_WGS84 <- analyse_WGS84[rev(order(as.data.frame(analyse_WGS84)[,varFlux])),]

        donnees <- merge(as.data.frame(analyse_WGS84)[,c("CODE1","CODE2")],data,by=c("CODE1","CODE2"),all.x=T)

        donnees <- sort(donnees[,varFlux], decreasing = TRUE)

        return(list(analyse_WGS84,donnees))
      })

      analyse_apres_filtre_init_ou <- reactive({
        req(analyse_ou())

        if(nrow(analyse_ou()[[2]])<10)
        {
          nb_flux_majeur <- nrow(analyse_ou()[[2]])
        }else
        {
          nb_flux_majeur <- 10
        }

        analyse_WGS84_list <- split(analyse_ou()[[2]],factor(analyse_ou()[[2]]$CODE1))
        analyse_WGS84_1 <- data.frame()
        aa <- lapply(1:length(analyse_WGS84_list), function(x) analyse_WGS84_1 <<- rbind(analyse_WGS84_1,as.data.frame(analyse_WGS84_list[[x]])[rev(order(as.data.frame(analyse_WGS84_list[[x]])[,varFlux]))[c(1:nb_flux_majeur)],]))
        analyse_WGS84_1 <- analyse_WGS84_1[!is.na(analyse_WGS84_1[,varFlux]),]

        analyse_WGS84_list <- split(analyse_ou()[[2]],factor(analyse_ou()[[2]]$CODE2))
        analyse_WGS84_2 <- data.frame()
        aa <- lapply(1:length(analyse_WGS84_list), function(x) analyse_WGS84_2 <<- rbind(analyse_WGS84_2,as.data.frame(analyse_WGS84_list[[x]])[rev(order(as.data.frame(analyse_WGS84_list[[x]])[,varFlux]))[c(1:nb_flux_majeur)],]))
        analyse_WGS84_2 <- analyse_WGS84_2[!is.na(analyse_WGS84_2[,varFlux]),]

        analyse_WGS84 <- unique(rbind(analyse_WGS84_1,analyse_WGS84_2))

        analyse_WGS84 <- st_as_sf(analyse_WGS84)

        analyse_WGS84 <- analyse_WGS84[as.vector(st_length(analyse_WGS84))<=300*1000,]

        analyse_WGS84 <- analyse_WGS84[as.data.frame(analyse_WGS84)[,varFlux]>=100,]

        analyse_WGS84 <- analyse_WGS84[rev(order(as.data.frame(analyse_WGS84)[,varFlux])),]

        donnees <- merge(as.data.frame(analyse_WGS84)[,c("CODE1","CODE2")],data,by=c("CODE1","CODE2"),all.x=T)

        donnees <- sort(donnees[,varFlux], decreasing = TRUE)

        return(list(analyse_WGS84,donnees))
      })

      # Pour construire la map en leaflet
      react_fond_ou <- reactive({

        if(input$menu=="carte")
        {
          showModal(modalDialog(HTML("<i class=\"fa fa-spinner fa-spin fa-2x fa-fw\"></i><font size=+1>\u00c9laboration de la carte...</font> "), size="m", footer=NULL, style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"))

          if(is.null(fondEtranger))
          {
            proj4 <- st_crs(fondMaille)$proj4string
          }else{
            proj4 <- st_crs(fondEtranger)$proj4string
          }
          
          # Construction de la map par defaut

          m <- leaflet(padding = 0,
                       options = leafletOptions(
                         preferCanvas = TRUE,
                         transition = 2,
                         crs = leafletCRS(crsClass = "L.Proj.CRS",
                                          code = paste0("EPSG:", code_epsg_ou()),
                                          proj4def = proj4,
                                          resolutions = 2^(16:1)
                         )
                       )) %>%

            setMapWidgetStyle(list(background = "#AFC9E0")) %>%

            addTiles_insee(attribution = paste0("<a href=\"http://www.insee.fr\">OCEANIS - \u00A9 IGN - INSEE ",format(Sys.time(), format = "%Y"),"</a>")) %>%

            fitBounds(lng1 = min(list_bbox_ou()[[1]]),
                      lat1 = min(list_bbox_ou()[[2]]),
                      lng2 = max(list_bbox_ou()[[1]]),
                      lat2 = max(list_bbox_ou()[[2]])
            ) %>%

            # On ajoute une barre d'echelle
            addScaleBar(position = 'bottomright',
                        options = scaleBarOptions(metric = TRUE, imperial = FALSE)
            ) %>%

            # Pour gerer l'ordre des calques
            addMapPane(name = "fond_pays", zIndex = 401) %>%
            addMapPane(name = "fond_france", zIndex = 402) %>%
            addMapPane(name = "fond_dep", zIndex = 403) %>%
            addMapPane(name = "fond_reg", zIndex = 404) %>%
            addMapPane(name = "fond_territoire", zIndex = 405) %>%
            addMapPane(name = "fond_trio3", zIndex = 406) %>%
            addMapPane(name = "fond_trio2", zIndex = 407) %>%
            addMapPane(name = "fond_trio1", zIndex = 408) %>%
            addMapPane(name = "selection", zIndex = 409) %>%

            addMapPane(name = "fond_legende", zIndex = 410)

          # AFFICHAGE DES FONDS D'HABILLAGE

          if(emprise %in% c("FRM","973"))
          {
            # fond des pays
            m <- addPolygons(map = m, data = fond_habillage_ou()[[2]][,"LIBGEO"], opacity = 1, # sauf la France
                             stroke = TRUE, color = "white",
                             weight = 1,
                             options = pathOptions(pane = "fond_pays", clickable = F),
                             fill = T, fillColor = "#CCCCCC", fillOpacity = 1
            )
          }
          # fond de la France metro, DOM ou etranger
          m <- addPolygons(map = m, data = fond_habillage_ou()[[1]][,"LIBGEO"], opacity = 1, # fond_france
                           stroke = TRUE, color = "black",
                           weight = 1.5,
                           options = pathOptions(pane = "fond_france", clickable = F),
                           fill = T, fillColor = "white", fillOpacity = 1
          )

          m_save_ou$a <- m

          # AFFICHAGE DU FOND TERRITOIRE

          if(!is.null(fondSuppl))
          {
            m <- addPolygons(map = m, data = fond_territoire_ou(),
                             stroke = TRUE, color = "#BFBFBF", opacity = 1,
                             weight = 0.5,
                             options = pathOptions(pane = "fond_territoire", clickable = T),
                             popup = paste0("<b> <font color=#2B3E50>",as.data.frame(fond_territoire_ou())[,"LIBELLE"], "</font> </b>"),
                             fill = T, fillColor = "white", fillOpacity = 0.001,
                             group = "territoire"
            )
          }

          # AFFICHAGE DES FONDS CONTOUR ET MAILLE

          # fond du contour
          m <- addPolygons(map = m, data = fond_contour_maille_ou()[[1]], opacity = 0.3,
                           stroke = TRUE, color = "black", weight = 3,
                           options = pathOptions(pane = "fond_trio3", clickable = T),
                           popup = paste0("<b> <font color=#2B3E50>",as.data.frame(fond_contour_maille_ou()[[1]])[,"LIBELLE"], "</font> </b>"),
                           fill = T, fillColor = "white", fillOpacity = 0.3,
                           group = "maille_contour"
          )

          # fond de la maille
          m <- addPolygons(map = m, data = fond_contour_maille_ou()[[2]], opacity = 1,
                           stroke = TRUE, color = "grey", weight = 1,
                           options = pathOptions(pane = "fond_trio2", clickable = T),
                           popup = paste0("<b> <font color=#2B3E50>",as.data.frame(fond_contour_maille_ou()[[2]])[,"LIBELLE"], "</font> </b>"),
                           fill = T, fillColor = "white", fillOpacity = 0.001,
                           group = "maille_contour"
          )

          # AFFICHAGE DE L'ANALYSE

          analyse_WGS84 <- analyse_apres_filtre_init_ou()[[1]]
          donnees <- analyse_apres_filtre_init_ou()[[2]]

          m <- addPolylines(map = m,
                            data = analyse_WGS84,
                            stroke = TRUE, color = "#303030",
                            opacity = 1,
                            weight = 2,
                            options = pathOptions(pane = "fond_trio1", clickable = T),
                            popup = paste0("<b><font color=#2B3E50>",varFlux," : ",donnees,"</font></b>"),
                            group = "fleche"
          )

          removeModal()

          showModal(modalDialog(HTML("<font size=+1>Veuillez patientez svp, la carte va s'afficher dans quelques secondes...</font> "), size="m", footer=NULL, easyClose = TRUE, style = "color: #fff; background-color: #DF691A; border-color: #2e6da4")) #337ab7

          return(m)
        }
      })

      # MODIFICATION DES FONDS TERRITOIRE D'ETUDES, REGION ET DEPARTEMENT

      observeEvent(input$ajout_territoire_ou_id,{

        proxy <- leafletProxy("mymap_ou")

        clearGroup(map = proxy, group = "territoire")

        # fond du territoire d'etudes
        if(!is.null(fondSuppl))
        {
          if(input$ajout_territoire_ou_id)
          {
            proxy <- addPolygons(map = proxy, data = fond_territoire_ou(),
                                 stroke = TRUE, color = "#BFBFBF", opacity = 1,
                                 weight = 0.5,
                                 options = pathOptions(pane = "fond_territoire", clickable = T),
                                 popup = paste0("<b> <font color=#2B3E50>",as.data.frame(fond_territoire_ou())[,"LIBELLE"], "</font> </b>"),
                                 fill = T, fillColor = "white", fillOpacity = 0.001,
                                 group = "territoire"
            )
          }
        }
      },ignoreInit = TRUE)

      observeEvent(input$ajout_reg_ou_id,{

        proxy <- leafletProxy("mymap_ou")

        clearGroup(map = proxy, group = "region")

        if(emprise=="FRM")
        {
          if(input$ajout_reg_ou_id)
          {
            #fond des regions
            proxy <- addPolygons(map = proxy, data = fond_region_ou(),
                                 stroke = TRUE, color = "grey", opacity = 1,
                                 weight = 1.5,
                                 options = pathOptions(pane = "fond_reg", clickable = F),
                                 fill = F,
                                 group = "region"
            )
          }
        }
      },ignoreInit = TRUE)

      observeEvent(input$ajout_dep_ou_id,{

        proxy <- leafletProxy("mymap_ou")

        clearGroup(map = proxy, group = "departement")

        if(emprise=="FRM")
        {
          if(input$ajout_dep_ou_id)
          {
            # fond des departements
            proxy <- addPolygons(map = proxy, data = fond_departement_ou(),
                                 stroke = TRUE, color = "grey", opacity = 1,
                                 weight = 0.5,
                                 options = pathOptions(pane = "fond_dep", clickable = F),
                                 fill = F,
                                 group = "departement"
            )
          }
        }
      },ignoreInit = TRUE)

      # MODIFICATION DE L'ORDRE DES CALQUES

      observeEvent(list(input$monter_fond_ou_id,input$descendre_fond_ou_id),{

        if(as.numeric(input$monter_fond_ou_id)==0 & as.numeric(input$descendre_fond_ou_id)==0) return(NULL)

        proxy <- leafletProxy("mymap_ou")

        clearGroup(map = proxy, group = "maille_contour")
        clearGroup(map = proxy, group = "fleche")

        i <- 1 #pour gerer l'ordre des fonds dans le pane

        for(fond in liste_fonds$a)
        {
          if(fond=="analyse")
          {
            analyse_WGS84 <- analyse_apres_filtre_ou()[[1]]
            donnees <- analyse_apres_filtre_ou()[[2]]

            proxy <- addPolylines(map = proxy,
                                  data = analyse_WGS84,
                                  stroke = TRUE, color = "#303030",
                                  opacity = 1,
                                  weight = input$epaisseur_trait_ou_id,
                                  options = pathOptions(pane = paste0("fond_trio",i), clickable = T),
                                  popup = paste0("<b><font color=#2B3E50>",varFlux," : ",donnees,"</font></b>"),
                                  group = "fleche"
            )

            ordre_analyse$a <- i
          }

          if(fond=="maille")
          {
            proxy <- addPolygons(map = proxy, data = fond_contour_maille_ou()[[2]], opacity = 1,
                                 stroke = TRUE, color = "grey", weight = 1,
                                 options = pathOptions(pane = paste0("fond_trio",i), clickable = T),
                                 popup = paste0("<b> <font color=#2B3E50>",as.data.frame(fond_contour_maille_ou()[[2]])[,"LIBELLE"], "</font> </b>"),
                                 fill = T, fillColor = "white", fillOpacity = 0.001,
                                 group = "maille_contour"
            )
          }

          if(fond=="contour")
          {
            proxy <- addPolygons(map = proxy, data = fond_contour_maille_ou()[[1]], opacity = 0.3,
                                 stroke = TRUE, color = "black", weight = 3,
                                 options = pathOptions(pane = paste0("fond_trio",i), clickable = T),
                                 popup = paste0("<b> <font color=#2B3E50>",as.data.frame(fond_contour_maille_ou()[[1]])[,"LIBELLE"], "</font> </b>"),
                                 fill = T, fillColor = "white", fillOpacity = 0.3,
                                 group = "maille_contour"
            )
          }

          i <- i + 1
        }
      },ignoreInit = TRUE)

      # MODIFICATION DES FLUX

      observeEvent(list(input$flux_min_ou_id,input$distance_max_ou_id,input$flux_majeur_ou_id,input$epaisseur_trait_ou_id,input$decalage_aller_retour_ou_id,input$decalage_centroid_ou_id),{
        req(input$flux_min_ou_id,input$distance_max_ou_id,input$flux_majeur_ou_id,input$epaisseur_trait_ou_id,input$decalage_aller_retour_ou_id,input$decalage_centroid_ou_id)

        proxy <- leafletProxy("mymap_ou")

        clearGroup(map = proxy, group = "fleche")

        analyse_WGS84 <- analyse_apres_filtre_ou()[[1]]
        donnees <- analyse_apres_filtre_ou()[[2]]

        proxy <- addPolylines(map = proxy,
                              data = analyse_WGS84,
                              stroke = TRUE, color = "#303030",
                              opacity = 1,
                              weight = input$epaisseur_trait_ou_id,
                              options = pathOptions(pane = paste0("fond_trio",ordre_analyse$a), clickable = T),
                              popup = paste0("<b><font color=#2B3E50>",varFlux," : ",donnees,"</font></b>"),
                              group = "fleche"
        )
      },ignoreInit = TRUE)

      # MODIFICATION DE LA SELECTION DES OBJETS VIA LES TABLEAUX

      observeEvent(input$onglets_ou,{
        req(input$onglets_ou)

        if(input$onglets_ou == "carte")
        {
          proxy <- leafletProxy("mymap_ou")

          clearGroup(map = proxy, group = "select_donnees")

          if(!is.null(input$mydonnees_ou_rows_selected))
          {
            fond_select_donnees <- st_transform(fond_select_donnees_ou(),crs=4326)
            proxy <- addPolylines(map = proxy,
                                  data = fond_select_donnees,
                                  stroke = TRUE, color = "#FFFF00",
                                  opacity = 1,
                                  weight = input$epaisseur_trait_ou_id,
                                  options = pathOptions(pane = "selection", clickable = F),
                                  fill = F,
                                  group = "select_donnees"
            )
          }
        }
      },ignoreInit = TRUE)

      observeEvent(input$onglets_ou,{
        req(input$onglets_ou)

        if(input$onglets_ou == "carte")
        {
          proxy <- leafletProxy("mymap_ou")

          clearGroup(map = proxy, group = "select_maille")

          if(!is.null(input$mymaille_ou_rows_selected))
          {
            proxy <- addPolygons(map = proxy, data = fond_select_maille_ou(),
                                 stroke = FALSE,
                                 options = pathOptions(pane = "selection", clickable = F),
                                 fill = T,
                                 fillColor = "#FFFF00",
                                 fillOpacity = 1,
                                 group = "select_maille"
            )
          }
        }
      },ignoreInit = TRUE)

      observeEvent(input$onglets_ou,{
        req(input$onglets_ou)

        if(input$onglets_ou == "carte")
        {
          proxy <- leafletProxy("mymap_ou")

          clearGroup(map = proxy, group = "select_contour")

          if(!is.null(input$mycontour_ou_rows_selected))
          {
            proxy <- addPolygons(map = proxy, data = fond_select_contour_ou(),
                                 stroke = FALSE,
                                 options = pathOptions(pane = "selection", clickable = F),
                                 fill = T,
                                 fillColor = "#FFFF00",
                                 fillOpacity = 1,
                                 group = "select_contour"
            )
          }
        }
      },ignoreInit = TRUE)

      # AJOUT DES ONGLETS SAUVEGARDE

      observeEvent(input$save_carte_ou_id,{

        showModal(modalDialog(HTML("<i class=\"fa fa-spinner fa-spin fa-2x fa-fw\"></i><font size=+1>Sauvegarde de la carte en cours...</font> "), size="m", footer=NULL, style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"))

        insert_save$a <- insert_save$a + 1
        nb_save_carte <- insert_save$a-remove_carte$a

        m_save <- m_save_ou$a

        if(nb_save_carte>6)
        {
          insert_save$a <- insert_save$a - 1
          showModal(modalDialog(HTML("<font size=+1>Vous ne pouvez pas sauvegarger plus de 6 cartes. Veuillez en supprimer avant de continuer.</font> "), size="l", footer=NULL, easyClose = TRUE, style = "color: #fff; background-color: #DF691A; border-color: #2e6da4")) #337ab7
          return(NULL)
        }

        output[[paste0("mymap_save_",insert_save$a,"_ou")]] <- renderLeaflet({

          if(!is.null(fondSuppl))
          {
            if(isolate(input$ajout_territoire_ou_id))
            {
              m_save <- addPolygons(map = m_save, data = isolate(fond_territoire_ou()),
                                    stroke = TRUE, color = "#BFBFBF", opacity = 1,
                                    weight = 0.5,
                                    options = pathOptions(pane = "fond_territoire", clickable = T),
                                    popup = paste0("<b> <font color=#2B3E50>",as.data.frame(isolate(fond_territoire_ou()))[,"LIBELLE"], "</font> </b>"),
                                    fill = T, fillColor = "white", fillOpacity = 0.001
              )
            }
          }

          if(isolate(input$ajout_reg_ou_id))
          {
            m_save <- addPolygons(map = m_save, data = isolate(fond_region_ou()),
                                  stroke = TRUE, color = "grey", opacity = 1,
                                  weight = 1.5,
                                  options = pathOptions(pane = "fond_reg", clickable = F),
                                  fill = F
            )
          }

          if(isolate(input$ajout_dep_ou_id))
          {
            m_save <- addPolygons(map = m_save, data = isolate(fond_departement_ou()),
                                  stroke = TRUE, color = "grey", opacity = 1,
                                  weight = 0.5,
                                  options = pathOptions(pane = "fond_dep", clickable = F),
                                  fill = F
            )
          }

          i <- 1 #pour gerer l'ordre des fonds dans le pane

          for(fond in isolate(liste_fonds$a))
          {
            if(fond=="analyse")
            {
              analyse_WGS84 <- isolate(analyse_apres_filtre_ou())[[1]]
              donnees <- isolate(analyse_apres_filtre_ou())[[2]]

              m_save <- addPolylines(map = m_save,
                                     data = analyse_WGS84,
                                     stroke = TRUE, color = "#303030",
                                     opacity = 1,
                                     weight = isolate(input$epaisseur_trait_ou_id),
                                     options = pathOptions(pane = paste0("fond_trio",i), clickable = T),
                                     popup = paste0("<b><font color=#2B3E50>",varFlux," : ",donnees,"</font></b>")
              )
            }

            if(fond=="maille")
            {
              m_save <- addPolygons(map = m_save, data = isolate(fond_contour_maille_ou())[[2]], opacity = 1,
                                    stroke = TRUE, color = "grey", weight = 1,
                                    options = pathOptions(pane = paste0("fond_trio",i), clickable = T),
                                    popup = paste0("<b> <font color=#2B3E50>",as.data.frame(isolate(fond_contour_maille_ou())[[2]])[,"LIBELLE"], "</font> </b>"),
                                    fill = T, fillColor = "white", fillOpacity = 0.001
              )
            }

            if(fond=="contour")
            {
              m_save <- addPolygons(map = m_save, data = isolate(fond_contour_maille_ou())[[1]], opacity = 0.3,
                                    stroke = TRUE, color = "black", weight = 3,
                                    options = pathOptions(pane = paste0("fond_trio",i), clickable = T),
                                    popup = paste0("<b> <font color=#2B3E50>",as.data.frame(isolate(fond_contour_maille_ou())[[1]])[,"LIBELLE"], "</font> </b>"),
                                    fill = T, fillColor = "white", fillOpacity = 0.3
              )
            }

            i <- i + 1
          }

          removeModal()

          m_save
        })

        output[[paste0("remove_carte_",nb_save_carte,"_ou")]] <- renderUI({
          actionButton(paste0("remove_carte_",nb_save_carte,"_ou_id"),label="X Supprimer la carte", style="color:#FFFFFF; border-color:#FFFFFF; background-color:#2B3E50")
        })
        appendTab(inputId = "onglets_ou",
                  tabPanel(title=HTML(paste0("<font color=#AFC9E0> Carte ",insert_save$a,"</font>")),value=paste0("carte",nb_save_carte),uiOutput(paste0("remove_carte_",nb_save_carte,"_ou")),leafletOutput(paste0("mymap_save_",insert_save$a,"_ou"),width="100%",height = 800)),
                  select = TRUE,
                  session = session
        )
      }, ignoreInit = TRUE)

      observeEvent(input$remove_carte_1_ou_id,{
        remove_carte$a <- remove_carte$a + 1
        removeTab(inputId = "onglets_ou",
                  target = "carte1",
                  session = session
        )
      }, ignoreInit = TRUE)

      observeEvent(input$remove_carte_2_ou_id,{
        remove_carte$a <- remove_carte$a + 1
        removeTab(inputId = "onglets_ou",
                  target = "carte2",
                  session = session
        )
      }, ignoreInit = TRUE)

      observeEvent(input$remove_carte_3_ou_id,{
        remove_carte$a <- remove_carte$a + 1
        removeTab(inputId = "onglets_ou",
                  target = "carte3",
                  session = session
        )
      }, ignoreInit = TRUE)

      observeEvent(input$remove_carte_4_ou_id,{
        remove_carte$a <- remove_carte$a + 1
        removeTab(inputId = "onglets_ou",
                  target = "carte4",
                  session = session
        )
      }, ignoreInit = TRUE)

      observeEvent(input$remove_carte_5_ou_id,{
        remove_carte$a <- remove_carte$a + 1
        removeTab(inputId = "onglets_ou",
                  target = "carte5",
                  session = session
        )
      }, ignoreInit = TRUE)

      observeEvent(input$remove_carte_6_ou_id,{
        remove_carte$a <- remove_carte$a + 1
        removeTab(inputId = "onglets_ou",
                  target = "carte6",
                  session = session
        )
      }, ignoreInit = TRUE)

      # TABLEAUX DE DONNEES, MAILLE ET CONTOUR

      output$mydonnees_ou <- DT::renderDataTable(DT::datatable({
        analyse_WGS84 <- analyse_apres_filtre_ou()[[1]]
        data <- as.data.frame(analyse_WGS84)
        tableau_donnees <- data[,c("CODE1","CODE2",varFlux)]
      },  style = 'bootstrap'
      ))

      output$mymaille_ou <- DT::renderDataTable(DT::datatable({
        data <- as.data.frame(fondMaille)
        tableau_maille <- data[,c(1:2)]
      },  style = 'bootstrap'
      ))

      output$mycontour_ou <- DT::renderDataTable(DT::datatable({
        data <- as.data.frame(fondContour)
        tableau_contour <- data[,c(1:2)]
      },  style = 'bootstrap'
      ))

      # ENVOI DU LEAFLET A L'UI

      output$mymap_ou <- renderLeaflet({
        react_fond_ou()
      })
    }

    runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)
    }

Try the oceanis package in your browser

Any scripts or data that you put into this service are public.

oceanis documentation built on July 13, 2022, 5:06 p.m.