在闪亮的应用程序中更新数据后,隐藏由传单地图上的点击事件创建的表 [英] Hide table that is created by click-event on leaflet map after data is updated in a shiny app

查看:45
本文介绍了在闪亮的应用程序中更新数据后,隐藏由传单地图上的点击事件创建的表的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我下面有一个闪亮的应用程序,用户可以在其中上传文件(这里我只是将dt放入了反应函数中),然后他可以从中选择要显示为 selectInput()通过 pickerInput().然后他应该可以点击Update2 并查看地图.

I have the shiny app below in which the user uploads a file (here I just put the dt in a reactive function) and from there he can choose which columns he wants to display as selectInput() via a pickerInput(). Then he should be able to click on Update2 and see the map.

用户还应该能够通过将所有值乘以 numericInput() value1 来更新 depth 值,并创建一个新的 sliderInput(),因此也将更新表中显示的数据框.仅当用户单击 Update2 操作按钮时,才应应用这些更改.

The user should also be able to update the depth values by multiplying all of them with the numericInput() value1 and create a new sliderInput() and therefore update the dataframe that is displayed in the table as well. These changes should be applied only when the user clicks on Update2 actionbutton.

当我单击特定点时,会在地图下方显示一个带有相关数据的表格.问题是,当我执行另一个操作时,例如更新地图或其他操作,该表会保留在那里,而我希望它在我再次单击某个点时消失并重新出现.

When I click on a specific point I get a table below the map with relative data. The issue is that when I do another action,for example update the map or something, this table remains there while I want it to be disappeared and re-appeared when I click on a point again.

library(shiny)
library(shinyWidgets)
library(DT)
library(leaflet)
library(leaflet.extras)
# ui object

ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            uiOutput("inputp1"),
            #Add the output for new pickers
            uiOutput("pickers"),
            numericInput("num", label = ("value"), value = 1),
            actionButton("button2", "Update 2")
        ),
        
        mainPanel(
            leafletOutput("map"),
            tableOutput("myTable")
            
            
            
        )
    )
)

# server()
server <- function(input, output, session) {
    DF1 <- reactiveValues(data=NULL)
    
    dt <- reactive({
        
        dt<-data.frame(quakes)
        dt$ID <- seq.int(nrow(dt))
        dt
    })
    
    observe({
        DF1$data <- dt()
    })

    output$inputp1 <- renderUI({
        pickerInput(
            inputId = "p1",
            label = "Select Column headers",
            choices = colnames( dt()),
            multiple = TRUE,
            options = list(`actions-box` = TRUE)
        )
    })
    
    observeEvent(input$p1, {
        #Create the new pickers
        output$pickers<-renderUI({
            dt1 <- DF1$data
            div(lapply(input$p1, function(x){
                if (is.numeric(dt1[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
                }else { # if (is.factor(dt1[[x]])) {
                    selectInput(
                        inputId = x,       # The col name of selected column
                        label = x,         # The col label of selected column
                        choices = dt1[,x], # all rows of selected column
                        multiple = TRUE
                    )
                }
                
            }))
        })
    })
    dt2 <- eventReactive(input$button2, {
        req(input$num)
        
        dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
        dt$depth<-dt$depth*isolate(input$num)
        
        dt
    })
    observe({DF1$data <- dt2()})
    observeEvent(input$button2, {
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt2()
        colname <- colnames(dt2())
        for (colname in input$p1) {
            if (!is.null(input[[colname]][[1]]) && is.numeric(input[[colname]][[1]])) {
                dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
            }else {
                if (!is.null(input[[colname]])) {
                    dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
                }
            }
        }
        
    output$map<-renderLeaflet({input$button2
        if (input$button2){
        leaflet(dt_part) %>%
            addProviderTiles(providers$CartoDB.DarkMatter) %>%
            setView( 178, -20, 5 ) %>%
            addHeatmap(
                lng = ~long, lat = ~lat, intensity = ~mag,
                blur = 20, max = 0.05, radius = 15
            ) %>% 
            addCircleMarkers(lng = dt_part$long, lat = dt_part$lat, layerId = dt_part$depth,
                             fillOpacity = 0, weight = 0,
                             popup = paste("ID:", dt_part$ID, "<br>",
                                           "Depth:", dt_part$depth, "<br>",
                                           "Stations:", dt_part$stations),
                             labelOptions = labelOptions(noHide = TRUE)) 
        }
        else{
            return(NULL)
        }
    })
    
   
    })
    
    
    
   
    data <- reactiveValues(clickedMarker=NULL)
    
    # observe the marker click info and print to console when it is changed.
    observeEvent(input$map_marker_click,{
        dt_part <- dt2()
        
        print("observed map_marker_click")
        data$clickedMarker <- input$map_marker_click
        print(data$clickedMarker)
        output$myTable <- renderTable({
            return(
                subset(dt_part,depth == data$clickedMarker$id)
            )
        })
    })
}

# shinyApp()
shinyApp(ui = ui, server = server)

推荐答案

我认为最简单的方法是使用包 shinyjs ,在那里您可以使用jQuery函数隐藏和显示您想要的对象.请注意,您还必须在UI部分中使用函数 useShinyjs()激活Shinyjs

Hi I think the easiest way to do this is to use the package shinyjs there you can use the jQuery functions to hide and show objects you want. Please note that you have to activate shinyjs with the function useShinyjs() inthe UI part aswell

ui <- fluidPage(
  shinyjs::useShinyjs(),# Set up shinyjs
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("inputp1"),
      #Add the output for new pickers
      uiOutput("pickers"),
      numericInput("num", label = ("value"), value = 1),
      actionButton("button2", "Update 2")
    ),
    
    mainPanel(
      leafletOutput("map"),
      tableOutput("myTable")
      
      
      
    )
  )
)

# server()
server <- function(input, output, session) {
  DF1 <- reactiveValues(data=NULL)
  
  dt <- reactive({
    
    dt<-data.frame(quakes)
    dt$ID <- seq.int(nrow(dt))
    dt
  })
  
  observe({
    DF1$data <- dt()
  })
  
  output$inputp1 <- renderUI({
    pickerInput(
      inputId = "p1",
      label = "Select Column headers",
      choices = colnames( dt()),
      multiple = TRUE,
      options = list(`actions-box` = TRUE)
    )
  })
  
  observeEvent(input$p1, {
    #Create the new pickers
    output$pickers<-renderUI({
      dt1 <- DF1$data
      div(lapply(input$p1, function(x){
        if (is.numeric(dt1[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
        }else { # if (is.factor(dt1[[x]])) {
          selectInput(
            inputId = x,       # The col name of selected column
            label = x,         # The col label of selected column
            choices = dt1[,x], # all rows of selected column
            multiple = TRUE
          )
        }
        
      }))
    })
  })
  dt2 <- eventReactive(input$button2, {
    req(input$num)
    
    dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
    dt$depth<-dt$depth*isolate(input$num)
    
    dt
  })
  observe({DF1$data <- dt2()})
  observeEvent(input$button2, {
    req(input$p1, sapply(input$p1, function(x) input[[x]]))
    dt_part <- dt2()
    colname <- colnames(dt2())
    shinyjs::runjs("console.log('hiding table')")
    shinyjs::runjs("$('#myTable').hide()")
    for (colname in input$p1) {
      if (!is.null(input[[colname]][[1]]) && is.numeric(input[[colname]][[1]])) {
        dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
      }else {
        if (!is.null(input[[colname]])) {
          dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
        }
      }
    }
    
    
    
    output$map<-renderLeaflet({input$button2
      if (input$button2){
        leaflet(dt_part) %>%
          addProviderTiles(providers$CartoDB.DarkMatter) %>%
          setView( 178, -20, 5 ) %>%
          addHeatmap(
            lng = ~long, lat = ~lat, intensity = ~mag,
            blur = 20, max = 0.05, radius = 15
          ) %>% 
          addCircleMarkers(lng = dt_part$long, lat = dt_part$lat, layerId = dt_part$depth,
                           fillOpacity = 0, weight = 0,
                           popup = paste("ID:", dt_part$ID, "<br>",
                                         "Depth:", dt_part$depth, "<br>",
                                         "Stations:", dt_part$stations),
                           labelOptions = labelOptions(noHide = TRUE)) 
      }
      else{
        return(NULL)
      }
    })
  })
  
  
  
  
  data <- reactiveValues(clickedMarker=NULL)
  
  # observe the marker click info and print to console when it is changed.
  observeEvent(input$map_marker_click,{
    dt_part <- dt2()
    print("observed map_marker_click")
    data$clickedMarker <- input$map_marker_click
    print(data$clickedMarker)
    output$myTable <- renderTable({
      shinyjs::runjs("console.log('showing table')")
      shinyjs::runjs("$('#myTable').show()")
      return(
        subset(dt_part,depth == data$clickedMarker$id)
      )
    })
  })
}

# shinyApp()
shinyApp(ui = ui, server = server)

这篇关于在闪亮的应用程序中更新数据后,隐藏由传单地图上的点击事件创建的表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆