基于第二个数据帧中的值对表进行条件格式化

Question

假设这个例子：

Attachments

是否可以根据第二个表的数据格式化第一个表？假设我希望第一个表的值的字体变为绿色，如果第二个表中相同位置的值相同。如果值不相等，则为红色。

例如library(shiny) library(tidyverse) df1 <- data.frame(A = 1:5, B = 6:10, C = 11:15) df2 <- data.frame(A = c(1:3,7,5), B = c(11, 7:10), C = 16:20) server <- function(input, output) { output$table1 <- renderTable({ df1 }, digits = 0 ) output$table2 <- renderTable({ df2 }, digits = 0 ) } ui <- fluidPage( div(h3("Table Formatting"), align = "center"), div(tableOutput("table1"),align = "center"), div(tableOutput("table2"), align = "center") ) shinyApp(ui = ui, server = server) ，所以这应该是绿色的。但df1[1,1] = df2[1,1] = 1与df1[4,1] = 4不同，因此df2[4,1] = 7中的字体应为红色。

我不在乎格式是基于data.table，formattable还是完全不同的格式，只要它可以在闪亮中使用。

提前致谢！

  

您可以在我自己的帖子中找到完整的答案。见下文。

Answer 1

以下是您的代码：

library("shiny")
library("formattable")

df1 <- data.frame(A = 1:5, B = 6:10, C = 11:15)
df2 <- data.frame(A = c(1:3,7,5), B = c(11, 7:10), C = 16:20) 

ident <- function(...){
  args <- c(...) 
  if( length( args ) > 2L ){
    #  recursively call ident()
    out <- c( identical( args[1] , args[2] ) , ident(args[-1]))
  }else{
    out <- identical( args[1] , args[2] )
  }    
  return( all( out ) )
}

ui <- fluidPage(
  div(h3("Table Formatting"), align = "center"),
  div(formattableOutput("table1"),align = "center"), 
  div(formattableOutput("table2"), align = "center")
)

server <- function(input, output) {
  output$table2 <- renderFormattable({formattable(df2, list(A = formatter("span", style = x ~ style(color= ifelse(x == df1$A & x == 1,"green", ifelse(!x == df1$A, "red", NA))))))})

  output$table1 <- renderFormattable({formattable(df1)})
}
shinyApp(ui = ui, server = server)

我已用于此目的formattable包。我刚刚使用了df2的格式，以及df1中server应该使用的格式。我希望这会让你继续前进。它完全符合您的要求：当df1$A == df2$A和= 1然后为绿色​​时，如果!df1$A == df2$A则为红色。

Answer 2

基于Mal_a的解决方案，我发现了以通用方式设置所有列的格式。我用了eval(parse(text = "..."))。您可以通过for循环创建任何所需的代码作为字符串。

library("shiny")
library("formattable")

df1 <- data.frame(A = 1:5, B = 6:10, C = 11:15)
df2 <- data.frame(A = c(1:3,7,5), B = c(11, 7:10), C = 16:20) 

ui <- fluidPage(
  div(h3("Table Formatting"), align = "center"),
  div(formattableOutput("table1"),align = "center"), 
  div(formattableOutput("table2"), align = "center")
)

server <- function(input, output) {
  # output$table2 <- renderFormattable({formattable(df2, list(A = formatter("span", style = x ~ style(color= ifelse(x == df1$A,"green", ifelse(!x == df1$A, "red", NA))))))})

      output$table2 <- renderFormattable({
      # the following string argument can be created by a for-loop
        eval(parse(text = "formattable(df2, list(A = formatter('span', style = x ~ style(color= ifelse(x == df1$A,'green', ifelse(!x == df1$A, 'red', NA)))),
                                                 B = formatter('span', style = x ~ style(color= ifelse(x == df1$B,'green', ifelse(!x == df1$B, 'red', NA)))),
                                                 C = formatter('span', style = x ~ style(color= ifelse(x == df1$C,'green', ifelse(!x == df1$C, 'red', NA))))))"))

      })

      output$table1 <- renderFormattable({formattable(df1)})
    }
    shinyApp(ui = ui, server = server)

结果：