问题描述
我在Shiny应用程序中使用了一些条件格式的电子书,例如,如果特定列上的数据丢失(例如下面的col1
,则将整个行显示为红色)。
现在,我还想将此信息(缺少必需值)返回给Shiny(例如使用布尔值),以便采取其他措施(例如,禁用闪亮按钮)。
是否有一种简便的方法?还是我应该在rhandsontable上并行编写一个观察者代码,然后再次测试强制列是否已填充?
这是我要实现的目标的一个示例:
library(shiny)
library(rhandsontable)
DF <- data.frame(col1 = c(1,NA,3),col2 = c(letters[23:22],NA),col3 = round(rnorm(3,1e6,1e3),0))
server <- shinyServer(function(input,output,session) {
output$rt <- renderRHandsontable({
rhandsontable(DF) %>%
hot_cols(renderer = "
function (instance,td,row,col,prop,value,cellProperties) {
Handsontable.renderers.NumericRenderer.apply(this,arguments);
var col_col1 = instance.getData()[row][0]
if(!col_col1) {
td.style.background = 'pink';
}
}")
})
})
ui <- shinyUI(fluidPage(
rHandsontableOutput("rt"),br(),actionButton(inputId = "btn1",label = "disable this btn when at least one cell is red")
))
shinyApp(ui,server)
解决方法
这是一种方法。
library(shiny)
library(rhandsontable)
library(shinyjs)
DF <- data.frame(
col1 = c(1,NA,3),col2 = c(letters[23:22],NA),col3 = round(rnorm(3,1e6,1e3),0),col4 = 3:1
)
server <- shinyServer(function(input,output,session) {
session$sendCustomMessage("dims",list(nrows = nrow(DF),ncols = ncol(DF)))
output$rt <- renderRHandsontable({
rhandsontable(DF) %>%
hot_cols(renderer = "
function (instance,td,row,col,prop,value,cellProperties) {
Handsontable.renderers.NumericRenderer.apply(this,arguments);
if(!value) {
td.style.background = 'pink';
array[col][row] = true;
} else {
array[col][row] = false;
}
Shiny.setInputValue('missingValues:shiny.matrix',array);
}")
})
observeEvent(input[["missingValues"]],{
if(any(input[["missingValues"]])){
disable("btn1")
}else{
enable("btn1")
}
})
observe({
print(input$missingValues)
})
})
js <- HTML(
"var array = [];","function initializeArray(dims){"," for(var i = 0; i < dims.ncols; ++i){"," array.push(new Array(dims.nrows));"," }","}","$(document).on('shiny:connected',function(){"," Shiny.addCustomMessageHandler('dims',initializeArray);","});"
)
ui <- shinyUI(fluidPage(
tags$head(tags$script(js)),useShinyjs(),rHandsontableOutput("rt"),br(),actionButton(inputId = "btn1",label = "disable this btn when at least one cell is red")
))
shinyApp(ui,server)