Home > database >  Leaflet fullscreen toggle/button in R Shiny
Leaflet fullscreen toggle/button in R Shiny

Time:02-05

I am trying to create a time series visualization via leaflet with a slider in R Shiny. The app works fine. As an additional step, I am trying to add a toggle/button which the user can click and the map will then load in fullscreen.

How can I add a button functionality to toggle the map display in fullscreen and then upon clicking it again to back to the original/default size?

Code

# This is a Shiny time series map web application
library(shiny)
library(tidyverse)
library(tidyr)
library(leaflet)
library(xts)


xts_to_tibble <- function(xts_obj) {
  data.frame(index(xts_obj), coredata(xts_obj)) %>%
    set_names(c("date", names(xts_obj))) %>%
    as_tibble()
}

# Create sample data
Date <- c(
  "2014-04-08", "2014-06-04", "2014-04-30",
  "2014-05-30", "2014-05-01"
)
lat <- as.numeric(c(
  "45.53814", "45.51076", "45.43560", "45.54332",
  "45.52234"
))
lon <- as.numeric(c(
  "-73.63672", "-73.61029", "-73.60100",
  "-73.56000 ", "-73.59022"
))
id <- as.numeric(c("1", "2", "3", "4", "5"))

# Create a df from the above columns
df <- data.frame(id, lat, lon, Date)
df$Year <- lubridate::year(df$Date)
df$Month <- lubridate::month(df$Date, label = TRUE, abbr = FALSE)
df$Week <- lubridate::week(df$Date)
df$Date <- as.Date(df$Date)
ui <- fluidPage(

  # Title
  titlePanel("Time Series Visiualization Map"),
  sidebarLayout(

    # Define the sidebar
    sidebarPanel(
      radioButtons(
        inputId = "Frequency",
        label = " Select Time Series Frequency",
        choices = c(
          "weeks",
          "months",
          "years"
        ),
        selected = "weeks",
        inline = T
      ),
      uiOutput("Time_Series_UI")
    ),
    mainPanel(
      leafletOutput("Time_Series_Map")
    ),
  )
)



# Define server logic required to draw a histogram
server <- function(input, output) {

  # Render slider input depending on data frequency

  observe({
    # Create an xts object
    df_xts <- xts(df, order.by = as.Date(df$Date))

    # All_Dates = unique(df$Start_Date)

    Filtered_Dates <- df_xts[xts::endpoints(
      df_xts,
      on = input$Frequency
    )] %>% xts_to_tibble()

    output$Time_Series_UI <- renderUI({
      sliderInput("Date", "Date:",
        min = pull(slice_min(Filtered_Dates, date), date),
        max = pull(slice_max(Filtered_Dates, date), date),
        value = pull(slice_min(Filtered_Dates, date), date),
        step = 1,
        #timeFormat = "%YYYY-%MM-           
  •  Tags:  
  • Related