[英]R shiny set check-box controls value to values in specific column of dataframe
I would like to set check-box values to the corresponding values in column 'YN' when data table loads.我想在加载数据表时将复选框值设置为“YN”列中的相应值。 I've tried to modify an example I've found that uses the check-box control to update 'YN' values.
我试图修改一个使用复选框控件更新“YN”值的示例。 This is exactly what I need, however, initially the values of the check-boxes were defaulted to 'TRUE'and not the 'YN' values from datafame.
这正是我需要的,但是,最初复选框的值默认为“TRUE”,而不是 datafame 中的“YN”值。 I've created a function 'valueFromData' that I thought would populate the controls initially, however, it doesn't seem to work.
我创建了一个 function 'valueFromData' 我认为最初会填充控件,但是,它似乎不起作用。 Please suggest how to implement this correctly.
请建议如何正确实施。 Thank you very much.
非常感谢。 Here is the code:
这是代码:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DT::dataTableOutput('x1'),
),
server = function(input, output, session) {
# create a character vector of shiny inputs
shinyInput = function(FUN, len, id, value, ...) {
if (length(value) == 1) value <- rep(value, len)
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = value[i]))
}
inputs
}
# obtain the values of check-boxes from 'data'YN'
valueFromData = function(id, len) {
print(id)
print(len)
unlist(lapply(seq_len(len), function(i) {
print(i)
print(df1$YN[i])
value = print(df1$YN[i])
#print(value)
#if (is.null(value)) TRUE else value
}))
}
# obtain the values of inputs
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
#print(value)
if (is.null(value)) TRUE else value
}))
}
n = 10
df1 = data.frame(
month = month.abb[1:n],
YN = rep(c(FALSE, TRUE), times = c(5,5)),
ID = seq_len(n),
stringsAsFactors = FALSE
)
df2 = data.frame(
cb = shinyInput(checkboxInput, n, 'cb_', value = valueFromData('cb_', n), width='1px'),
df1,
stringsAsFactors = FALSE
)
loopData = reactive({
df2$cb <<- shinyInput(checkboxInput, n, 'cb_', value = shinyValue('cb_', n), width='1px')
df2$YN <<- shinyValue('cb_', n)
df2
})
output$x1 = DT::renderDataTable(
isolate(loopData()),
escape = FALSE, selection = 'none',
options = list(
dom = 't', paging = FALSE, ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
proxy = dataTableProxy('x1')
observe({
replaceData(proxy, loopData(), resetPaging = FALSE)
})
}
)
Here is a way:这是一种方法:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
),
server = function(input, output, session) {
# create a character vector of shiny inputs
shinyInput = function(FUN, len, id, value, width) {
if (length(value) == 1) value <- rep(value, len)
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] =
as.character(FUN(paste0(id, i), label = NULL, value = value[i], width = width))
}
inputs
}
# obtain the values of inputs
shinyValue = function(id, len, initial) {
vapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) initial[i] else value
}, FUN.VALUE = logical(1))
}
n = 10
YN = rep(c(FALSE, TRUE), times = c(5,5))
df1 = data.frame(
cb = shinyInput(checkboxInput, n, 'cb_',
value = YN, width='30px'),
month = month.abb[1:n],
YN = YN,
ID = seq_len(n),
stringsAsFactors = FALSE
)
loopData = reactive({
values = shinyValue('cb_', n, initial = YN)
dat = df1
dat$cb = shinyInput(checkboxInput, n, 'cb_',
value = values,
width = '30px')
dat$YN = values
dat
})
output$x1 = renderDT(
df1, class = "display compact",
escape = FALSE, selection = 'none',
options = list(
dom = 't', paging = FALSE, ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
proxy = dataTableProxy('x1')
observe({
replaceData(proxy, loopData(), resetPaging = FALSE)
})
}
)
Another way, which should be more performant:另一种方式,应该更高效:
library(shiny)
library(DT)
df <- data.frame(item = c("a", "b", "c"), YN = c(TRUE, FALSE, FALSE))
shinyCheckbox <- function(id, values) {
inputs <- character(length(values))
for(i in seq_along(inputs)) {
inputs[i] <-
as.character(
checkboxInput(paste0(id, i), label = NULL, value = values[i], width = "20px")
)
}
inputs
}
callback <- c(
"$('[id^=check]').on('click', function(){",
" var id = this.getAttribute('id');",
" var i = parseInt(/check(\\d+)/.exec(id)[1]);",
" var value = $(this).prop('checked');",
" var cell = table.cell(i-1, 2).data(value).draw();",
"})"
)
server <- function(input, output, session) {
output$tbl <- renderDT(
server = FALSE, escape = FALSE, callback = JS(callback),
options = list(
dom = 't', paging = FALSE, ordering = FALSE,
columnDefs = list(
list(targets = "_all", className = "dt-center"),
list(targets = 3, width = "20px")
),
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
), {
df$check <- shinyCheckbox("check", df$YN)
df
}
)
}
ui <- fluidPage(
DTOutput("tbl")
)
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.