inst/app/server.R

In anna-doizy/butinagepei: Explore bee harvesting in Reunion island

function(input, output, session) {

  # for local use : stop the server when the session ends
  is_local <- Sys.getenv('SHINY_PORT') == ""
  if(is_local) session$onSessionEnded(function() stopApp())

  ## Interactive Map ###########################################

  # Filter data ####

  suivi_sel <- reactive({

    suivi %>%
      filter(
        between(date, min(input$periode), max(input$periode)),
        vernaculaire %in% input$especes
      )
  })

  # Set a color per species ####
  color_species <- reactive({

    categories <- sort(unique(suivi$vernaculaire))

    colorRampPalette(c("red", "darkgreen", "blue"))(length(categories)) %>%
      setNames(categories)
    # named color vector
  })

  # Create an empty Reunion map
  output$map <- renderLeaflet({

    leaflet(options = leafletOptions(maxZoom = 14)) %>% # maxzoom anonymises data
      addProviderTiles("Stamen.Terrain") %>%
      setView(55.8, -21.15, zoom = 10)
  })


  # Don't reload the map when the user is changing date and species settings
  observe({
    ifelse(input$cluster,

      leafletProxy("map", data = suivi_sel()) %>%
        clearMarkerClusters() %>%
        clearMarkers() %>%
        addCircleMarkers(
          ~longitude,
          ~latitude,
          color = ~colorFactor(color_species(), domain = names(color_species()))(vernaculaire),
          popup = ~paste(
            paste0("<img src = \"", htmlEscape(img_src), "\", style = \"max-width:200px;max-height:200px\">"),
            htmlEscape(vernaculaire),
            paste("<em>", htmlEscape(g_latin), htmlEscape(e_latin), "</em>"),
            htmlEscape(date),
            sep = "<br>"
          ),
          fill = TRUE,
          opacity = 0.5,
          fillOpacity = 0.8,
          radius = 9,
          clusterOptions = markerClusterOptions()
        ),

      leafletProxy("map", data = suivi_sel()) %>%
        clearMarkerClusters() %>%
        clearMarkers() %>%
        addCircleMarkers(
          ~longitude,
          ~latitude,
          color = ~colorFactor(color_species(), domain = names(color_species()))(vernaculaire),
          popup = ~paste(
            paste0("<img src = \"", htmlEscape(img_src), "\", style = \"max-width:200px;max-height:200px\">"),
            htmlEscape(vernaculaire),
            paste("<em>", htmlEscape(g_latin), htmlEscape(e_latin), "</em>"),
            htmlEscape(date),
            sep = "<br>"
          ),
          fill = TRUE,
          opacity = 0.5,
          fillOpacity = 0.8,
          radius = 9
      )
    )
  })


  # Temporal visualisation ####

  output$temporel <- renderPlot({

    if(nrow(suivi_sel()) > 0) # in the case where nothing is selected: don't plot the graph
      ggplot(suivi_sel()) +
        aes(x = date, fill = vernaculaire) +
        geom_density(alpha = 0.8) +
        geom_rug(length = unit(0.1, "npc")) +
        labs(
          title = paste0(input$especes, " (n = ", nrow(suivi_sel()), ")"),
          x = NULL, y = NULL) +
        scale_fill_manual(values = color_species()) +
        scale_x_date(date_labels = "%m/%y") +
        scale_y_continuous(breaks = NULL, expand = expansion(mult = 0.15)) +
        # facet_wrap(
        #   vars(vernaculaire),
        #   labeller = labeller(
        #     vernaculaire = as_labeller(~ paste0(.x, " (", nrow(suivi_sel()), " observations)") %>% rlang::set_names())
        #   ),
        #   ncol = 1,
        #   scales = "free_y"
        # ) +
        suppressMessages(ggdark::dark_theme_light()) +
        theme(
          plot.title = element_text(hjust = 0.5),
          legend.position = "none",
          strip.text = element_text(size = 14)#,
          # strip.background = element_rect(fill = "#6a6a6a")
        )
    },
  res = 90

  )


  ## Data Explorer ###########################################


  output$suivitable <- renderDataTable({

    suivi %>%
      mutate(`nom latin` = paste(g_latin, e_latin)) %>%
      rename(`nom commun` = vernaculaire, `source de l'image` = img_src) %>%
      select(-espece, -g_latin, -e_latin) %>%
      relocate(`nom latin`, .after = `nom commun`) %>%
      datatable(
        filter = "top",
        selection = "none",
        class = "hover",
        fillContainer = TRUE,
        option = list(dom = "ti", paging = F, scrollY = "600px"
        )
      )
    })


  output$export <- downloadHandler(
    filename = function() {
      paste0(Sys.Date(), "_butinagepei.csv")
    },
    content = function(file) {
      write.csv2(suivi, file, row.names = FALSE)
    }
  )



}