Постоянный ввод данных внутри блестящий - PullRequest
Новая
       7

Постоянный ввод данных внутри блестящий

0 голосов
/ 27 сентября 2019

Я пытаюсь «взломать» данные :)

Мне бы хотелось, чтобы статус OK или KO кнопок в строках DT :: datatable был постоянным.Другими словами, нажатая кнопка должна оставаться с ее меткой OK и синим цветом, даже после фильтра (это работает!), И даже если я просматриваю страницы таблицы данных.(это не работает: переход со страницы 1 на страницу 2 и возврат к 1 свободным изменениям)

this blue button need to stay blue

для этого, я думаю,необходимо использовать обратный вызов с javascript, я пробовал много способов без успеха (ajax.reload, destroy + 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)

видПривет

...