DT Table 中的闪亮小部件
Posted
技术标签:
【中文标题】DT Table 中的闪亮小部件【英文标题】：Shiny widgets in DT Table 【发布时间】：2019-07-28 18:57:51 【问题描述】：我正在尝试在 DT 表的行中包含闪亮的小部件，例如 textInput、selectInput（单个）、sliderInput 和 selectInput（多个）。小部件直接在页面上时，它们显示正确，但是，当它们放在表格中时，其中一些显示不正确。
textInput 很好，selectInput（单个）除了一些 css 差异之外大部分都很好，但是 selectInput（多个）没有正确显示，sliderInput 肯定没有正确显示。似乎依赖 javascript 的小部件是有问题的。有没有办法让这些小部件在 DT 表中正常工作？
这是我的可重现示例。我在将小部件放入表格时使用了原始 html，但我直接从每个小部件的闪亮函数生成的 HTML 中获取。
library(shiny)
library(DT)
ui <- fluidPage(
h3("This is how I want the widgets to look in the DT table."),
fluidRow(column(3, textInput(inputId = "text",
label = "TEXT")),
column(3, selectInput(inputId = "single_select",
label = "SINGLE SELECT",
choices = c("", "A", "B", "C"))),
column(3, sliderInput(inputId = "slider",
label = "SLIDER",
min = 0,
max = 10,
value = c(0, 10))),
column(3, selectizeInput(inputId = "multiple_select",
label = "MULTIPLE SELECT",
choices = c("", "A", "B", "C"),
multiple = TRUE))),
h3("This is how they actually appear in a DT table."),
fluidRow(DTOutput(outputId = "table"))
)
server <- function(input, output, session)
output$table <- renderDT(
data <- data.frame(ROW = 1:5,
TEXT = '<input id="text" type="text" class="form-control" value=""/>',
SINGLE_SELECT = '<select id="single_select" style="width: 100%;">
<option value="" selected></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
SLIDER = '<input class="js-range-slider" id="slider" data-type="double" data-min="0" data-max="10" data-from="0" data-to="10" data-step="1" data-grid="true" data-grid-num="10" data-grid-snap="false" data-prettify-separator="," data-prettify-enabled="true" data-keyboard="true" data-drag-interval="true" data-data-type="number"/>',
MULTIPLE_SELECT = '<select id="multiple_select" class="form-control" multiple="multiple">
<option value=""></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
stringsAsFactors = FALSE)
datatable(data = data,
selection = "none",
escape = FALSE,
rownames = FALSE)
)
shinyApp(ui = ui, server = server)
【问题讨论】：
【参考方案1】：滑块
对于滑块，您必须从文本输入开始：
SLIDER = '<input type="text" id="s" name="slider" value="" />'
然后用 JavaScript 把它变成一个滑块：
js <- c(
"function(settings)",
" $('#s').ionRangeSlider(",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20,",
" from: 5,",
" to: 15",
" );",
""
)
有关选项，请参阅ionRangeSlider。
您可以使用 initComplete 选项传递 JavaScript 代码：
server <- function(input, output, session)
output$table <- renderDT(
data <- data.frame(ROW = 1:5,
TEXT = '<input id="text" type="text" class="form-control" value=""/>',
SINGLE_SELECT = '<select id="single_select" style="width: 100%;">
<option value="" selected></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
SLIDER = '<input type="text" id="s" name="slider" value="" />',
MULTIPLE_SELECT = '<select id="multiple_select" class="form-control" multiple="multiple">
<option value=""></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
stringsAsFactors = FALSE)
datatable(data = data,
selection = "none",
escape = FALSE,
rownames = FALSE,
options =
list(
initComplete = JS(js)
))
)
然后你只得到第一行的滑块：
那是因为五个文本输入具有相同的 id。您必须为五个文本输入设置不同的 id：
SLIDER = sapply(1:5, function(i)
sprintf('<input type="text" id="Slider%d" name="slider" value="" />', i)
),
然后使用这段 JavaScript 代码将它们变成滑块：
js <- c(
"function(settings)",
" $('[id^=Slider]').ionRangeSlider(",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20,",
" from: 5,",
" to: 15",
" );",
""
)
要设置from 和to 的初始值，最好在输入文本的value 参数中给出它们，如下所示：
SLIDER = sapply(1:5, function(i)
sprintf('<input type="text" id="Slider%d" name="slider" value="5;15" />', i)
)
js <- c(
"function(settings)",
" $('[id^=Slider]').ionRangeSlider(",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20",
" );",
""
)
多选
要获得所需的多选显示，您必须调用selectize()：
MULTIPLE_SELECT = '<select id="mselect" class="form-control" multiple="multiple">
<option value=""></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>'
js <- c(
"function(settings)",
" $('[id^=Slider]').ionRangeSlider(",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20",
" );",
" $('#mselect').selectize()",
""
)
同样，这仅适用于第一个多选。使用个人 id 申请五个。
绑定
最后，您必须绑定输入以使其值在 Shiny 中可用：
datatable(data = data,
selection = "none",
escape = FALSE,
rownames = FALSE,
options =
list(
initComplete = JS(js),
preDrawCallback = JS('function() Shiny.unbindAll(this.api().table().node()); '),
drawCallback = JS('function() Shiny.bindAll(this.api().table().node()); ')
)
)
现在您可以获取input$Slider1、input$Slider2、...和input$mselect 中的值。请注意，input$Slider[1/2/3/4/5] 以这种格式返回滑块的值："3;15"。
【讨论】：
谢谢！这正是我所需要的。我想我也希望有一个日期范围输入，但我想我可以根据您的操作方式弄清楚如何做到这一点。 @mosk915 有关日期输入，请参见 here。 如果您不介意，我有一个后续问题。使滑块出现在下拉列表中有多难，类似于它出现在数字列的列过滤器中的方式，您在其中看到一个文本框，然后当您单击它时滑块下降到框下方？以上是关于DT Table 中的闪亮小部件的主要内容，如果未能解决你的问题，请参考以下文章
选择一个 DT 行，然后在闪亮的应用程序中根据小部件选择输入和 actionButton() 更改该行的一个单元格的值