#' 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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.