CODEWITHSUNDEEP
rformattingr-markdown
InColorado
InColorado

Reputation: 348

How to apply formattable formats to multiple columns?

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

Upvotes: 3

Views: 1601

Answers (1)

Julian_Hn
Julian_Hn

Reputation: 2141

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

Upvotes: 2

Related Questions