r - 如何根据 Shiny 应用程序中复选框的输入对数据框中的某些行进行样式格式化？

标签 r user-interface shiny dt

我正在开发一个 Shiny 的应用程序，其中用户使用一些小部件交互式地过滤数据框。我的复选框之一称为“LOT”。此复选框的目的是将 x_LOT 或 Y_LOT 列的值为“true”的行标记为黄色。

我尝试在 renderTable 中包含一个条件，这样如果复选框的输入为 true，相应的行就会被着色，但它不起作用。我尝试为其余过滤器编写条件内部 react 函数，但它也不起作用。

我的代码如下:

# 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)

enter image description here

编辑:问题已解决

只需将 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)

关于r - 如何根据 Shiny 应用程序中复选框的输入对数据框中的某些行进行样式格式化？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/57625282/

上一篇：google-apps-script - Google API 返回响应 200 空 JSON

下一篇：reactjs - 如何为嵌套子菜单创建键？

相关文章：

Shiny 的 R : How can I adjust radio buttons to the grid width of column?

r - 将长格式分组数据转换为宽格式

r - 获取数据框中最接近第一行的 top_n 行

c# - 如何在 C# 中启动一个 UI 线程

android - AsyncTask 未在 UI 线程上更新

mysql - Shiny R 重置 dataTableOutput

带有 mlr3::autoplot() 的 Roc 曲线用于 "holdout"重采样的基准

r - Sparklyr:使用 group_by，然后从组中的行连接字符串

用于选择一个或两个的 JAVA UI 元素

image-processing - 如何将本地镜像加载到 Shiny 的应用程序以使用 EBImage 进行图像分析

©2024 IT工具网  联系我们