admin管理员组文章数量:1321261
I'm working on a datatable in R-Shiny. I'd like to build a datatable that is editable in some columns. Moreover, I need the filter and search functions.
I have to use the server side rendering, because in my final setting I will have a very huge number of lines.
So my problem is that the table is rendered from a reactiveVal. So when I edit some values on page 20, then the table will be reloaded, and I'm back on page 1. This is a problem when I have to edit many columns in one line.
So what can I do? Does anybody have an idea?
Here's a demonstration of my code, but with some fictive data and another context.
library(shiny)
library(DT)
generate_data <- function(n = 100) {
data.frame(
ID = 1:n,
FirstName = paste("FirstName", 1:n),
LastName = paste("LastName", 1:n),
Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
PostalCode = sample(10000:99999, n, replace = TRUE),
City = paste("City", sample(1:50, n, replace = TRUE)),
VisitsPerYear = sample(1:20, n, replace = TRUE),
Status = rep("active", n)
)
}
ui <- fluidPage(
titlePanel("Sample Data for Persons"),
DTOutput("table")
)
server <- function(input, output, session) {
testdata <- reactiveVal(generate_data(100))
output$table <- renderDT({
datatable(testdata(),
options = list(
server = TRUE,
pageLength = 10
),
editable = list(target = 'cell', disable = list(columns = 0:6))
)
})
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
i <- info$row
j <- info$col
v <- info$value
data <- testdata()
if (j == 7) {
data[i, j] <- v
}
testdata(data)
})
}
shinyApp(ui = ui, server = server)
I'm working on a datatable in R-Shiny. I'd like to build a datatable that is editable in some columns. Moreover, I need the filter and search functions.
I have to use the server side rendering, because in my final setting I will have a very huge number of lines.
So my problem is that the table is rendered from a reactiveVal. So when I edit some values on page 20, then the table will be reloaded, and I'm back on page 1. This is a problem when I have to edit many columns in one line.
So what can I do? Does anybody have an idea?
Here's a demonstration of my code, but with some fictive data and another context.
library(shiny)
library(DT)
generate_data <- function(n = 100) {
data.frame(
ID = 1:n,
FirstName = paste("FirstName", 1:n),
LastName = paste("LastName", 1:n),
Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
PostalCode = sample(10000:99999, n, replace = TRUE),
City = paste("City", sample(1:50, n, replace = TRUE)),
VisitsPerYear = sample(1:20, n, replace = TRUE),
Status = rep("active", n)
)
}
ui <- fluidPage(
titlePanel("Sample Data for Persons"),
DTOutput("table")
)
server <- function(input, output, session) {
testdata <- reactiveVal(generate_data(100))
output$table <- renderDT({
datatable(testdata(),
options = list(
server = TRUE,
pageLength = 10
),
editable = list(target = 'cell', disable = list(columns = 0:6))
)
})
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
i <- info$row
j <- info$col
v <- info$value
data <- testdata()
if (j == 7) {
data[i, j] <- v
}
testdata(data)
})
}
shinyApp(ui = ui, server = server)
Share
Improve this question
edited Jan 17 at 16:10
jpsmith
17.7k6 gold badges22 silver badges45 bronze badges
asked Jan 17 at 15:30
KTSBKTSB
1117 bronze badges
1 Answer
Reset to default 0So when I edit some values on page 20, then the table will be reloaded, and I'm back on page 1. This is a problem when I have to edit many columns in one line.
So what can I do? Does anybody have an idea?
First, I would set pageLength = nrow(testdata())
to always show your whole table. Secondly you can use stateSave = TRUE
to remember the state of your table. I would also turn of rownames rownames = FALSE
since you have the ID column anyway. Furthermore I would turn off the row selection as it behaves weird and sometimes overshadows the row value which you want to edit: selection = 'none'
This should do the trick, let me know if this helped. I also have another more fancy JavaScript solution ;)
Code (normal boring way)
library(shiny)
library(DT)
generate_data <- function(n = 100) {
data.frame(
ID = 1:n,
FirstName = paste("FirstName", 1:n),
LastName = paste("LastName", 1:n),
Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
PostalCode = sample(10000:99999, n, replace = TRUE),
City = paste("City", sample(1:50, n, replace = TRUE)),
VisitsPerYear = sample(1:20, n, replace = TRUE),
Status = rep("active", n)
)
}
ui <- fluidPage(
titlePanel("Sample Data for Persons"),
DTOutput("table")
)
server <- function(input, output, session) {
testdata <- reactiveVal(generate_data(100))
output$table <- renderDT({
datatable(testdata(),
options = list(
pageLength = nrow(testdata()),
stateSave = TRUE,
dom = 'Bfrtip' # Adds better control options
),
selection = 'none', # Disable row selection
editable = list(target = 'cell', disable = list(columns = 0:6)),
rownames = FALSE
)
}, server = FALSE) # Move server option here
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
i <- info$row
j <- info$col
v <- info$value
print(j)
data <- testdata()
if (j == 7) {
data[i, j] <- v
testdata(data)
}
})
}
shinyApp(ui = ui, server = server)
Fancy way
library(shiny)
library(DT)
generate_data <- function(n = 100) {
data.frame(
ID = 1:n,
FirstName = paste("FirstName", 1:n),
LastName = paste("LastName", 1:n),
Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
PostalCode = sample(10000:99999, n, replace = TRUE),
City = paste("City", sample(1:50, n, replace = TRUE)),
VisitsPerYear = sample(1:20, n, replace = TRUE),
Status = rep("active", n)
)
}
ui <- fluidPage(
titlePanel("Sample Data for Persons"),
tags$head(
tags$style(HTML("
.dataTable td.status-cell {
padding: 0 !important;
}
.dataTable td.status-cell input {
width: 100%;
border: none;
background: transparent;
margin: 0;
padding: 8px;
height: 100%;
}
"))
),
DTOutput("table")
)
server <- function(input, output, session) {
testdata <- reactiveVal(generate_data(100))
output$table <- renderDT({
datatable(
testdata(),
options = list(
pageLength = nrow(testdata()),
stateSave = TRUE,
dom = 'Bfrtip',
columnDefs = list(
list(
targets = 7,
className = 'status-cell'
)
),
initComplete = JS("
function(settings, json) {
var table = settings.oInstance.api();
var container = table.table().container();
$(container).on('click', 'td.status-cell', function() {
var cell = $(this);
if (!cell.find('input').length) {
var value = cell.text();
cell.html('<input type=\"text\" value=\"' + value + '\">');
cell.find('input').focus();
}
});
$(container).on('blur', 'td.status-cell input', function() {
var input = $(this);
var value = input.val();
var cell = input.closest('td');
var row = table.row(cell.parent()).index();
Shiny.setInputValue('table_cell_edit', {
row: row + 1,
col: 7,
value: value
});
});
// Initialize all status cells with input fields
table.cells('.status-cell').every(function() {
var cell = $(this.node());
var value = cell.text();
cell.html('<input type=\"text\" value=\"' + value + '\">');
});
}
")
),
selection = 'none',
editable = FALSE,
rownames = FALSE
)
}, server = FALSE)
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
i <- info$row
j <- info$col
v <- info$value
data <- testdata()
if (j == 7) {
data[i, j] <- v
testdata(data)
}
})
}
shinyApp(ui = ui, server = server)
本文标签: Editable DT in RShinyStack Overflow
版权声明:本文标题:Editable DT in R-Shiny - Stack Overflow 内容由网友自发贡献,该文观点仅代表作者本人, 转载请联系作者并注明出处:http://www.betaflare.com/web/1742095562a2420525.html, 本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容,一经查实,本站将立刻删除。
发表评论