DT代理显示无数据
DT proxy displays no data
我尝试构建的应用程序有问题。我有一个大数据 table（部分如下所示），我试图根据用户输入进行过滤。侧面板允许用户 select 仪表、日期范围，然后是所需的列（即降水和温度）。如果列复选框被 selected，则显示过滤器选项，允许过滤行。一旦用户点击提交按钮，table 应该根据所有选择的输入进行渲染。整个数据 table 在我加载应用程序时呈现，但是一旦我选择过滤器然后单击提交，table 输出显示“table 中没有可用数据”“显示 0 到 0，共 0条目。”应该有数据显示，因为我尝试的值在其中。也许我不应该使用代理 table 来过滤？我不希望 table 在每次更改过滤器时更新（因为它是一个大数据集），只是在按下提交按钮时。任何帮助将不胜感激。
# load libraries
library(tidyverse)
library(DT)
library(rgdal)
library(shiny)
library(shinyjs) #shiny java script with R language
library(here)
# import dataset
allvarsdata = readRDS(here("Scripts/shiny app/allvarsdata.RDS")) #datatable
varsdata = as_tibble(allvarsdata)
A tibble: 6 x 4
GaugeID DATE PRCP TAIR
<chr> <date> <dbl> <dbl>
1 01013500 1980-10-01 3.1 3.1
2 01435762 1980-10-02 4.24 10.5
3 01837490 1980-10-03 8.02 11.8
4 02947591 1980-10-04 15.3 7.38
5 03048601 1980-10-05 8.48 4.8
6 09385031 2014-12-06 0 5.41
###############################################
ui = fluidPage(
# implement shiny js features
useShinyjs(),
titlePanel(),
tabsetPanel(
tabPanel(title = "Data",
sidebarLayout(
sidebarPanel(
# gauge selection, pull down with all 671 gauges
selectInput(inputId = "gauge1", label = "Select USGS Gauge(s)",
choices = sort(unique(allvarsdata$GaugeID)),
selected = NULL, multiple = TRUE),
# two buttons to 1) select all gauges and 2) clear the selections
fluidRow(
column(width = 6, actionButton("selectall", "Select all")),
column(width = 6, actionButton("clear", "Clear"))
), #fluidRow close
# date range selection for entire record
dateRangeInput(inputId = "daterange", label = "Select date range",
start = "1981-01-01", end = "2014-12-31",
min = "1981-01-01", max = "2014-12-31",
format = "yyyy-mm-dd", separator = " - "),
# checkbox to select precipitation column
checkboxInput(inputId = "prcp", label = "Precipitation", value = FALSE),
conditionalPanel( #display slider when box checked, filter rows based on slider
condition = "input.prcp",
sliderInput(inputId = "prcp1", label = "mm/day",
min = 0, max = 200, value = c(50, 100), ticks = FALSE)),
checkboxInput(inputId = "temp", label = "Temperature", value = FALSE),
conditionalPanel(
condition = "input.temp",
sliderInput(inputId = "temp1", label = "Celcius",
min = -45, max = 40, value = c(0, 20), ticks = FALSE)),
# submit button to filter/select data based on all user inputs, only when clicked
actionButton(inputId = "submit1",
label = "Submit")
), #sidebarPanel close
mainPanel(
DT::DTOutput(outputId = "filteredtable")
) #mainPanel close
) # sidebarLayout close
), #tabPanel close
) # tabsetPanel close
) # fluidPage close
### SERVER ###
server = function(input, output, session) {
# create reactive values based on allvarsdata
filtered = reactiveValues(fdat = varsdata)
output$filteredtable = DT::renderDT({
isolate(filtered$fdat) # render DT with no dependency between data and render function
}, options = list(paging = TRUE, processing = TRUE))
proxy = DT::dataTableProxy("filteredtable") #updates data instead of using render function
observe({
DT::replaceData(proxy, filtered$fdat)
})
observeEvent(input$submit1, { #wrap all filters within the submit action button
filtered$fdat = filtered$fdat %>%
dplyr::filter(GaugeID == input$gauge1,
DATE >= input$daterange[1], DATE <= input$daterange[2],
PRCP >= input$prcp1[1], PRCP <= input$prcp1[2],
TAIR >= input$temp1[1], TAIR <= input$temp1[2])
# if no gauge is selected, return no results
if(is.null(input$gauge1)) {
return(NULL)
}
if(is.null(input$prcp)) { # if precip box is not checked, remove precip column
filtered$fdat = filtered$fdat %>%
select(-PRCP)
}
if(is.null(input$temp)) { # if temp box is not checked, remove temp column from data table
filtered$fdat = filtered$fdat %>%
select(-TAIR)
}
filtered$fdat
}) #observeEvent close (submit)
# clear selected gauges button based on shinyjs reset function
observeEvent(input$clear, {
reset("gauge1")
})
# select all gauges button
observeEvent(input$selectall, {
if(input$selectall) {
updateSelectInput(session = session, "gauge1",
selected = varsdata$GaugeID)
}
})
} # server close bracket
# Run the application
shinyApp(ui = ui, server = server)
由 reprex package (v2.0.0)
于 2021-07-15 创建
您在过滤时遇到了一些问题。
- 你的约会对象很个性
- 变量
input$prcp和input$temp符合逻辑
- 即使变量不存在（
temp1 和 prcp1）也会执行过滤
解决这些问题后，您就不需要代理了，因为您的对象是 reactiveValues 对象。试试这个
varsdata <- read.table(text="GaugeID DATE PRCP TAIR
1 01013500 1980-10-01 3.1 3.1
2 01435762 1980-10-02 4.24 10.5
3 01837490 1980-10-03 8.02 11.8
4 02947591 1980-10-04 15.3 7.38
5 03048601 1980-10-05 8.48 4.8
6 09385031 2014-12-06 0 5.41", header=T)
allvarsdata <- varsdata
###############################################
ui = fluidPage(
# implement shiny js features
useShinyjs(),
#titlePanel(),
tabsetPanel(id = "tabs",
tabPanel(title = "Data",
sidebarLayout(
sidebarPanel(
# gauge selection, pull down with all 671 gauges
selectInput(inputId = "gauge1", label = "Select USGS Gauge(s)",
choices = sort(unique(allvarsdata$GaugeID)),
selected = NULL, multiple = TRUE),
# two buttons to 1) select all gauges and 2) clear the selections
fluidRow(
column(width = 6, actionButton("selectall", "Select all")),
column(width = 6, actionButton("clear", "Clear"))
), #fluidRow close
# date range selection for entire record
dateRangeInput(inputId = "daterange", label = "Select date range",
start = "1980-01-01", end = "2014-12-31",
min = "1980-01-01", max = "2014-12-31",
format = "yyyy-mm-dd", separator = " - "),
# checkbox to select precipitation column
checkboxInput(inputId = "prcp", label = "Precipitation", value = FALSE),
conditionalPanel( #display slider when box checked, filter rows based on slider
condition = "input.prcp",
sliderInput(inputId = "prcp1", label = "mm/day",
min = 0, max = 200, value = c(0, 100), ticks = FALSE)),
checkboxInput(inputId = "temp", label = "Temperature", value = FALSE),
conditionalPanel(
condition = "input.temp",
sliderInput(inputId = "temp1", label = "Celcius",
min = -45, max = 40, value = c(0, 20), ticks = FALSE)),
# submit button to filter/select data based on all user inputs, only when clicked
actionButton(inputId = "submit1", label = "Submit")
), #sidebarPanel close
mainPanel(
DTOutput(outputId = "filteredtable")
) #mainPanel close
) # sidebarLayout close
) #tabPanel close
) # tabsetPanel close
) # fluidPage close
### SERVER ###
server = function(input, output, session) {
# create reactive values based on allvarsdata
filtered = reactiveValues(fdat = varsdata)
output$filteredtable = renderDT({
filtered$fdat # render DT with no dependency between data and render function
}, options = list(paging = TRUE, processing = TRUE))
# proxy = DT::dataTableProxy("filteredtable") #updates data instead of using render function
# observe({
# DT::replaceData(proxy, filtered$fdat)
# })
fdata <- eventReactive(input$submit1, {
# if no gauge is selected, return no results
if(is.null(input$gauge1)) {
filteredt <- NULL
}else{
filteredt = varsdata %>%
dplyr::filter(GaugeID %in% input$gauge1, as.Date(DATE) >= as.Date(input$daterange[1]), as.Date(DATE) <= as.Date(input$daterange[2]))
if(input$prcp) { # if precip box is not checked, remove precip column
filteredt = filteredt %>% dplyr::filter(PRCP >= input$prcp1[1], PRCP <= input$prcp1[2])
} else {
filteredt = filteredt %>% select(-PRCP)
}
if(input$temp) { # if temp box is not checked, remove temp column from data table
filteredt = filteredt %>% dplyr::filter(TAIR >= input$temp1[1], TAIR <= input$temp1[2])
}else {
filteredt = filteredt %>% select(-TAIR)
}
}
filteredt
})
observeEvent(input$submit1, {
filtered$fdat <- fdata()
}) #observeEvent close (submit)
# clear selected gauges button based on shinyjs reset function
observeEvent(input$clear, {
reset("gauge1")
})
# select all gauges button
observeEvent(input$selectall, {
if(input$selectall) {
updateSelectInput(session = session, "gauge1",
selected = varsdata$GaugeID)
}
})
} # server close bracket
# Run the application
shinyApp(ui = ui, server = server)
我尝试构建的应用程序有问题。我有一个大数据 table（部分如下所示），我试图根据用户输入进行过滤。侧面板允许用户 select 仪表、日期范围，然后是所需的列（即降水和温度）。如果列复选框被 selected，则显示过滤器选项，允许过滤行。一旦用户点击提交按钮，table 应该根据所有选择的输入进行渲染。整个数据 table 在我加载应用程序时呈现，但是一旦我选择过滤器然后单击提交，table 输出显示“table 中没有可用数据”“显示 0 到 0，共 0条目。”应该有数据显示，因为我尝试的值在其中。也许我不应该使用代理 table 来过滤？我不希望 table 在每次更改过滤器时更新（因为它是一个大数据集），只是在按下提交按钮时。任何帮助将不胜感激。
# load libraries
library(tidyverse)
library(DT)
library(rgdal)
library(shiny)
library(shinyjs) #shiny java script with R language
library(here)
# import dataset
allvarsdata = readRDS(here("Scripts/shiny app/allvarsdata.RDS")) #datatable
varsdata = as_tibble(allvarsdata)
A tibble: 6 x 4
GaugeID DATE PRCP TAIR
<chr> <date> <dbl> <dbl>
1 01013500 1980-10-01 3.1 3.1
2 01435762 1980-10-02 4.24 10.5
3 01837490 1980-10-03 8.02 11.8
4 02947591 1980-10-04 15.3 7.38
5 03048601 1980-10-05 8.48 4.8
6 09385031 2014-12-06 0 5.41
###############################################
ui = fluidPage(
# implement shiny js features
useShinyjs(),
titlePanel(),
tabsetPanel(
tabPanel(title = "Data",
sidebarLayout(
sidebarPanel(
# gauge selection, pull down with all 671 gauges
selectInput(inputId = "gauge1", label = "Select USGS Gauge(s)",
choices = sort(unique(allvarsdata$GaugeID)),
selected = NULL, multiple = TRUE),
# two buttons to 1) select all gauges and 2) clear the selections
fluidRow(
column(width = 6, actionButton("selectall", "Select all")),
column(width = 6, actionButton("clear", "Clear"))
), #fluidRow close
# date range selection for entire record
dateRangeInput(inputId = "daterange", label = "Select date range",
start = "1981-01-01", end = "2014-12-31",
min = "1981-01-01", max = "2014-12-31",
format = "yyyy-mm-dd", separator = " - "),
# checkbox to select precipitation column
checkboxInput(inputId = "prcp", label = "Precipitation", value = FALSE),
conditionalPanel( #display slider when box checked, filter rows based on slider
condition = "input.prcp",
sliderInput(inputId = "prcp1", label = "mm/day",
min = 0, max = 200, value = c(50, 100), ticks = FALSE)),
checkboxInput(inputId = "temp", label = "Temperature", value = FALSE),
conditionalPanel(
condition = "input.temp",
sliderInput(inputId = "temp1", label = "Celcius",
min = -45, max = 40, value = c(0, 20), ticks = FALSE)),
# submit button to filter/select data based on all user inputs, only when clicked
actionButton(inputId = "submit1",
label = "Submit")
), #sidebarPanel close
mainPanel(
DT::DTOutput(outputId = "filteredtable")
) #mainPanel close
) # sidebarLayout close
), #tabPanel close
) # tabsetPanel close
) # fluidPage close
### SERVER ###
server = function(input, output, session) {
# create reactive values based on allvarsdata
filtered = reactiveValues(fdat = varsdata)
output$filteredtable = DT::renderDT({
isolate(filtered$fdat) # render DT with no dependency between data and render function
}, options = list(paging = TRUE, processing = TRUE))
proxy = DT::dataTableProxy("filteredtable") #updates data instead of using render function
observe({
DT::replaceData(proxy, filtered$fdat)
})
observeEvent(input$submit1, { #wrap all filters within the submit action button
filtered$fdat = filtered$fdat %>%
dplyr::filter(GaugeID == input$gauge1,
DATE >= input$daterange[1], DATE <= input$daterange[2],
PRCP >= input$prcp1[1], PRCP <= input$prcp1[2],
TAIR >= input$temp1[1], TAIR <= input$temp1[2])
# if no gauge is selected, return no results
if(is.null(input$gauge1)) {
return(NULL)
}
if(is.null(input$prcp)) { # if precip box is not checked, remove precip column
filtered$fdat = filtered$fdat %>%
select(-PRCP)
}
if(is.null(input$temp)) { # if temp box is not checked, remove temp column from data table
filtered$fdat = filtered$fdat %>%
select(-TAIR)
}
filtered$fdat
}) #observeEvent close (submit)
# clear selected gauges button based on shinyjs reset function
observeEvent(input$clear, {
reset("gauge1")
})
# select all gauges button
observeEvent(input$selectall, {
if(input$selectall) {
updateSelectInput(session = session, "gauge1",
selected = varsdata$GaugeID)
}
})
} # server close bracket
# Run the application
shinyApp(ui = ui, server = server)
由 reprex package (v2.0.0)
于 2021-07-15 创建您在过滤时遇到了一些问题。
- 你的约会对象很个性
- 变量
input$prcp和input$temp符合逻辑 - 即使变量不存在（
temp1和prcp1）也会执行过滤
解决这些问题后，您就不需要代理了，因为您的对象是 reactiveValues 对象。试试这个
varsdata <- read.table(text="GaugeID DATE PRCP TAIR
1 01013500 1980-10-01 3.1 3.1
2 01435762 1980-10-02 4.24 10.5
3 01837490 1980-10-03 8.02 11.8
4 02947591 1980-10-04 15.3 7.38
5 03048601 1980-10-05 8.48 4.8
6 09385031 2014-12-06 0 5.41", header=T)
allvarsdata <- varsdata
###############################################
ui = fluidPage(
# implement shiny js features
useShinyjs(),
#titlePanel(),
tabsetPanel(id = "tabs",
tabPanel(title = "Data",
sidebarLayout(
sidebarPanel(
# gauge selection, pull down with all 671 gauges
selectInput(inputId = "gauge1", label = "Select USGS Gauge(s)",
choices = sort(unique(allvarsdata$GaugeID)),
selected = NULL, multiple = TRUE),
# two buttons to 1) select all gauges and 2) clear the selections
fluidRow(
column(width = 6, actionButton("selectall", "Select all")),
column(width = 6, actionButton("clear", "Clear"))
), #fluidRow close
# date range selection for entire record
dateRangeInput(inputId = "daterange", label = "Select date range",
start = "1980-01-01", end = "2014-12-31",
min = "1980-01-01", max = "2014-12-31",
format = "yyyy-mm-dd", separator = " - "),
# checkbox to select precipitation column
checkboxInput(inputId = "prcp", label = "Precipitation", value = FALSE),
conditionalPanel( #display slider when box checked, filter rows based on slider
condition = "input.prcp",
sliderInput(inputId = "prcp1", label = "mm/day",
min = 0, max = 200, value = c(0, 100), ticks = FALSE)),
checkboxInput(inputId = "temp", label = "Temperature", value = FALSE),
conditionalPanel(
condition = "input.temp",
sliderInput(inputId = "temp1", label = "Celcius",
min = -45, max = 40, value = c(0, 20), ticks = FALSE)),
# submit button to filter/select data based on all user inputs, only when clicked
actionButton(inputId = "submit1", label = "Submit")
), #sidebarPanel close
mainPanel(
DTOutput(outputId = "filteredtable")
) #mainPanel close
) # sidebarLayout close
) #tabPanel close
) # tabsetPanel close
) # fluidPage close
### SERVER ###
server = function(input, output, session) {
# create reactive values based on allvarsdata
filtered = reactiveValues(fdat = varsdata)
output$filteredtable = renderDT({
filtered$fdat # render DT with no dependency between data and render function
}, options = list(paging = TRUE, processing = TRUE))
# proxy = DT::dataTableProxy("filteredtable") #updates data instead of using render function
# observe({
# DT::replaceData(proxy, filtered$fdat)
# })
fdata <- eventReactive(input$submit1, {
# if no gauge is selected, return no results
if(is.null(input$gauge1)) {
filteredt <- NULL
}else{
filteredt = varsdata %>%
dplyr::filter(GaugeID %in% input$gauge1, as.Date(DATE) >= as.Date(input$daterange[1]), as.Date(DATE) <= as.Date(input$daterange[2]))
if(input$prcp) { # if precip box is not checked, remove precip column
filteredt = filteredt %>% dplyr::filter(PRCP >= input$prcp1[1], PRCP <= input$prcp1[2])
} else {
filteredt = filteredt %>% select(-PRCP)
}
if(input$temp) { # if temp box is not checked, remove temp column from data table
filteredt = filteredt %>% dplyr::filter(TAIR >= input$temp1[1], TAIR <= input$temp1[2])
}else {
filteredt = filteredt %>% select(-TAIR)
}
}
filteredt
})
observeEvent(input$submit1, {
filtered$fdat <- fdata()
}) #observeEvent close (submit)
# clear selected gauges button based on shinyjs reset function
observeEvent(input$clear, {
reset("gauge1")
})
# select all gauges button
observeEvent(input$selectall, {
if(input$selectall) {
updateSelectInput(session = session, "gauge1",
selected = varsdata$GaugeID)
}
})
} # server close bracket
# Run the application
shinyApp(ui = ui, server = server)