在 R shiny 中双击将 plotoutput 替换为 leafletoutput

标签 r shiny leaflet

我有 plotOutput 的输出,双击 map 时,我想查看 leafletoutput 的输出。在下面的代码中,当双击 map 时,传单 map 显示在谷歌地图下方。双击前会显示第一张图片,但双击后,我只想查看传单 map 。有关如何执行此操作的任何建议?

   library(shiny)
   library(shinydashboard)
   library(leaflet)
   library(dismo)
   library(ggmap)
   library(dplyr)

 shinyApp(
 ui = dashboardPage(
 dashboardHeader(title=""),

 dashboardSidebar(width = 200 ),


dashboardBody(   

  fluidRow(

    plotOutput("USA_GoogleMap",dblclick='plot_dblclick'),
    leafletOutput("leaflet_map")


  )
)),

 server=function(input, output, session) {

double_clicked <- reactiveValues(

center = NULL 
)

  # Handle double clicks on the plot

observeEvent(input$plot_dblclick, {

double_clicked$center <- c(input$plot_dblclick$x,input$plot_dblclick$y)

 })



output$USA_GoogleMap<-renderPlot({

statesMap = map_data("state")

xy=cbind(statesMap$long,statesMap$lat)
y=c(36.4,41.5,42.25,27.7,32.77)
x=c(-115.5,-100,-75,-81.5,-97.45)
state=c("Nevada","Nebraska","New York","Florida","Texas")
bases=cbind(x,y)
bases_mercator=data_frame(Mercator_X=Mercator(bases)[,1],Mercator_Y=Mercator(bases)[,2],State=state)


g = gmap(xy, type='satellite',zoom=4)   
plot(g, inter=TRUE)
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("white", alpha=0.2))
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("yellow", alpha=0.4))
text(bases_mercator$Mercator_X,bases_mercator$Mercator_Y,state)

})


 output$leaflet_map <- renderLeaflet({
if(!is.null(double_clicked$center)){

  leaflet()%>%setView(lng = -71.0589, lat = 42.3601, zoom = 12)%>%addTiles()
 }
})
}
   )
 shinyApp(ui = ui, server = server)

第一张图片

enter image description here

第二张图片

enter image description here

最佳答案

首先让我先说一句 - 有比我展示的更好的方法。我只是还没有找到。我确信这是一个比我所知道的更好的程序员,但至少我可以说这是可行的。尽管它很丑陋。隐藏情节的关键是使用 conditionalPanel(我以前不熟悉)。

我有一个文本触发器,用于识别绘图是否被双击,并使用它来触发是否显示面板。但是,如果不使用 textOutput 调用它,我无法让文本初始化...所以我有一个字体大小为零的 textOutput 调用。同样,必须有比我现在做的更好的很多方法来触发它……但同样,至少它是有效的。希望它会有所帮助。

library('shiny')
library('shinydashboard')
library('leaflet')
library('dismo')
library('ggmap')
library('dplyr')

shinyApp(
  ui = dashboardPage(
    dashboardHeader(title=""),

    dashboardSidebar(width = 200 ),

    dashboardBody(   

      fluidRow(
        conditionalPanel(
          condition = 'output.condition == 0',
          plotOutput("USA_GoogleMap",dblclick='plot_dblclick')
        ),
        leafletOutput("leaflet_map"),
        textOutput('condition'),
        tags$head(tags$style("#condition{font-size: 0px}"))

      )
    )),

  server=function(input, output, session) {

    double_clicked <- reactiveValues(

      center = NULL 
    )

    # Handle double clicks on the plot

    observeEvent(input$plot_dblclick, {

      double_clicked$center <- c(input$plot_dblclick$x,input$plot_dblclick$y)

    })

    output$USA_GoogleMap<-renderPlot({
      if(is.null(double_clicked$center)){
        statesMap = map_data("state")

        xy=cbind(statesMap$long,statesMap$lat)
        y=c(36.4,41.5,42.25,27.7,32.77)
        x=c(-115.5,-100,-75,-81.5,-97.45)
        state=c("Nevada","Nebraska","New York","Florida","Texas")
        bases=cbind(x,y)
        bases_mercator=data_frame(Mercator_X=Mercator(bases)[,1],Mercator_Y=Mercator(bases)[,2],State=state)

        g = gmap(xy, type='satellite',zoom=4)   
        plot(g, inter=TRUE)
        points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("white", alpha=0.2))
        points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("yellow", alpha=0.4))
        text(bases_mercator$Mercator_X,bases_mercator$Mercator_Y,state)

      }

    })


    output$leaflet_map <- renderLeaflet({
      if(!is.null(double_clicked$center)){

        leaflet()%>%setView(lng = -71.0589, lat = 42.3601, zoom = 12)%>%addTiles()
      }
    })

    output$condition <- renderText({
      ifelse(!is.null(double_clicked$center), 1, 0)
    })

  }

)

关于在 R shiny 中双击将 plotoutput 替换为 leafletoutput,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/41026597/

相关文章:

r - 使用 R 在列中抓取图像

r - 如何根据不同的类别找到多少个唯一值

r - 传单绘图工具栏 : allow only editing and deleting but not adding new markers in R Shiny

javascript - 在 Shiny 环境中将 Leaflet 控件放在 map div 之外

javascript - 在 Knockout 中调整 Leaflet JS map 的大小

r - 更改 ggpairs 中的对角线图

r - 升级 R 后无法安装 devtools 包

r - R : How to customize the coloring of clusters?的传单

javascript - 如何使用 Shadow DOM 中的 div 作为 Leaflet map 容器?

javascript - 数据切换选项卡不下载传单 map