この効果を実現する方法の簡単な例を次に示します。わかりやすいようにシンプルにしてみました。より高度な機能とスタイリングを簡単に追加できます。ボーナスポイントのスタイリングを追加しました。
ncol = 4 # typically rank 1:9
n = ncol^2
values = matrix(round(rnorm(n),2), nrow = ncol, byrow = T)
labs = paste0("r", rep(1:ncol, each = ncol), "c", rep(1:ncol, times = ncol))
labels = matrix(labs, nrow = ncol, byrow = T)
free = matrix(rbinom(n= n, size = 1, prob = .5), nrow = ncol, byrow = T)
myObj = list(values = values, labels = labels, free = free)
# use formattable, htmlwidgets, and htmltools
library(formattable)
library(htmltools)
library(htmlwidgets)
# see what formattable gives us
formattable(myObj$values)
# now make each of our cells
# contain information for our tooltip
m_html <- matrix(
mapply(
function(value, label, free){
as.character(tags$span(
"data-toggle"="tooltip",
"title" = paste0(label, ": ", free),
formatC(value, format="f", digits=3)
))
},
myObj$values,
myObj$labels,
myObj$free
),
ncol = 4
)
browsable(
attachDependencies(
tagList(
onRender(
as.htmlwidget(formattable(m_html)),
"
function(el,x){
$(el).find('[data-toggle=\"tooltip\"]').tooltip()
}
"
)
),
shiny::bootstrapLib()
)
)
上記を別の方法で実行し、提案したスタイリングを追加する非常に簡単な方法を次に示します。
# purrr could ease some of this pain
# but wanted to avoid dependencies
formattable(
matrix(
formatter(
"span",
"data-toggle" = "tooltip",
# use the label and free to add a simple title
# this can be infinitely styled and refined
"title" = mapply(
function(value,label,free) {
paste0(label,": ",free)
},
myObj$values, myObj$label, myObj$free
),
# color the background of cells based on free
"style" = mapply(
function(value,free) {
if(free==1) color = "red"
if(free==0) color = "green"
paste0("display:block; background:",color,";")
},
myObj$values, myObj$free
),
# values will be the text in the cells
x~x
)(myObj$values),
# put back in a matrix of ncol=4
ncol=4
)
)