Question

我想在我闪亮的应用中实现复选框;但是，我面临两个问题：

重新排序列后，对数据表的任何检查都会消失（例如，尝试按mpg订购表）
删除列后，对数据表的任何检查都会消失（例如，取消选中Columns to show:中的框）

这是我的虚拟示例（它是来自this SO answer的代码的修改版本）：

library(shiny)
TABLE = mtcars
TABLE$id = 1:nrow(mtcars)
APP <- list()

APP$ui <- pageWithSidebar(
    headerPanel(NULL),
    sidebarPanel(
        checkboxGroupInput("show_vars", "Columns to show:", 
                           names(TABLE), selected = names(TABLE))
    ),
    mainPanel(
        dataTableOutput("resultTABLE")
    )
)
APP$server <- function(input, output, session) {

    output$resultTABLE = renderDataTable({
        addCheckboxButtons <- paste0('<input type="checkbox" name="row', 
                                     TABLE$id, '" value="', TABLE$id, '">',"")
        cbind(Pick = addCheckboxButtons, TABLE[, input$show_vars, drop = FALSE])
    }, escape = FALSE)
}

runApp(APP)

APP有效，但为了全面实施，我需要解决问题1和2.

Answer 1

根据您提问中提供的SO答案：

<?php
// you'll find that the request probably won't be pre-flighted now! But, lets keep this code in just in case
if ($_SERVER['REQUEST_METHOD'] == 'OPTIONS') {
    if (isset($_SERVER['HTTP_ACCESS_CONTROL_REQUEST_METHOD']) && $_SERVER['HTTP_ACCESS_CONTROL_REQUEST_METHOD'] == 'POST') {
        header('Access-Control-Allow-Origin: *');
        header('Access-Control-Allow-Headers: X-Requested-With, content-type');
    }
    exit;
}
// moved this after the conditional exit, no need to send it twice for an OPTIONS request
header('Access-Control-Allow-Origin: *');
header('Content-Type: application/json; charset=UTF-8'); // not really required, but let's be nice
$a = $_POST["a"];
$b = $_POST["b"];
// send back json, since you client code seems to want "jsondata"
echo json_encode(array('result'=>$a + $b));
?>

类似，但DT方法:(更高效，因为你不为每一行创建输入，因此它不会为每个被动值触发器重新创建表格（这是＆＃39; s是列和行标记）。它仅在列反应值触发器中重新创建表。您还可以在按钮扩展中使用library(shiny) mymtcars = mtcars mymtcars$id = 1:nrow(mtcars) runApp( list(ui = pageWithSidebar( headerPanel('Examples of DataTables'), sidebarPanel( checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars), selected = names(mymtcars)) ), mainPanel( dataTableOutput("mytable") ) ) , server = function(input, output, session) { strd<-reactiveValues(tr=0, slrows=character(length=nrow(mymtcars))) #preserve selected rows in a reactive element rowSelect <- reactive({ input$rows }) # use reactive value that's equal to 'checked' parameter for html code observe({ strd$slrows<-ifelse(mymtcars$id %in% as.numeric(rowSelect()),'checked','' ) }) #use observer for column checkboxinput to detect first run observeEvent(input$show_vars, { strd$tr<-strd$tr+1 print(strd$tr) }, ignoreNULL = TRUE) output$mytable = renderDataTable({ #if first run - nothing is checked if (strd$tr==1){ addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '" >',"") } else{ # add 'checked' parameter for html depending if id is present in selected rows reactive value addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id,'" ', strd$slrows,'>',"") } #Display table with checkbox buttons (cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])) }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25), escape=FALSE, callback = "function(table) { table.on('change.dt', 'tr td input:checkbox', function() { setTimeout(function () { Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() { return $(this).text(); }).get()) }, 10); }); }") } ) )以便与纯DT解决方案相处

colvis

闪亮：更改输入后，在数据表上检查框

1 个答案: