R - 当用户在不同的页面上时，闪亮的数据表（renderDataTable）重新加载到第一页并更新某个列值（selectInput）
Posted
技术标签:
【中文标题】R - 当用户在不同的页面上时，闪亮的数据表（renderDataTable）重新加载到第一页并更新某个列值（selectInput）【英文标题】：R - Shiny Data Table (renderDataTable) reloads to first page when user is on a different page and updates a certain column value (selectInput) 【发布时间】：2019-04-21 14:12:37 【问题描述】：问题：每当用户在数据表的不同页面上并更新某个列值（通过 selectInput）时，R Shiny 数据表都会重新加载到第一页。
您好 Stack 用户，
在 R Shiny 中，我创建了一个 Shiny 应用程序，其中包含一个数据表 (renderDataTable)，其中“status”列的单元格值可以由其预期用户更新（通过 selectInput）。
我准备了以下代码的简化示例。
ui.R
require(shiny)
require(shinyjs)
require(data.table)
require(dplyr)
require(DT)
shinyUI(fluidPage(
useShinyjs(),
mainPanel("",
fluidRow(
splitLayout(div(DT::dataTableOutput('my_table')),
div(
shinyjs::hidden(
wellPanel(id="my_panel",
h3("Update Status",align="center"),
htmlOutput("my_status")
)
)
)
)
)
)
))
server.R
#### DATA PREP AND FUNCTIONS ######################
id <- c('10001','10002','10003','10004','10005',
'10006','10007','10008','10009','10010',
'10011','10012','10013','10014','10015')
status <- c('OPEN','OPEN','CLOSED','CLOSED','OPEN',
'OPEN','CLOSED','CLOSED','OPEN','CLOSED',
'CLOSED','OPEN','OPEN','OPEN','CLOSED')
dt <- data.table(id=id,status=status)
render_my_table <- function(dt, sel)
if(missing(sel))
sel = list(mode='single')
else
sel = list(mode='single', selected = sel)
return (DT::datatable(dt[, list("ID" = id, "Status"=status)],
selection = sel, filter="top",
options = list(sDom = '<"top">lrt<"bottom">ip',
lengthChange = FALSE,
pageLength = 5)))
change_status <- function(s_id, s, user, new_dt)
if(!(s %in% c('OPEN','CLOSED')))
return (new_dt)
new_dt[id == s_id, status :=s]
return (new_dt)
#### SERVER ###############################
function(input, output, session)
output$my_table = DT::renderDataTable(
render_my_table(dt)
, server=TRUE)
observeEvent(input$my_table_cell_clicked,
row = as.numeric(input$my_table_rows_selected)
user = dt[row]
if(nrow(user) == 0)
return ()
session$userData$curr_case <- user$id
session$userData$curr_row <- row
output$my_status <- renderUI(
selectInput("my_status", "", c('OPEN','CLOSED'), selected=user$status)
)
shinyjs::showElement(id= "my_panel")
)
observeEvent(input$my_status,
if(isTRUE(session$userData$curr_case != ""))
new_dt = dt
current_status = new_dt[id == session$userData$curr_case]$status
new_status = input$my_status
if(current_status != new_status)
new_dt = change_status(session$userData$curr_case, new_status, new_dt)
output$my_table = DT::renderDataTable(
render_my_table(new_dt, session$userData$curr_row)
)
)
基本上，一旦用户从表格中选择了一行，表格右侧就会弹出一个隐藏面板。这显示了一个包含两个选项的下拉列表 (selectInput)，以便用户可以更新所选行的列状态值（打开到关闭，反之亦然）。
现在，代码按预期工作。但是，它有一个困扰该工具用户的错误。一旦用户在数据表的第 1 页以外的页面上（例如第 2 页，...到第 n 页）并且他/她更新了行的状态，就会发生更改，但数据表会重新加载第一页。
回到我的问题陈述，有什么方法可以使用 R Shiny 函数编写代码，用户可以实时更新单元格（通过下拉列表），而无需重新加载表回到第一页?
我已经尝试在这里和互联网搜索了几天，但直到现在还没有运气。任何线索将不胜感激。谢谢！
米克洛斯
【问题讨论】：
【参考方案1】：检查下面根据您的示例编辑和评论的代码。我将ui 和server 组合成一个脚本。
主要思路是在render_my_table中添加一个回调函数，在DT对象被渲染时刷新到正确的页面索引。
require(shiny)
require(shinydashboard)
require(shinyjs)
require(data.table)
require(dplyr)
require(DT)
require(htmltools)
ui <- shinyUI(fluidPage(
useShinyjs(),
mainPanel("",
fluidRow(
splitLayout(#cellWidths = c("110%", "40%"),
div(DT::dataTableOutput('my_table')),
div(
shinyjs::hidden(
wellPanel(id="my_panel",
h3("Update Status",align="center"),
htmlOutput("my_status")
)
)
)
)
)
)
))
#### DATA PREP AND FUNCTIONS ######################
id <- c('10001','10002','10003','10004','10005',
'10006','10007','10008','10009','10010',
'10011','10012','10013','10014','10015')
status <- c('NEW','PENDING','SOLVED','CLOSED','NEW',
'PENDING','SOLVED','CLOSED','NEW','PENDING',
'SOLVED','CLOSED','NEW','PENDING','SOLVED')
owner <- c('Alice','Bob','Carol','Dave','Me',
'Carol','Bob','Dave','Me','Alice',
'Me','Dave','Bob','Alice','Carol')
dt <- data.table(id=id,status=status)
st <- data.table(id=id,status=status,owner=owner)
render_my_table <- function(dt, sel, pgRowLength, curPgInd = 1)
if(missing(sel))
sel = list(mode='single')
else
sel = list(mode='single', selected = sel)
# Define a javascript function to load a currently selected page
pgLoadJS <- paste0('setTimeout(function() table.page(', curPgInd - 1,').draw(false);, 100);')
return (DT::datatable(dt[, list("ID" = id, "Status"=status)],
selection = sel, filter="top",
options = list(sDom = '<"top">lrt<"bottom">ip',
lengthChange = FALSE,
pageLength = pgRowLength
),
callback = JS(pgLoadJS) # Updates the page index when the table renders
)%>%
formatStyle('Status',
target = 'row',
backgroundColor = styleEqual(c('NEW', 'PENDING', 'SOLVED', 'CLOSED'),
c('white', 'yellow', 'dodgerblue', 'green'))
)
)
get_user_ses <- function()
return ("Me")
change_status <- function(s_id, s, user, new_dt)
if(!(s %in% c('NEW', 'PENDING', 'FRAUD', 'SOLVED', 'CLOSED')))
return (new_dt)
st = st
if(nrow(st[id == s_id]) == 0)
st = rbind(st, data.table("id" = c(s_id), "status" = c(s), "owner" = c(ifelse(is.null(user), NA, user))))
else
st[id == s_id, status:=s]
st[id == s_id, owner:=ifelse(is.null(user), NA, user)]
new_dt[id == s_id, status :=s]
new_dt[id == s_id, owner :=user]
return (new_dt)
#### SERVER ###############################
# Defines number of rows per page to find the page number of the edited row
defaultPgRows <- 5
server <- function(input, output, session)
# Saves the row index of the selected row
curRowInd <- reactive(
req(input$my_table_rows_selected)
as.numeric(input$my_table_rows_selected)
)
output$my_table = DT::renderDataTable(
render_my_table(dt,
pgRowLength = defaultPgRows)
, server=TRUE)
observeEvent(input$my_table_cell_clicked,
row = curRowInd()
user = dt[row]
if(nrow(user) == 0)
return ()
session$userData$curr_case <- user$id
session$userData$curr_row <- row
output$my_status <- renderUI(
selectInput("my_status", "", c('NEW','PENDING','SOLVED','CLOSED'), selected=user$status)
)
shinyjs::showElement(id= "my_panel")
)
observeEvent(input$my_status,
if(isTRUE(session$userData$curr_case != ""))
new_dt = dt
current_status = new_dt[id == session$userData$curr_case]$status
new_status = input$my_status
if(current_status != new_status)
new_dt = change_status(session$userData$curr_case, new_status, get_user_ses(), new_dt)
# Calculates the page index of the edited row
curPageInd <- ceiling(curRowInd() / defaultPgRows)
print(curPageInd)
output$my_table = DT::renderDataTable(
render_my_table(new_dt, session$userData$curr_row,
pgRowLength = defaultPgRows,
curPgInd = curPageInd) # Uses the current page index to render a new table
)
)
runApp(list(ui = ui, server = server), launch.browser = TRUE)
希望这会有所帮助。
【讨论】：
以上是关于R - 当用户在不同的页面上时，闪亮的数据表（renderDataTable）重新加载到第一页并更新某个列值（selectInput）的主要内容，如果未能解决你的问题，请参考以下文章