我在诸如here之类的SO各种帖子之间进行了混合，在学习如何开发Shiny应用程序方面取得了一些进步。
我已经成功地基于放置在DataTables中的checkboxInputs过滤了一个data.frame，但是我没有设法保留它们或在更改自定义过滤器后重置它们。我猜那是因为它也与JS有关，我不知道它如何与Shiny交互。
如果您在弄乱我的应用程序，会发现在更改过滤器（即原始过滤器）之后或之前，您可以选择已选中复选框的任意组合，并在另一个选项卡上检索经过正确过滤的表格。 更改过滤器后，或者在选中复选框之前更改过滤器，都不会发生这种情况。
我想要的
选择一个过滤器（在下面的示例中为input $ mpg），保留当前的过滤器选择（即，如果我更改mpg并回到上一个选择，我将保留选中的复选框），并将所有选定的行绑定/附加到我在“所有汽车”部分中选择的数据表（“授权汽车”部分中的那个）。
在完全可复制的应用程序中，我的代码如下：
Sys.setenv(JAVA_HOME='C:\\Program Files\\Java\\jre1.8.0_201')
library(tidyverse)
library(shiny)
library(DT)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
list(ui = fluidPage(
tabsetPanel(
tabPanel(
title = "All Cars",
headerPanel('Car Selector'),
sidebarPanel(
selectInput("mpg","Miles per Galon:",
choices=unique(mymtcars$mpg),
selected=unique(mymtcars$mpg)[1]),
actionButton("authorise","Authorise Selection")
),
mainPanel(
DT::dataTableOutput("mytable")
)
),
tabPanel(
title = "Authorised Cars",
mainPanel(
DT::dataTableOutput("authorised"))
)
)
)
, server = function(input, output, session) {
filtered_data <- reactive({
data <- subset(mymtcars,
mpg %in% input$mpg
)
data
})
shinyInput <- function(FUN,id,num,...) {
inputs <- character(num)
for (i in seq_len(num)) {
inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
}
inputs
}
rowSelect <- reactive({
rows=names(input)[grepl(pattern = "srows_",names(input))]
paste(unlist(lapply(rows,function(i){
if(input[[i]]==T){
return(filtered_data()$mpg[as.numeric(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))])
}
})))
})
mytable <- reactive({
cbind(Approve=shinyInput(checkboxInput,"srows_",nrow(filtered_data()),value=NULL,width=1), filtered_data())
})
output$mytable <- DT::renderDataTable({
DT::datatable(mytable(),
options = list(orderClasses = TRUE,
lengthMenu = c(5, 25, 50),
pageLength = 25 ,
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}')
),selection='none',escape=F)
})
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
authorised.cars <-
reactive({
df1 <- data.frame(Authorised=shinyValue("srows_",nrow(mytable())),mytable()) %>%
filter(Authorised == 1)
df1
}
)
output$authorised <- DT::renderDataTable({
df1 <- select(authorised.cars(),-Approve)
df1
})
})
)
将我的sessionInfo（）放在此处也可能很有价值：
R version 3.5.0 (2018-04-23)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)
Matrix products: default
locale:
[1] LC_COLLATE=Spanish_Spain.1252 LC_CTYPE=Spanish_Spain.1252
[3] LC_MONETARY=Spanish_Spain.1252 LC_NUMERIC=C
[5] LC_TIME=Spanish_Spain.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] data.table_1.11.4 magrittr_1.5 shinydashboard_0.7.1 DT_0.4
[5] shiny_1.1.0 lubridate_1.7.4 mailR_0.4.1 forcats_0.3.0
[9] stringr_1.3.1 dplyr_0.8.0.1 purrr_0.2.5 readr_1.1.1
[13] tidyr_0.8.1 tibble_2.0.1 ggplot2_3.0.0.9000 tidyverse_1.2.1
[17] openxlsx_4.1.0 DBI_1.0.0 RODBC_1.3-15
loaded via a namespace (and not attached):
[1] tidyselect_0.2.5 rJava_0.9-10 haven_1.1.2 lattice_0.20-35 sourcetools_0.1.7
[6] colorspace_1.3-2 htmltools_0.3.6 yaml_2.1.19 rlang_0.3.1 later_0.7.3
[11] R.oo_1.22.0 pillar_1.3.1 glue_1.3.0 withr_2.1.2 R.utils_2.8.0
[16] modelr_0.1.2 readxl_1.1.0 plyr_1.8.4 munsell_0.5.0 gtable_0.2.0
[21] cellranger_1.1.0 rvest_0.3.2 R.methodsS3_1.7.1 zip_1.0.0 htmlwidgets_1.2
[26] crosstalk_1.0.0 httpuv_1.4.4.1 broom_0.5.0 Rcpp_1.0.0 xtable_1.8-2
[31] promises_1.0.1 scales_0.5.0 backports_1.1.2 jsonlite_1.5 mime_0.5
[36] hms_0.4.2 digest_0.6.15 stringi_1.1.7 grid_3.5.0 cli_1.0.1
[41] tools_3.5.0 lazyeval_0.2.1 crayon_1.3.4 pkgconfig_2.0.2 rsconnect_0.8.12
[46] xml2_1.2.0 assertthat_0.2.0 httr_1.3.1 rstudioapi_0.7 R6_2.2.2
[51] nlme_3.1-137 compiler_3.5.0
感谢您的帮助！