r - 如何根据闪亮应用程序中复选框的输入设置数据框中某些行的样式?
问题描述
我正在开发一个闪亮的应用程序,其中用户使用一些小部件交互式地过滤数据框。我的复选框之一称为“LOT”。此复选框的目的是将 x_LOT 或 Y_LOT 列的值为“真”的那些行染成黄色。
我试图在渲染表中包含一个条件,这样如果复选框的输入为真,对应的行就会被着色,但它不起作用。我试图编写用于其他过滤器的条件内部反应函数,但它也不起作用。
我的代码如下:
# MY DATA FRAME
df <- data.frame(Consequence = c(rep("x",4),rep("y",4),rep("z",4)),
CANONICAL = rep(c("YES","NO"),6),
x_LOT = c(rep("False", 3), rep("True", 5), rep("False",2), "True","False"),
y_LOT = c(rep("False", 8), rep("True",2), rep("False",2)),
x3=c(12,43,64,34,93,16,32,74,84,89,45,67))
write.csv(df, "df.csv")
# MY APP
library(shiny)
library(DT) # for data tables
library(dplyr)
library(shinyWidgets)
library(lazyeval)
library(data.table)
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Upload your File",multiple = FALSE,
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")),
pickerInput("Consequence", "Consequence:", choices = NULL, options = list(`actions-box` = TRUE),
selected = NULL, multiple = TRUE ),
prettyCheckbox(inputId = "CANONICAL", label = "CANONICAL", value = FALSE,
outline = TRUE, fill = TRUE, bigger = TRUE, status = 'success',width = NULL),
prettyCheckbox(inputId="LOT", label = "LOT", value = FALSE,
outline= TRUE, fill = TRUE, status = 'success', width = NULL)),
mainPanel(
dataTableOutput("contents")
)))}
server <- function(input, output, session) {
df <- reactive({
req(input$file1)
df <- read.csv(input$file1$datapath)
})
observeEvent(df(), {
req(df())
updatePickerInput(session, inputId = "Consequence", choices = levels(df()$Consequence), selected = levels(df()$Consequence))
})
filtered_df <- reactive({
df() %>%
filter( Consequence %in% input$Consequence ) %>%
filter(if (input$CANONICAL == TRUE) CANONICAL == "YES" else !is.na(CANONICAL))
})
output$contents <- renderDT(
filtered_df(),
class = "display nowrap compact", # style
filter = "top")
# if(input$LOT == TRUE){
# cols = names(df())[grepl( "LOT", names(filtered_df()))]
# datatable(filtered_df) %>% formatStyle(
# columns = cols,
# target = 'row',
# backgroundColor = styleEqual("TRUE", 'yellow')
# )}
}
shinyApp(ui, server)
因此,在这种情况下,我希望在按下复选框“LOT”时将第 4 到 11 行涂成黄色。
谢谢,
瑞秋
解决方案
这是一个仅部分有效的解决方案。我不明白这个问题。(编辑:问题已解决,见最后)
首先,我已经删除了您的文件上传,以便不必上传文件。这与问题无关。我称之为数据框DF
。
问题就在这里:在下面的代码中,我这样做了renderDT(DT, ......
。如您所见,这很有效。但是当我这样做时renderDT(filtered_df(), ....)
,这不起作用,我不明白为什么。
DF <- df <- data.frame(Consequence = c(rep("x",4),rep("y",4),rep("z",4)),
CANONICAL = rep(c("YES","NO"),6),
x_LOT = c(rep("False", 3), rep("True", 5), rep("False",2), "True","False"),
y_LOT = c(rep("False", 8), rep("True",2), rep("False",2)),
x3=c(12,43,64,34,93,16,32,74,84,89,45,67))
#write.csv(df, "df.csv")
# MY APP
library(shiny)
library(DT) # for data tables
library(dplyr)
library(shinyWidgets)
# library(lazyeval)
# library(data.table)
callback <- function(rows){
c(
sprintf("var rows = [%s];", toString(rows)),
"$('#LOT').on('click', function(){",
" if($(this).prop('checked')){",
" for(var i=0; i<rows.length; ++i){",
" var row = table.row(rows[i]);",
" row.node().style.backgroundColor = 'yellow';",
" }",
" }else{",
" for(var i=0; i<rows.length; ++i){",
" var row = table.row(rows[i]);",
" row.node().style.backgroundColor = '';",
" }",
" }",
"})"
)
}
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Upload your File",multiple = FALSE,
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")),
pickerInput("Consequence", "Consequence:", choices = NULL, options = list(`actions-box` = TRUE),
selected = NULL, multiple = TRUE ),
prettyCheckbox(inputId = "CANONICAL", label = "CANONICAL", value = FALSE,
outline = TRUE, fill = TRUE, bigger = TRUE, status = 'success',width = NULL),
prettyCheckbox(inputId="LOT", label = "LOT", value = FALSE,
outline= TRUE, fill = TRUE, status = 'success', width = NULL)),
mainPanel(
DTOutput("contents")
)))}
server <- function(input, output, session) {
df <- reactive({
# req(input$file1)
# df <- read.csv(input$file1$datapath)
DF
})
yellowRows <- reactive({
req(df())
which(df()$x_LOT == "True" | df()$y_LOT == "True") - 1L
})
observeEvent(df(), {
req(df())
updatePickerInput(session, inputId = "Consequence",
choices = levels(df()$Consequence),
selected = levels(df()$Consequence))
})
filtered_df <- reactive({
df() %>%
filter( Consequence %in% input$Consequence ) %>%
filter(if (input$CANONICAL == TRUE) CANONICAL == "YES" else !is.na(CANONICAL))
})
output$contents <- renderDT({
req(filtered_df())
datatable(
DF,
class = "display nowrap compact",
filter = "top",
callback = JS(callback(yellowRows())),
options = list(
pageLength = 12)
)},
server = FALSE
)
}
shinyApp(ui, server)
编辑:问题已解决
只需替换yellowRows
为:
yellowRows <- reactive({
req(filtered_DAT())
which(filtered_DAT()$x_LOT == "True" | filtered_DAT()$y_LOT == "True") - 1L
})
output$contents <- renderDT({
req(filtered_DAT())
datatable(
filtered_DAT(),
class = "display nowrap compact",
filter = "top",
callback = JS(callback(yellowRows())),
options = list(
pageLength = 12)
)},
server = FALSE
)
编辑:适用于多个页面的版本
DF <- df <- data.frame(Consequence = c(rep("x",4),rep("y",4),rep("z",4)),
CANONICAL = rep(c("YES","NO"),6),
x_LOT = c(rep("False", 3), rep("True", 5), rep("False",2), "True","False"),
y_LOT = c(rep("False", 8), rep("True",2), rep("False",2)),
x3=c(12,43,64,34,93,16,32,74,84,89,45,67))
#write.csv(df, "df.csv")
# MY APP
library(shiny)
library(DT) # for data tables
library(dplyr)
library(shinyWidgets)
# library(lazyeval)
# library(data.table)
callback <- function(rows){
c(
sprintf("var rows = [%s];", toString(rows)),
"$('#LOT').on('click', function(){",
" for(var i=0; i<rows.length; ++i){",
" var row = table.row(rows[i]);",
" if(row.length){",
" row.node().style.backgroundColor = ",
" $(this).prop('checked') ? 'yellow' : '';",
" }",
" }",
"})"
)
}
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Upload your File",multiple = FALSE,
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")),
pickerInput("Consequence", "Consequence:", choices = NULL, options = list(`actions-box` = TRUE),
selected = NULL, multiple = TRUE ),
prettyCheckbox(inputId = "CANONICAL", label = "CANONICAL", value = FALSE,
outline = TRUE, fill = TRUE, bigger = TRUE, status = 'success',width = NULL),
prettyCheckbox(inputId="LOT", label = "LOT", value = FALSE,
outline= TRUE, fill = TRUE, status = 'success', width = NULL)),
mainPanel(
DTOutput("contents")
)))}
server <- function(input, output, session) {
df <- reactive({
# req(input$file1)
# df <- read.csv(input$file1$datapath)
DF
})
observeEvent(df(), {
req(df())
updatePickerInput(session, inputId = "Consequence",
choices = levels(df()$Consequence),
selected = levels(df()$Consequence))
})
filtered_df <- reactive({
df() %>%
filter( Consequence %in% input$Consequence ) %>%
filter(if (input$CANONICAL == TRUE) CANONICAL == "YES" else !is.na(CANONICAL))
})
yellowRows <- reactive({
req(filtered_df())
which(filtered_df()$x_LOT == "True" | filtered_df()$y_LOT == "True") - 1L
})
output$contents <- renderDT({
req(filtered_df())
datatable(
filtered_df(),
class = "display nowrap compact",
filter = "top",
callback = JS(callback(yellowRows())),
options = list(
pageLength = 6)
)},
server = FALSE
)
}
shinyApp(ui, server)
推荐阅读
- excel - 如何返回没有字母的正则表达式匹配
- java - 考虑到夏令时,如何在 mongoDB 中存储用于调度的未来日期
- r - 将不同的函数列表传递给 dplyr 总结
- javascript - 使用在导出函数中定义的函数,来自另一个文件
- react-native - 从本地`node_modules`运行时奇怪的react-native版本号
- java - 如果我在 Spring 中运行 Hibernate 请求,为什么会收到 ClassCastException?
- html - 在另一个 div 中居中 div 并防止它出去
- shell - 如何将一长列拆分为多列shell脚本
- java - 如何检测输入中的换行符
- angular -
当我添加两个时不起作用 在我的应用程序中