R/app_server.R

Defines functions app_server

#' The application server-side
#' 
#' @param input,output,session Internal parameters for {shiny}. 
#'     DO NOT REMOVE.
#' @import shiny
#' @import shiny.semantic
#' @import geosphere
#' @import leaflet
#' @import dplyr
#' @import lubridate
#' @import DT
#' @import shiny.i18n
#' @import shinycssloaders
#' @import shinyWidgets
#' @noRd
#' 


app_server <- function( input, output, session ) {
  # Your application server logic
  
  # read data
  # ships <- read.table(unz("inst/app/ext_data/ships_04112020.zip", "ships.csv"), header = T, dec = ".", sep = ",", encoding = "utf-8", quote = "\"", fill = T)
  # ships <- read.table("inst/app/ext_data/ships.csv", header = T, dec = ".", sep = ",", encoding = "utf-8", quote = "\"", fill = T)
  load("inst/app/ext_data/ships.RData")
  
  
  # translation file importation
  translator <- Translator$new(translation_json_path = "inst/app/ext_data/translation.json")
  
  # dynamic language
  i18n <- reactive({
    selected <- input$selected_language
    if (length(selected) > 0 && selected %in% translator$get_languages()) {
      translator$set_translation_language(selected)
    }
    translator
  })
  
  # language choice
  output$selected_language <- renderUI({
    multiple_radio("selected_language", icon("world"), choices = translator$get_languages(), selected = translator$get_languages()[1], position = "inline")
  })
  
  
  # select vessel type
  output$selected_vessel_type <- renderUI({
    selectizeInput("selected_vessel_type", i18n()$t("Select a vessel type :"),
                   choices = unique(ships$ship_type))
  })
  
  # data after vessel type selection
  vessel_type <- reactive({
    req(input$selected_vessel_type)
    vessel_type <- ships[which(ships$ship_type %in% input$selected_vessel_type),]
  })
  
  
  # select vessel
  output$selected_vessel <- renderUI({
    req(input$selected_vessel_type)
    selectizeInput("selected_vessel", i18n()$t("Select a vessel :"),
                   choices = unique(vessel_type()$SHIPNAME))
  })
  
  # data after vessel selection
  vessel <- reactive({
    req(input$selected_vessel)
    vessel <- vessel_type()[which(vessel_type()$SHIPNAME %in% input$selected_vessel),]
  })
  
  # calcul of final observation
  observation <- reactive({
    req(vessel())
    # datetime transformation
    data <- vessel()
    data$DATETIME <- as.POSIXct(data$DATETIME, format = "%Y-%m-%dT%H:%M:%OS")
    # order by data
    ship_selected_order <- data[order(data$DATETIME),]
    # distance between 2 observations
    ship_selected_order <- mutate(ship_selected_order, 
                                  Distance = distHaversine(cbind(LON, LAT),
                                                           cbind(lag(LON), lag(LAT))))
    ship_selected_order$Distance <- round(ship_selected_order$Distance, 2)
    # selection with greatest distance and most recent datetime
    tot1 <- which(ship_selected_order$Distance %in% max(ship_selected_order$Distance, na.rm = T))
    toto <- sort(unique(c(tot1 - 1,tot1)))
    test <- ship_selected_order[toto,]
    tot2 <- which(test$DATETIME %in% max(test$DATETIME))
    toto <- c(tot2 - 1,tot2)
    observation <- test[toto,]
    # result
    observation
  })
  
  # text1
  output$text1 <- renderText({
    req(observation())
    paste(i18n()$t("<br><u><b>Observation of the longest distance sailed :</u></b><br><br>"))
  })
  
  # map
  output$map <- renderLeaflet({
    req(observation())
    data <- observation()
    leaflet() %>%
      # addTiles() %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      addCircleMarkers(
        # map = m,
        lng = data$LON,
        lat = data$LAT,
        popup = paste("Latitude:", data$LAT, ", longitude:", data$LON),
        stroke = F, fillOpacity = 0.5,
        color = "red") %>%
      fitBounds(
        # map = m,
        lng1 = min(data$LON - 0.13),
        lat1 = min(data$LAT - 0.13),
        lng2 = max(data$LON + 0.13),
        lat2 = max(data$LAT + 0.13)) %>%
      addPolylines(data = data, lng = ~LON, lat = ~LAT,
                   color = "blue", opacity = 0.2)
  })
  
  # text 2
  output$text2 <- renderText({
    req(observation())
    paste(i18n()$t("<br>The ship<b>"), unique(observation()$SHIPNAME), i18n()$t("</b>sailed<b>"), round(observation()$Distance[2], 2), "m</b>.<br>",
          i18n()$t("You can download observations with action button below or view informations in the table.<br><br>"))
  })
  
  # action button to download observation
  output$download_button <- renderUI({
    req(observation())
    downloadButton("download_button1", ("Observations"), style = "color: black; background-color: green;
                                                         border-color: black;position:right", icon("table"))
  })
  
  # téléchargement de la table
  output$download_button1 <- downloadHandler(
    filename = function() {
      paste("Observation",paste(input$selected_vessel_type, input$selected_vessel, sep = "-"),"_",Sys.Date(),".csv", sep = )
    },
    content = function(file) {
      write.table(observation(), file, row.names = F, sep = ";", dec = ".", fileEncoding = "UTF-8", quote = F)}
  )
  
  # table
  output$table <- renderDT({
    req(observation())
    datatable(data = observation()[,c(1,2,6,9,14,15,18,21)],
              options = list(autoWidth = TRUE, pageLength = 10, columnDefs = list(list(className = "dt-center",targets = "_all"))),
              rownames = FALSE)
  })
  
  ## END
}
leopedemay/WorkApp documentation built on Dec. 21, 2021, 10:42 a.m.