R Shiny中的宣传册全屏切换/按钮

2cmtqfgy  于 2023-04-27  发布在  其他
关注(0)|答案(2)|浏览(104)

我试图通过leaflet创建一个time series可视化,并在R Shiny中使用滑块。该应用程序运行正常。作为附加步骤,我试图添加一个toggle/button,用户可以单击该toggle/button,然后map将加载到fullscreen中。
我如何添加一个按钮功能来切换Map全屏显示,然后再次点击它回到原始/默认大小?
密码

# 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)
r7s23pms

r7s23pms1#

试试这个代码

# 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)

我在Map的左下角加了一个小按钮。当点击它时,图会放大到全屏,在全屏下,再次点击它会回到正常视图。

  • 你需要做的就是把你的绘图组件放在一个父组件、祖组件、祖父组件或祖父-祖父...父组件中,它有class = "leaflet-full-screen"
  • 如果您不喜欢按钮的位置或颜色等,请更改.plot-zoom样式。
  • 在你的应用程序中包含样式和脚本标签。通常你希望样式靠近应用程序的顶部(头部),并将脚本放置在传单标签之后。
  • 这适用于多个传单对象,因此这意味着它会将按钮添加到应用程序中的所有传单Map。

请看我的类似回答,我们如何用plotly做同样的事情。

neekobn8

neekobn82#

shinyfullscreen软件包为这个问题提供了一个非常简单的解决方案。最近updated包含一个全屏按钮,可以在单个图表上工作,或者在全屏和正常视图之间切换整个Shiny App。
您可以通过运行以下代码来安装开发版本:

devtools::install_github("etiennebacher/shinyfullscreen")

相关问题