问题
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.
The user should also be able to update the depth and stations values by multiplying all of them with the numericInput() value1 and value2 respectively 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. I have used shinyjs() like proposed in this solution but it does not work.
In order to execute app please upload this excel file.
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')
I believe that the main reason my method does not work is due to file upload and this is why I do not use it as it is and I have to upload it first.
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)
来源：https://stackoverflow.com/questions/64027378/shinyjs-is-not-working-properly-due-to-shiny-reactivity