我尝试“破解”数据表:)
我希望DT :: datatable行中的按钮的OK或KO状态保持不变。 换句话说,即使经过过滤器(此方法有效!),并且即使我浏览了数据表的页面,单击的按钮也必须保持其OK标签和蓝色。 (这不起作用:从第1页移至第2页,然后再返回1个零钱)
要做到这一点,我认为我需要在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)
种种问候