在闪亮的应用程序中更新数据后隐藏通过点击事件在传单地图上创建的表

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

我有下面这个闪亮的应用程序,用户可以在其中上传文件(这里我只是将 dt 放入反应函数中),然后他可以通过

selectInput()
选择要显示为
pickerInput()
的列。然后他应该能够点击
Update2
并查看地图。

用户还应该能够通过将所有值与

depth
numericInput()
相乘来更新
value1
值并创建新的
sliderInput()
,从而更新表中显示的数据框。仅当用户单击
Update2
操作按钮时才应应用这些更改。

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

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)
r shiny r-leaflet
1个回答
1
投票

嗨,我认为最简单的方法是使用包

shinyjs
,您可以使用 jQuery 函数来隐藏和显示您想要的对象。请注意,您还必须使用UI部分中的功能
useShinyjs()
激活shinyjs

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)
© www.soinside.com 2019 - 2024. All rights reserved.