Leaflet fullscreen toggle/button

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-%DD",
        animate = T
      )
    })
  })

  # Filter data for the date selected
  Filtered_Data <- reactive({
    req(input$Date)
    filter(df, Date == input$Date)
  })


  # Create the leaflet map
  output$Time_Series_Map <- renderLeaflet({
    leaflet(df) %>%
      addTiles() %>%
      setView(lat = 0, lng = 0, zoom = 2)
  })

  # Create data markers for selected date
  observe({
    # print(input$Date)

    leafletProxy("Time_Series_Map", data = Filtered_Data()) %>%
      addCircleMarkers(
        lng = ~lon, lat = ~lat,
        popup = ~id
      )
  })
}

# Run the application
shinyApp(ui = ui, server = server)

Solution

Try this code

# This is a Shiny time series map web application
library(shiny)
library(tidyverse)
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(
    htmltools::htmlDependencies(icon("", verify_fa = FALSE)),
    tags$style(
        '
        .plot-zoom {
            position: absolute;
            border: none;
            background-color: transparent;
            bottom: 0;
            left: 0;
            z-index: 1;
        }
        .full-screen {
            position: fixed;
            height: 100vh !important;
            width: 100vw !important;
            left: 0;
            top: 0;
            z-index: 9999;
            overflow: hidden;
        }
        
        .leaflet-full-screen {
            position: relative;
        }
        '
    ),
    # 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(
            div(
                class = "leaflet-full-screen",
                leafletOutput("Time_Series_Map")
            )
           
        ),
    ),
    tags$script(HTML(
        "
        function plotZoom(el){
            el = $(el);
            var parent = el.parent().parent();
            if(el.attr('data-full_screen') === 'false') {
                parent.addClass('full-screen')
                      .css('position', '')
                      .trigger('resize').fadeOut().fadeIn();
                el.attr('data-full_screen', 'true');
            } else {
                parent.removeClass('full-screen')
                      .css('position', 'relative')
                      .trigger('resize').fadeOut().fadeIn();
                el.attr('data-full_screen', 'false');
            }
        }
        
        $(function(){
           $('.leaflet-full-screen  .leaflet.html-widget').append(
            `
            <div class='plot-zoom'>
                <button onclick=plotZoom(this)  data-full_screen='false' title='Full screen'>
                    <i class='fa fa-expand-arrows-alt'></i>
                </button>
            </div>
            `); 
        })
        "
    ))
)



# 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-%DD",
                        animate = T
            )
        })
    })
    
    # Filter data for the date selected
    Filtered_Data <- reactive({
        req(input$Date)
        filter(df, Date == input$Date)
    })
    
    
    # Create the leaflet map
    output$Time_Series_Map <- renderLeaflet({
        leaflet(df) %>%
            addTiles() %>%
            setView(lat = 0, lng = 0, zoom = 2)
    })
    
    # Create data markers for selected date
    observe({
        # print(input$Date)
        
        leafletProxy("Time_Series_Map", data = Filtered_Data()) %>%
            addCircleMarkers(
                lng = ~lon, lat = ~lat,
                popup = ~id
            )
    })
}

# Run the application
shinyApp(ui = ui, server = server)

I added a little button on the bottom left of the map. when it is clicked, the plot is zoomed to full screen and in full screen, click it again will go back to normal view.

All you need to do is place your plot components inside a parent or grandparent or grand-grand...parent component which has class = "leaflet-full-screen".
Change the .plot-zoom style if you don't like the button position or color etc.
Include the style and script tags in your app. Usually you want to have the style close to the top (head) of your app and place the script after leaflet tags.
This works on multiple leaflet objects, so it means it will add the button to all leaflet maps in your app.

See my similar answer how we can do the same thing with plotly. The code is a little different though.