R Shinyjs由于光泽反应性而无法正常工作

我在下面有一个闪亮的应用程序，用户在其中上传一个文件（这里我只是把dt放在一个反应函数中），从那里他可以通过

pickerInput（）

选择要显示为

selectInput（）

的列。然后他应该能够点击

Update2

并查看地图

用户还应该能够更新

深度

和

站

值，方法是将所有值分别乘以

数值输入（）

value1

和

value2

，并创建一个新的

sliderInput（）

，从而更新表中显示的数据帧。只有当用户单击

Update2

action按钮时，才能应用这些更改

当我点击一个特定的点时，我会在地图下面看到一个表格，上面有相关的数据。问题是，当我执行另一个操作（例如更新地图或其他操作）时，该表仍保留在那里，而我希望它消失，并在再次单击某个点时重新出现。我使用了解决方案中建议的shinyjs（），但它不起作用

为了执行应用程序，请上传此excel文件

library(openxlsx)

# read data from an Excel file or Workbook object into a data.frame
df <- read.xlsx('quakes.xlsx')

# for writing a data.frame or list of data.frames to an xlsx file
write.xlsx(quakes, 'quakes.xlsx')

库（openxlsx）
#将Excel文件或工作簿对象中的数据读取到data.frame中
df您能否尝试获得一个更紧凑的代码示例，该示例不使用那么多的包和代码行？如果你在一个小例子中重现这个问题，那么更有可能有人能够提供帮助。将问题隔离到更小的代码段确实需要更多的时间，但距离解决方案还有一半：）
library(shiny)
library(rgdal)
library(leaflet.extras)
library(leaflet)
library(dplyr)
library(shinyWidgets)
library(readxl)
library(Hmisc)
library(DT)
# ui object
options(shiny.maxRequestSize = 45*1024^2)
ui <- fluidPage(
  shinyjs::useShinyjs(),# Set up shinyjs
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose xlsx file',
                accept = c(".xlsx")
      ),
      uiOutput("inputp1"),
      #Add the output for new pickers
      uiOutput("pickers")
      
    ),
    
    mainPanel(
      leafletOutput("map"),
      tableOutput("myTable"),
      tags$h4("Adjust Values of Selected/Filtered Data"),
      tags$hr(),
      uiOutput("ass"),
      uiOutput("mrk"),
      tags$hr(),
      actionButton("button2", "Apply values")
      
    )
  )
)

# server()
server <- function(input, output, session) {
  DF1 <- reactiveValues(data=NULL)
  
  #dt <- reactive({
  
  # dt<-data.frame(quakes)
  #})
  xl<-reactive({
    req(input$file1)
    
    inFile <- input$file1
    
    dat<-read_excel(inFile$datapath)
    dat<-data.frame(dat)
    dat$ID <- seq.int(nrow(dat))
    if("depth" %in% colnames(dat)&"stations" %in% colnames(dat)){
      dat$depth<-as.numeric(dat$depth)/5
      dat$stations<-as.numeric(dat$stations)/5
      
      
    }
    else if("ass_val_tot" %in% colnames(dat)&"mkt_val_tot" %nin% colnames(dat)){
      dat$depth<-as.numeric(dat$depth)/5
      
    }
    else if("ass_val_tot" %nin% colnames(dat)&"mkt_val_tot" %in% colnames(dat)){
      dat$stations<-as.numeric(dat$stations)/5
      
    }
    return(dat)
    
    
  })
  observe({
    DF1$data <- xl()
  })
  
  output$inputp1 <- renderUI({
    pickerInput(
      inputId = "p1",
      label = "Select Column headers",
      choices = colnames( xl()),
      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]])) {
          pickerInput(
            inputId = x#The colname of selected column
            ,
            label = x #The colname of selected column
            ,
            choices = as.character(unique(dt1[,x]))#all rows of selected column
            ,
            multiple = TRUE,options = list(`actions-box` = TRUE)
            
          )
        }
        else{
          pickerInput(
            inputId = x#The colname of selected column
            ,
            label = x #The colname of selected column
            ,
            choices = as.character(unique(dt1[,x]))#all rows of selected column
            ,
            multiple = TRUE,options = list(`actions-box` = TRUE)
            
          )
        }
        
        
      }))
    })
  })
  
  output$ass<-renderUI({
    # Copy the line below to make a number input box into the UI.
    numericInput("num1", label = ("Stations"), value = 1)
    
    
    
  })
  output$mrk<-renderUI({
    # Copy the line below to make a number input box into the UI.
    numericInput("num2", label = ("Depth"), value = 1)
    
  })
  dt2 <- eventReactive(input$button2, {
    req(input$num1)
    req(input$num2)
    
    dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
    if("depth" %in% colnames(xl())&"stations" %in% colnames(xl())){
      dt$depth<-as.numeric(dt$depth)*isolate(input$num1)
      dt$stations<-as.numeric(dt$stations)*isolate(input$num2)
    }
    else if("depth" %in% colnames(xl())&"stations" %nin% colnames(xl())){
      dt$depth<-as.numeric(dt$depth)*isolate(input$num1)
    }
    else if("depth" %nin% colnames(xl())&"stations" %nin% colnames(xl())){
      dt$depth<-as.numeric(dt$stations)*isolate(input$num2)
      
    }
    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){
        
        
          pal <- colorNumeric(
            palette = "RdYlBu",
            domain = isolate(dt_part$depth)
          )
          leaflet(isolate(dt_part)) %>%
            addProviderTiles(providers$CartoDB.Positron) %>%
            setView( 178, -20, 5
            ) %>%
            addHeatmap(
              lng = isolate(dt_part$long), lat = isolate(dt_part$lat), intensity = isolate(dt_part$depth),
              blur = 20, max = 0.05, radius = 15
            ) %>%addCircleMarkers(lng = isolate(dt_part$long), lat = isolate(dt_part$lat), layerId = dt_part$ID,
                                 fillOpacity = 0, weight = 0,
                                 popup = paste("Parcel ID:",isolate(dt_part$ID) , "<br>",
                                               "Assessed Value:",isolate(dt_part$depth),"<br>"
                                 ),
                                 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({
      n<-subset(dt_part,ID == data$clickedMarker$id)
      shinyjs::runjs("console.log('showing table')")
      shinyjs::runjs("$('#myTable').show()")
      return(
        n<-n[1:3,1:3]
      )
    })
  })
  
}

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