How to apply formattable formats to multiple columns? - r

Question

I have two data.frames (each originally a dimension from a larger parent 3-d array). One holds numeric values. The other has T/F values indicating whether the confidence interval for each value in the first array overlaps a reference confidence interval. The confidence intervals are different for every value in the array, so in formatting the table I can’t refer to constants, only to the array of T/F values.
I want to show a table of the first array, with background color of each cell based on the second array. So that formattable can see the columns with T/F values, I created a single data frame that binds the columns from both 3rd dimensions. In the real data there are ~20 columns of numeric values. Here is a simplified example:
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)
I can create the table formatting I want by calling each column by name. There are two special considerations. First, for the first four columns, the choice of background color is conditional on a second column. Second, the last four columns I would like to hide. Is there a way to do this with apply or some similar succinct dynamic syntax?
Here is the long version that I’d like to consolidate.
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))
This question is similar to the second of my questions and is unanswered: Loop, hide columns and r formattable
Failed attempts to automate hiding the T/F columns follow. I don’t have any ideas for automating the 2-column references.
formattable(ft.data[, 1:4])
If I omit the columns with the T/F designations, the formatter doesn’t know they exist.
area(col = 5:8) = F)) # no effect
Outside the formattable command, create a string:
formatter.string <- paste( unlist(paste0("match.", c(“model1”, “model2”, “model3”, “model4”), " = #F,\n\t")), collapse='')
then within the list for formattable, add
eval(parse(formatter.string)))) # no effect OR
lapply(5:8, function(m.col){m.col = F}) # also no effect

Answer 1

This is the best I could come up with using some eval / parse magic:
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))