DT闪亮BUT中单列的渲染下拉列表仅在单击单元格并使用replaceData()时加载 [英] render dropdown for single column in DT shiny BUT loaded only on cell click and with replaceData()
本文介绍了DT闪亮BUT中单列的渲染下拉列表仅在单击单元格并使用replaceData()时加载的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
- 要在DT数据表中选择下拉列表而不是在数据表的构建中而是在单元格上构建，请使用
replaceData()并使用RDBMS(SQL Server)上的数据. - 当我单击的选定选项时，例如
Ohio，我要设置ID为2的数据(和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()
- 选择事件未绑定.奇怪的是，只有我单击的单元格是未绑定的.
- 所选页面丢失
- 更新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闪亮，如何使数据表对数据表中的复选框做出反应，由史瑞克·谭
- 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
在此先感谢您的帮助:)
Thank you in advance for your help :)
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("[\r\n]", "", 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闪亮BUT中单列的渲染下拉列表仅在单击单元格并使用replaceData()时加载的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
