持久的数据表内部输入闪亮

时间:2019-09-27 15:04:49

标签: javascript r shiny datatables dt

我尝试“破解”数据表:)

我希望DT :: datatable行中的按钮的OK或KO状态保持不变。 换句话说,即使经过过滤器(此方法有效!),并且即使我浏览了数据表的页面,单击的按钮也必须保持其OK标签和蓝色。 (这不起作用:从第1页移至第2页,然后再返回1个零钱)

this blue button need to stay blue

要做到这一点,我认为我需要在JavaScript中使用回调,我尝试了许多不成功的方法(ajax.reloaddestroy + draw

请看一下这个代表:

library(shiny)
library(DT)
library(magrittr)
library(tidyverse)
butt <- function(
  id, 
  ok, 
  data_value = 0, 
  vert = FALSE
){
  tags$button(
    id = id, 
    `data-value` = data_value, 
    class = ifelse(vert, "blue", "green"),
    onclick = sprintf('
      $(this).toggleClass("blue green");
      $(this).text(function(i, text){
          return text === "OK" ? "KO" : "OK";
        });
      $(this).data("value", $(this).data("value") + 1) ;
      Shiny.setInputValue("%s", $(this).data("value"))
      ', id), 
    ifelse(ok, "OK", "KO")
  )
}

ui <- function(request){
  tagList(
    tags$style(
      '.blue{
        background-color: blue;
      }
      .green{
        background-color: green;
      }'
    ),
    selectInput("species", "species", c("setosa", "versicolor", "virginica")),
    DTOutput("plop")
  )
}

server <- function(input, output, session){

  r <- new.env(parent = emptyenv())

  r$click = data.frame(
    id = 1:nrow(iris), 
    ed = 0 , 
    vert = FALSE
  )

  output$plop <- renderDT({
    datatable({
      iris %>%
        mutate(
          Plop = purrr::pmap(
            r$click,
            ~ {
              butt(
                sprintf("row%s", ..1), 
                ok = ..2, 
                data_value = ..2, 
                vert = ..3
              )
            }
          )  %>% purrr::map_chr(paste)
        ) %>%
        dplyr::filter(Species == input$species)
    }, escape = FALSE,
    # callback = JS()
    # options = list()
    )
  })

  purrr::map(
    1:nrow(iris),
    ~{
      observeEvent( input[[sprintf("row%s", .x)]] , {
          cli::cat_rule(sprintf("input %s",  .x  ))
          print(input[[sprintf("row%s", .x)]])
          r$click$ed[.x] <- input[[sprintf("row%s", .x)]]
          r$click$vert[.x] %<>% `n'est pas`()
        })
    }
  )
}

shinyApp(ui, server)

种种问候

0 个答案:

没有答案