传单取决于按钮和 insertUI 不呈现闪亮

问题描述 投票:0回答:0

我正在开发一个闪亮的应用程序。我有一个应该具有以下行为的面板:首先,只有一个按钮。如果单击此按钮,则会出现一个绘图和另一个按钮。如果单击另一个按钮,则会出现另一幅图和一张地图。

然而,即使情节没有问题,地图也永远不会被渲染。

这是一个可重现的例子:

library(shiny)
library(leaflet)
library(dplyr)
library(shinydashboard)

new_map = function(){
  m <- leaflet() %>%
    addTiles() %>%  # Add default OpenStreetMap map tiles
    addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
  return(m)
}

new_map_v2 = function(){
  m <- leaflet() %>%
    addTiles() %>%  # Add default OpenStreetMap map tiles
    addMarkers(lng=100, lat=-100, popup="This map is good")
  return(m)
}


ui <- navbarPage("Shiny app",
                 tabPanel("Tab1",
                          uiOutput("some_button"),
                          div(id = "page_basic")
                 )
)


server = function(input, output, session) {
  
values <- reactiveValues(launched = FALSE, comp = FALSE)
  
  
output$some_button = renderUI(if(!values$launched){
  tag_alea = tags$div(fluidRow(column(width = 6, actionButton("clic_zero", "Click me"))))
  HTML(paste0(tag_alea))
} else {tag_base = tags$div(fluidRow(column(width = 6,
                                               actionButton("clic_one", "Another completely different button")))
)
HTML(paste0(tag_base))
})

observeEvent(input$clic_zero, {
  values$launched = TRUE})

observeEvent(input$clic_one,{
  values$comp = !values$comp})

observe({ if (values$comp & values$launched){
  page_first = tags$div(id = "page_no_comp",
                                         fluidRow(
                                           column(width = 6, plotOutput("plot")),
                                           column(width = 6,
                                                  box(width = NULL,
                                                      title = "Here should be the map",
                                                      leafletOutput("new_map")
                                                  )
                                                  )
                                           )
                                         )
  ui_page_first = paste(page_first)
  removeUI(selector = "#page_comp")
  insertUI(
    selector = "#page_basic",
    where = "afterEnd",
    ui = HTML(ui_page_first))
} else if (!values$comp & values$launched){
  page_second = tags$div(id = "page_comp",
                        fluidRow(
                          column(width = 6, plotOutput("plot2")),
                          column(width = 6,
                                 box(width = NULL,
                                     title = "No map below, that's normal"
                                 )
                          )
                        )
  )
  ui_page_second = paste(page_second)
  removeUI(selector = "#page_no_comp")
  insertUI(
    selector = "#page_basic",
    where = "afterEnd",
    ui = HTML(ui_page_second))
  }
  })

output$new_map <-  renderLeaflet({
  new_map()
})

output$plot <- renderPlot({
  plot(c(1,2,3,4))
})

output$plot2 <- renderPlot({
  hist(c(4,3,2,1))
})

}

shinyApp(ui, server)

如您所见,地图从未渲染过。 真正有趣的是我完全不理解的是以下行为:如果我绘制两张地图而不是一张地图,就没有问题了。以下代码运行良好,即使我所做的只是添加一个名为 new_map_v2 的地图。

library(shiny)
library(leaflet)
library(dplyr)
library(shinydashboard)

new_map = function(){
  m <- leaflet() %>%
    addTiles() %>%  # Add default OpenStreetMap map tiles
    addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
  return(m)
}

new_map_v2 = function(){
  m <- leaflet() %>%
    addTiles() %>%  # Add default OpenStreetMap map tiles
    addMarkers(lng=100, lat=-100, popup="This map is good")
  return(m)
}


ui <- navbarPage("Shiny app",
                 tabPanel("Tab1",
                          uiOutput("some_button"),
                          leafletOutput("new_map_v2"),
                          div(id = "page_basic")
                 )
)


server = function(input, output, session) {
  
values <- reactiveValues(launched = FALSE, comp = FALSE)
  
  
output$some_button = renderUI(if(!values$launched){
  tag_alea = tags$div(fluidRow(column(width = 6, actionButton("clic_zero", "Click me"))))
  HTML(paste0(tag_alea))
} else {tag_base = tags$div(fluidRow(column(width = 6,
                                               actionButton("clic_one", "Another completely different button")))
)
HTML(paste0(tag_base))
})

observeEvent(input$clic_zero, {
  values$launched = TRUE})

observeEvent(input$clic_one,{
  values$comp = !values$comp})

observe({ if (values$comp & values$launched){
  page_first = tags$div(id = "page_no_comp",
                                         fluidRow(
                                           column(width = 6, plotOutput("plot")),
                                           column(width = 6,
                                                  box(width = NULL,
                                                      title = "Here should be the map",
                                                      leafletOutput("new_map")
                                                  )
                                                  )
                                           )
                                         )
  ui_page_first = paste(page_first)
  removeUI(selector = "#page_comp")
  insertUI(
    selector = "#page_basic",
    where = "afterEnd",
    ui = HTML(ui_page_first))
} else if (!values$comp & values$launched){
  page_second = tags$div(id = "page_comp",
                        fluidRow(
                          column(width = 6, plotOutput("plot2")),
                          column(width = 6,
                                 box(width = NULL,
                                     title = "No map below, that's normal"
                                 )
                          )
                        )
  )
  ui_page_second = paste(page_second)
  removeUI(selector = "#page_no_comp")
  insertUI(
    selector = "#page_basic",
    where = "afterEnd",
    ui = HTML(ui_page_second))
  }
  })

output$new_map <-  renderLeaflet({
  new_map()
})

output$new_map_v2 <-  renderLeaflet({
  new_map_v2()
})

output$plot <- renderPlot({
  plot(c(1,2,3,4))
})

output$plot2 <- renderPlot({
  hist(c(4,3,2,1))
})

}

shinyApp(ui, server)

我真正的 Shiny 应用程序更复杂,我真的需要在点击按钮后在这个面板中显示地图。我想,一个解决方案可能是始终显示地图,有时根据按钮状态“隐藏”或“显示”它;我不想要这个,因为那样我可能会在页面组织方面遇到一些问题。

当然,我的应用程序中只有一张地图;我想问题是应用程序在 UI 中至少需要一个“真实的”leafletOutput,而不依赖于某些观察事件?也许要初始化一些东西? 在我的应用程序中,我尝试添加另一张地图;有问题的地图只在我第二次点击按钮时显示,所以这不是很好。

非常感谢任何想法,即使它不是一个真正完美的解决方案

r shiny leaflet shiny-reactivity
© www.soinside.com 2019 - 2024. All rights reserved.