r - 如何将格式化格式应用于多列？

Question

我有两个 data.frames(每个最初都是来自一个更大的父 3 维数组的维度)。一个保存数值。另一个具有 T/F 值，指示第一个数组中每个值的置信区间是否与引用置信区间重叠。数组中每个值的置信区间都不同，因此在格式化表格时我不能引用常量，只能引用 T/F 值数组。

我想显示第一个数组的表格，每个单元格的背景颜色基于第二个数组。为了让 formattable 可以看到具有 T/F 值的列，我创建了一个数据框，它绑定(bind)了来自三个维度的列。在实际数据中，大约有 20 列数值。这是一个简化的示例:

 orig.data <- array(dim = c(3, 4, 2))
 dimnames(orig.data) <- list (c("site1", "site2", "site3"), c("model1", "model2", "model3",
   "model4"), c("mean.val", "is.in.CI"))
 orig.data[,,1] <- round(runif(12, 2, 10), 2)
 orig.data[,,2] <- as.logical(round(runif(12, 0, 1)))
 ft.data <- data.frame(orig.data[,,2], stringsAsFactors = F)
 colnames(ft.data) <- paste0("match.", colnames(ft.data))
 ft.data <- cbind(data.frame(orig.data[,,1], stringsAsFactors = F), 
    ft.data)

我可以通过按名称调用每一列来创建我想要的表格格式。有两个特殊的考虑。首先，对于前四列，背景颜色的选择取决于第二列。其次，我想隐藏最后四列。有没有办法使用 apply 或一些类似的简洁动态语法来做到这一点？

这是我要合并的长版本。

 yes.color <- "lightgreen"
 no.color <- "pink"
 formattable::formattable(ft.data, list(
     `model1` = formatter("span", style = ~ style(display = "block",
        "border-radius" = "4px", "padding-right" = "4px",
        "background-color" =  ifelse(`match.model1`, yes.color, no.color))),
     `model2` = formatter("span", style = ~ style(display = "block",
        "border-radius" = "4px", "padding-right" = "4px",
        "background-color" =  ifelse(`match.model2`, yes.color, no.color))),
     `model3` = formatter("span", style = ~ style(display = "block",
        "border-radius" = "4px", "padding-right" = "4px",
        "background-color" =  ifelse(`match.model3`, yes.color, no.color))),
     `model4` = formatter("span", style = ~ style(display = "block",
        "border-radius" = "4px", "padding-right" = "4px",
        "background-color" =  ifelse(`match.model4`, yes.color, no.color))),
     match.model1 = F,
     match.model2 = F,
     match.model3 = F,
     match.model4 = F))

这个问题与我的第二个问题类似，没有答案:Loop, hide columns and r formattable

自动隐藏 T/F 列的失败尝试如下。我对自动化 2 列引用没有任何想法。

 formattable(ft.data[, 1:4]) 

如果我省略带有 T/F 名称的列，格式化程序将不知道它们的存在。

  area(col = 5:8) = F)) # no effect

在可格式化命令之外，创建一个字符串:

 formatter.string <- paste( unlist(paste0("match.", c(“model1”, “model2”, “model3”, “model4”), " = #F,\n\t")), collapse='')

然后在 formattable 列表中，添加

  eval(parse(formatter.string)))) # no effect  OR
  lapply(5:8, function(m.col){m.col = F}) # also no effect

Answer 1

这是我使用一些eval/parse 魔法所能想到的最好结果:

format <- sapply(names(ft.data)[1:4],function(x)
{
  eval( #evaluate the following expression
    parse(text=  #parse the following string to an expression
        sub("_SUB_", #find "_SUB_"
            paste0("`match.",x,"`"), #replace with name of column
            "formatter(\"span\", style = ~ style(display = \"block\", #in the string containing the formatter call
                                      \"border-radius\" = \"4px\", \"padding-right\" = \"4px\",
                                      \"background-color\" =  ifelse(_SUB_, yes.color, no.color)))")))
},simplify=F,USE.NAMES = T)

#hiding part. Same concept as above
hide <- sapply(names(ft.data[5:8]), function(x) eval(parse(text=sub("_SUB_",x,"_SUB_ = F"))),
               simplify=F,USE.NAMES=T)

formattable::formattable(ft.data,c(format,hide))