渲染 DT 中单列的下拉列表闪亮但仅在单元格单击时加载并使用 replaceData() [英] render dropdown for single column in DT shiny BUT loaded only on cell click and with replaceData()
本文介绍了渲染 DT 中单列的下拉列表闪亮但仅在单元格单击时加载并使用 replaceData()的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
- 要在 DT 数据表中选择下拉列表，而不是在数据表的构建中，而是在单元格单击上构建，使用
replaceData()和 RDBMS (SQL Server) 上的数据. - 当我单击 的选定选项时，例如
Ohio，我想使用 id2设置我的数据(和 RDBMS).
- To have select dropdown in DT datatables not at the building of the datatable but built on cell click, with
replaceData()and with the datas on RDBMS (SQL Server). - When I click on the selected option of the , for example
OhioI want to set my data (and the RDBMS) with the id2.
使用
replaceData()
- select 的事件是未绑定的.这很奇怪，因为只有我点击的单元格是未绑定的.
- 所选页面丢失
- StateId 的更新有效(但如果我选择另一个原始数据并返回，则无法再次单击)
- 而且，我认为这是一件积极的事情，选择是在行选择处绘制的
- the events of select are unbinded. It strange because only the cells where I've clicked are unbinded.
- the selected page is lost
- Update of StateId works (but I cannot click again on if I select an another raw and come back)
- and, it's a positive thing I think, the select are drawn at row select
没有replaceData()
- 所有事件都已绑定，但我无法更新 DT 数据表中的 StateId
- 既不在数据中(因此也不在 RDMBS SQL 更新中)
我使用下面的这个技巧在 DT 表中添加复选框.它工作得很好，但是当有大量数据时，它在构建中非常慢，因为每个复选框的 html 数量非常重要.
I used this trick below to add checkbox in DT Table. It works very well but it's very slow at the building when there is lot of datas because the amount of html for each checkbox is very important.
- R Shiny，如何让数据表对数据表中的复选框做出反应 作者:史瑞克谭
- R Shiny, how to make datatable react to checkboxes in datatable by Shrek Tan
我使用下面的这个技巧，类似于上一部分，来编写我的代码.但我尝试只建立在单元格点击上，因为我知道前面的部分很慢
I used this trick below, similar to previous part, to write my code. But I try to build only on cell click because I know by the previous part that is slow
预先感谢您的帮助:)
library(shiny)
library(DT)
library(dplyr)
library(shinyjs)
library(DescTools)
# inspired by https://stackoverflow.com/questions/57215607/render-dropdown-for-single-column-in-dt-shiny/57218361#57218361
#
ui <- fluidPage(
useShinyjs(),
tags$head(tags$script(
HTML("
Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
title = 'Selectinput column in a table',
DT::dataTableOutput('foo_dt'),
verbatimTextOutput('selection'),
textInput("mypage",label = NULL,value ="" )
)
# in real case : Query on RDBMS SQL Server
df_product <- data.frame( Product = c(rep("Toaster", 3), rep("Radio", 3)),StateId = c(3,2,2,1,1,2), stringsAsFactors = FALSE)
df_state <- data.frame(StateId = c(1,2,3), State = c("Alabama","Ohio","WDC"), stringsAsFactors = FALSE)
df_datatable <- df_product %>% left_join(.,df_state, by = c("StateId"="StateId")) %>% select (Product,State,StateId)
myselected_vector <- (which(colnames(df_datatable) %in% c("StateId")) )
target_vector <- (which(colnames(df_datatable) %in% c("State")) )
df_state_select <-df_state %>% transmute (value=StateId,label=State) %>% unique()
list_label_value=setNames(df_state_select$value,df_state_select$label)
selectInputModel <-gsub("[
]", "", as.character(
selectInput("selectionXX", "", choices = list_label_value, width = "100px")
))
server <- function(input, output, session) {
react <- reactiveValues(
foo_dt_page=NULL,
# in real case : Query on RDBMS SQL Server
datas = df_datatable,
foo_dt_refresh= FALSE
)
datas_react <-reactive({
input_evt=react$foo_dt_refresh
isolate(react$datas)
})
proxy_foo_dt=dataTableProxy('foo_dt')
output$foo_dt = DT::renderDataTable(
datas_react(), escape = FALSE, selection='single',
server = TRUE,
editable = list(target = "cell"),
options = list(
ordering = FALSE,
columnDefs = list(
list(orderable = FALSE, className = 'details-control', targets = target_vector),
list(width = '10px', targets = myselected_vector)
),
stateSave = TRUE,
pageLength = 2,
lengthMenu = c(2,5,6),
preDrawCallback = JS('function() {
Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS("function() {
mypage = $('#mypage').val();
if (typeof mypage !== 'undefined' && mypage.trim().length!=0) {
if ( $('#foo_dt').find('.dataTable').DataTable().page()!=parseInt(mypage) ) {
$('#foo_dt').find('.dataTable').DataTable().page(parseInt(mypage)).draw(false);
$('#mypage').val('');
}
}
Shiny.bindAll(this.api().table().node());
} ")
),
callback = JS(paste0("
table.on('click', 'td.details-control', function() {
console.log('phil test')
var td = $(this),
row = table.row(td.closest('tr'));
myrow = row.data()[0];
myselected = row.data()[",myselected_vector[1],"];
if ($('#selection' + myrow).length == 0) {
selectInputModel = '",selectInputModel[1],"';
selectInputModel = selectInputModel.replace('<select id=\"selectionXX\">','<select id=\"selectionXX\" class=\"shiny-bound-input\">');
selectInputModel = selectInputModel.replace(/XX/g, myrow);
// selectInputModel = selectInputModel.replace('selected', '');
selectInputModel = selectInputModel.replace('value=\"' + myselected + '\"', 'value=\"' + myselected + '\" selected');
td.html(selectInputModel);
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());
}
})
"))
)
output$selection = renderPrint({
str(sapply(1:nrow(datas_react()), function(i) input[[paste0("selection", i)]]))
})
ReplaceData_foo_dtRefresh <- function (react) {
react$foo_dt_refresh <- TRUE
session$sendCustomMessage("unbindDT", "foo_dt")
replaceData(proxy_foo_dt,(datas_react()) , resetPaging = TRUE)
react$foo_dt_refresh <- FALSE
}
observeEvent(lapply(1:nrow(isolate(datas_react())), function(i) input[[paste0("selection", i)]]), {
validate(
need(!is.null(input$foo_dt_cell_clicked) , message = FALSE)
)
print(
paste0(Sys.time() ," : ",
as.character( input$foo_dt_cell_clicked$row)," =" ,
input[[paste0("selection", input$foo_dt_cell_clicked$row )]]
)
)
if ( react$datas[input$foo_dt_cell_clicked$row,myselected_vector]!= input[[paste0("selection", input$foo_dt_cell_clicked$row )]] ) {
isolate(react$datas[input$foo_dt_cell_clicked$row,myselected_vector]<- input[[paste0("selection", input$foo_dt_cell_clicked$row )]] )
isolate(react$datas[input$foo_dt_cell_clicked$row,target_vector]<-(df_state %>% filter(StateId==input[[paste0("selection", input$foo_dt_cell_clicked$row )]]))$State)
ReplaceData_foo_dtRefresh (react)
updateTextInput(session,"mypage",label = NULL,ceiling(input$foo_dt_cell_clicked$row / input$foo_dt_state$length)-1)
}
},ignoreNULL = TRUE)
}
shinyApp(ui, server)
xfun::session_info()
xfun::session_info()
Package version:
assertthat_0.2.1 backports_1.1.7 BH_1.72.0.3 callr_3.4.3 cli_2.0.2 colorspace_1.4.1 compiler_3.6.3 crayon_1.3.4
crosstalk_1.0.0 desc_1.2.0 digest_0.6.25 dplyr_1.0.0 DT_0.12.1 ellipsis_0.3.1 evaluate_0.14 fansi_0.4.1
farver_2.0.3 fastmap_1.0.1 generics_0.0.2 ggplot2_3.3.1 glue_1.4.1 graphics_3.6.3 grDevices_3.6.3 grid_3.6.3
gtable_0.3.0 htmltools_0.4.0 htmlwidgets_1.5.1 httpuv_1.5.2 isoband_0.2.1 jsonlite_1.6.1 labeling_0.3 later_1.0.0
lattice_0.20.38 lazyeval_0.2.2 lifecycle_0.2.0 magrittr_1.5 MASS_7.3.51.5 Matrix_1.2.17 methods_3.6.3 mgcv_1.8.31
mime_0.9 munsell_0.5.0 nlme_3.1.141 pillar_1.4.4 pkgbuild_1.0.8 pkgconfig_2.0.3 pkgload_1.1.0 praise_1.0.0
prettyunits_1.1.1 processx_3.4.2 promises_1.1.0 ps_1.3.3 purrr_0.3.4 R6_2.4.1 RColorBrewer_1.1.2 Rcpp_1.0.4.6
rlang_0.4.6 rprojroot_1.3.2 rstudioapi_0.11 scales_1.1.1 shiny_1.4.0 sourcetools_0.1.7 splines_3.6.3 stats_3.6.3
testthat_2.3.2 tibble_3.0.1 tidyselect_1.1.0 tools_3.6.3 utf8_1.1.4 utils_3.6.3 vctrs_0.3.1 viridisLite_0.3.0
withr_2.2.0 xfun_0.14 xtable_1.8-4 yaml_2.2.1
推荐答案
在运行 replaceData 之前必须先解除绑定.
You have to unbind before running replaceData.
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
title = 'Selectinput column in a table',
......
和在 server 中:
......
session$sendCustomMessage("unbindDT", "foo_dt")
ReplaceData_foo_dtRefresh (react)
这篇关于渲染 DT 中单列的下拉列表闪亮但仅在单元格单击时加载并使用 replaceData()的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
