如何在闪亮的编辑单元格上对 DT 进行子集化
How to subset DT with edited cells on shiny
我正在尝试从闪亮的 DT 输出中获取子集数据table，其中我编辑了一些单元格。
不需要编辑原始数据table，只需渲染编辑后的值。
这就是我闪亮的 UI 的样子：
第一个DT为源数据
第二个是用第一个的选定行制作的
下面三行是加权平均值；加权标准差；和第二个数据的总和 table.
我制作了第二个 DT edi 的“Poids”table，我想提取一个编辑过的 DT（以及其他）DT2 也在其上进行我的 3 计算。
我的代码有一部分：
x2<-reactive({
sel <- input$x1_rows_selected
if(length(valdureT())){
valdureT()[sel, ]
}
})
output$x2 = DT::renderDataTable(x2(), rownames = FALSE,editable = list(
target = 'cell', disable = list(columns = c(1:9))),
extensions = c ('RowGroup'),
options = list(rowGroup = list(dataSrc = 2), order = list(c(4 , 'asc'))),
selection = 'none'
)
x3<-reactive({
sel <- input$x2_rows_all
if(length(x2())){
x2()[sel, ]
}
})
M<-reactive({M <- x3()$"Dureté Moyenne"
M<-as.numeric(M)})
S<-reactive({S<- x3()$"Ecart Type Dureté"
S<-as.numeric(S)})
N<-reactive({N<- x3()$Poids
N<-as.numeric(N)
})
dureTmoymoy<- reactive({paste("Dureté Moyenne des batchs séléctionnés : ",{weighted.mean(M(), N())}," kg")})
sdmoy<- reactive({paste("Ecart Type des batchs selectionnés : ",{sqrt(weighted.mean(S()^2 + M()^2, N()) - weighted.mean(M(), N())^2)}," kg")})
poidsselect<- reactive({paste("Poids des batchs selectionnés :", {sum(N())}," kg")})
output$dureTmoymoy<-renderText({dureTmoymoy()})
output$sdmoy<-renderText({sdmoy()})
output$poidsselect<-renderText({poidsselect()})
如您所见，我使用输入 $x2_rows_all 创建了 x3 对象（预期的 DT2 (x2) 并编辑了行），但这不起作用。
这可能吗？
以虹膜数据为例####
好的抱歉，这里有一个虹膜数据的例子。
我制作了第一列（萼片长度）editable；萼片长度对我的加权平均值有影响。
如何在我编辑萼片长度列时使我的 3 条机器人线反应？
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
wellPanel(
fluidRow(
column(12,h2("iris head" , align = "center"), DT::dataTableOutput('x1')),
column(12,h2("row selected on iris head" , align = "center"), DT::dataTableOutput('x2'))
),
h2("3 calculation about 2nd DT with edited cells"),
h3(textOutput("dureTmoymoy", inline = TRUE)),
h3(textOutput("sdmoy", inline = TRUE)),
h3(textOutput("poidsselect", inline = TRUE)),
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
headiris<- reactive({
headiris<-head(iris)
headiris<-as.data.frame(headiris)
})
output$x1 = DT::renderDataTable(headiris())
x2<-reactive({
sel <- input$x1_rows_selected
if(length(headiris())){
headiris()[sel, ]
}
})
output$x2 = DT::renderDataTable(x2(), rownames = FALSE,editable = list(
target = 'cell', disable = list(columns = c(1:6))),
selection = 'none'
)
x3<-reactive({
sel <- input$x2_rows_all
if(length(x2())){
x2()[sel, ]
}
})
M<-reactive({M <- x3()$"Petal.Length"
M<-as.numeric(M)})
S<-reactive({S<- x3()$"Sepal.Width"
S<-as.numeric(S)})
N<-reactive({N<- x3()$"Sepal.Length"
N<-as.numeric(N)
})
dureTmoymoy<- reactive({paste("petal lenght weighted mean ",{weighted.mean(M(), N())}," kg")})
sdmoy<- reactive({paste("sepal width weighted mean (SD) ",{sqrt(weighted.mean(S()^2 + M()^2, N()) - weighted.mean(M(), N())^2)}," kg")})
poidsselect<- reactive({paste("Sepal lenght sum :", {sum(N())}," kg")})
output$dureTmoymoy<-renderText({dureTmoymoy()})
output$sdmoy<-renderText({sdmoy()})
output$poidsselect<-renderText({poidsselect()})
}
# Run the application
shinyApp(ui = ui, server = server)
潜在的问题是 table 中编辑的数据没有写回用于生成 table 的 reactive/data 对象 x2。所以你必须添加逻辑来读出编辑的数据。我通过将用于呈现 table 和选定行的数据存储为 reactiveValues 对象 dat$x2 来解决此问题。然后我添加了 2 observeEvent:
- 一个监听所选行的编辑
- 一个监听选择行的变化。但是，作为我使用
input$x1_cell_clicked 的事件，因为 input$x1_rows_selected 不会在最后选定的行被取消选择并且根本没有选择任何行时触发。此外，它包含仅添加新行但不覆盖之前选择的行的逻辑，因为否则可能的编辑将丢失
library(shiny)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
wellPanel(
fluidRow(
column(12,h2("iris head" , align = "center"), DT::dataTableOutput('x1')),
column(12,h2("row selected on iris head" , align = "center"), DT::dataTableOutput('x2'))
),
h2("3 calculation about 2nd DT with edited cells"),
h3(textOutput("dureTmoymoy", inline = TRUE)),
h3(textOutput("sdmoy", inline = TRUE)),
h3(textOutput("poidsselect", inline = TRUE)),
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
headiris<- reactive({
headiris<-head(iris)
headiris<-as.data.frame(headiris)
})
output$x1 = DT::renderDataTable(headiris())
output$x2 = DT::renderDataTable({
req(dat$x2)
DT::datatable(dat$x2[, colnames(dat$x2) != "selected_row"], rownames = FALSE,editable = list(
target = 'cell', disable = list(columns = c(1:6))),
selection = 'none')
})
# define the data as reactive value
dat <- reactiveValues()
# listen for changes which rows are selected
observeEvent(input$x1_cell_clicked, {
print(input$x1_rows_selected)
if (is.null(dat$x2)) {
new_data <- cbind(selected_row = input$x1_rows_selected, headiris()[input$x1_rows_selected, ])
dat$x2 <- new_data
} else {
old_rows <- dat$x2
old_row_numbers <- dat$x2$selected_row
# rows to add
new_row_number <- setdiff(input$x1_rows_selected, old_row_numbers)
if (length(new_row_number) != 0) {
new_row <- cbind(selected_row = new_row_number, headiris()[new_row_number, ])
new_data <- rbind(old_rows, new_row)
new_data <- new_data %>%
arrange(selected_row)
}
# rows to delete
delete_row_numbers <- setdiff(old_row_numbers, input$x1_rows_selected)
if (length(delete_row_numbers) != 0) {
new_data <- dat$x2 %>%
filter(selected_row %in% input$x1_rows_selected)
}
dat$x2 <- new_data
}
})
# update edited data
observeEvent(input$x2_cell_edit, {
data_table <- dat$x2
data_table[input$x2_cell_edit$row, "Sepal.Length"] <- as.numeric(input$x2_cell_edit$value)
dat$x2 <- data_table
})
M<-reactive({M <- dat$x2$"Petal.Length"
M<-as.numeric(M)})
S<-reactive({S<- dat$x2$"Sepal.Width"
S<-as.numeric(S)})
N<-reactive({N<- dat$x2$"Sepal.Length"
N<-as.numeric(N)
})
dureTmoymoy<- reactive({paste("petal lenght weighted mean ",{weighted.mean(M(), N())}," kg")})
sdmoy<- reactive({paste("sepal width weighted mean (SD) ",{sqrt(weighted.mean(S()^2 + M()^2, N()) - weighted.mean(M(), N())^2)}," kg")})
poidsselect<- reactive({paste("Sepal lenght sum :", {sum(N())}," kg")})
output$dureTmoymoy<-renderText({dureTmoymoy()})
output$sdmoy<-renderText({sdmoy()})
output$poidsselect<-renderText({poidsselect()})
}
# Run the application
shinyApp(ui = ui, server = server)
我正在尝试从闪亮的 DT 输出中获取子集数据table，其中我编辑了一些单元格。 不需要编辑原始数据table，只需渲染编辑后的值。 这就是我闪亮的 UI 的样子：
第一个DT为源数据 第二个是用第一个的选定行制作的 下面三行是加权平均值；加权标准差；和第二个数据的总和 table.
我制作了第二个 DT edi 的“Poids”table，我想提取一个编辑过的 DT（以及其他）DT2 也在其上进行我的 3 计算。
我的代码有一部分：
x2<-reactive({
sel <- input$x1_rows_selected
if(length(valdureT())){
valdureT()[sel, ]
}
})
output$x2 = DT::renderDataTable(x2(), rownames = FALSE,editable = list(
target = 'cell', disable = list(columns = c(1:9))),
extensions = c ('RowGroup'),
options = list(rowGroup = list(dataSrc = 2), order = list(c(4 , 'asc'))),
selection = 'none'
)
x3<-reactive({
sel <- input$x2_rows_all
if(length(x2())){
x2()[sel, ]
}
})
M<-reactive({M <- x3()$"Dureté Moyenne"
M<-as.numeric(M)})
S<-reactive({S<- x3()$"Ecart Type Dureté"
S<-as.numeric(S)})
N<-reactive({N<- x3()$Poids
N<-as.numeric(N)
})
dureTmoymoy<- reactive({paste("Dureté Moyenne des batchs séléctionnés : ",{weighted.mean(M(), N())}," kg")})
sdmoy<- reactive({paste("Ecart Type des batchs selectionnés : ",{sqrt(weighted.mean(S()^2 + M()^2, N()) - weighted.mean(M(), N())^2)}," kg")})
poidsselect<- reactive({paste("Poids des batchs selectionnés :", {sum(N())}," kg")})
output$dureTmoymoy<-renderText({dureTmoymoy()})
output$sdmoy<-renderText({sdmoy()})
output$poidsselect<-renderText({poidsselect()})
如您所见，我使用输入 $x2_rows_all 创建了 x3 对象（预期的 DT2 (x2) 并编辑了行），但这不起作用。
这可能吗？
以虹膜数据为例####好的抱歉，这里有一个虹膜数据的例子。
我制作了第一列（萼片长度）editable；萼片长度对我的加权平均值有影响。
如何在我编辑萼片长度列时使我的 3 条机器人线反应？
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
wellPanel(
fluidRow(
column(12,h2("iris head" , align = "center"), DT::dataTableOutput('x1')),
column(12,h2("row selected on iris head" , align = "center"), DT::dataTableOutput('x2'))
),
h2("3 calculation about 2nd DT with edited cells"),
h3(textOutput("dureTmoymoy", inline = TRUE)),
h3(textOutput("sdmoy", inline = TRUE)),
h3(textOutput("poidsselect", inline = TRUE)),
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
headiris<- reactive({
headiris<-head(iris)
headiris<-as.data.frame(headiris)
})
output$x1 = DT::renderDataTable(headiris())
x2<-reactive({
sel <- input$x1_rows_selected
if(length(headiris())){
headiris()[sel, ]
}
})
output$x2 = DT::renderDataTable(x2(), rownames = FALSE,editable = list(
target = 'cell', disable = list(columns = c(1:6))),
selection = 'none'
)
x3<-reactive({
sel <- input$x2_rows_all
if(length(x2())){
x2()[sel, ]
}
})
M<-reactive({M <- x3()$"Petal.Length"
M<-as.numeric(M)})
S<-reactive({S<- x3()$"Sepal.Width"
S<-as.numeric(S)})
N<-reactive({N<- x3()$"Sepal.Length"
N<-as.numeric(N)
})
dureTmoymoy<- reactive({paste("petal lenght weighted mean ",{weighted.mean(M(), N())}," kg")})
sdmoy<- reactive({paste("sepal width weighted mean (SD) ",{sqrt(weighted.mean(S()^2 + M()^2, N()) - weighted.mean(M(), N())^2)}," kg")})
poidsselect<- reactive({paste("Sepal lenght sum :", {sum(N())}," kg")})
output$dureTmoymoy<-renderText({dureTmoymoy()})
output$sdmoy<-renderText({sdmoy()})
output$poidsselect<-renderText({poidsselect()})
}
# Run the application
shinyApp(ui = ui, server = server)
潜在的问题是 table 中编辑的数据没有写回用于生成 table 的 reactive/data 对象 x2。所以你必须添加逻辑来读出编辑的数据。我通过将用于呈现 table 和选定行的数据存储为 reactiveValues 对象 dat$x2 来解决此问题。然后我添加了 2 observeEvent:
- 一个监听所选行的编辑
- 一个监听选择行的变化。但是，作为我使用
input$x1_cell_clicked的事件，因为input$x1_rows_selected不会在最后选定的行被取消选择并且根本没有选择任何行时触发。此外，它包含仅添加新行但不覆盖之前选择的行的逻辑，因为否则可能的编辑将丢失
library(shiny)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
wellPanel(
fluidRow(
column(12,h2("iris head" , align = "center"), DT::dataTableOutput('x1')),
column(12,h2("row selected on iris head" , align = "center"), DT::dataTableOutput('x2'))
),
h2("3 calculation about 2nd DT with edited cells"),
h3(textOutput("dureTmoymoy", inline = TRUE)),
h3(textOutput("sdmoy", inline = TRUE)),
h3(textOutput("poidsselect", inline = TRUE)),
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
headiris<- reactive({
headiris<-head(iris)
headiris<-as.data.frame(headiris)
})
output$x1 = DT::renderDataTable(headiris())
output$x2 = DT::renderDataTable({
req(dat$x2)
DT::datatable(dat$x2[, colnames(dat$x2) != "selected_row"], rownames = FALSE,editable = list(
target = 'cell', disable = list(columns = c(1:6))),
selection = 'none')
})
# define the data as reactive value
dat <- reactiveValues()
# listen for changes which rows are selected
observeEvent(input$x1_cell_clicked, {
print(input$x1_rows_selected)
if (is.null(dat$x2)) {
new_data <- cbind(selected_row = input$x1_rows_selected, headiris()[input$x1_rows_selected, ])
dat$x2 <- new_data
} else {
old_rows <- dat$x2
old_row_numbers <- dat$x2$selected_row
# rows to add
new_row_number <- setdiff(input$x1_rows_selected, old_row_numbers)
if (length(new_row_number) != 0) {
new_row <- cbind(selected_row = new_row_number, headiris()[new_row_number, ])
new_data <- rbind(old_rows, new_row)
new_data <- new_data %>%
arrange(selected_row)
}
# rows to delete
delete_row_numbers <- setdiff(old_row_numbers, input$x1_rows_selected)
if (length(delete_row_numbers) != 0) {
new_data <- dat$x2 %>%
filter(selected_row %in% input$x1_rows_selected)
}
dat$x2 <- new_data
}
})
# update edited data
observeEvent(input$x2_cell_edit, {
data_table <- dat$x2
data_table[input$x2_cell_edit$row, "Sepal.Length"] <- as.numeric(input$x2_cell_edit$value)
dat$x2 <- data_table
})
M<-reactive({M <- dat$x2$"Petal.Length"
M<-as.numeric(M)})
S<-reactive({S<- dat$x2$"Sepal.Width"
S<-as.numeric(S)})
N<-reactive({N<- dat$x2$"Sepal.Length"
N<-as.numeric(N)
})
dureTmoymoy<- reactive({paste("petal lenght weighted mean ",{weighted.mean(M(), N())}," kg")})
sdmoy<- reactive({paste("sepal width weighted mean (SD) ",{sqrt(weighted.mean(S()^2 + M()^2, N()) - weighted.mean(M(), N())^2)}," kg")})
poidsselect<- reactive({paste("Sepal lenght sum :", {sum(N())}," kg")})
output$dureTmoymoy<-renderText({dureTmoymoy()})
output$sdmoy<-renderText({sdmoy()})
output$poidsselect<-renderText({poidsselect()})
}
# Run the application
shinyApp(ui = ui, server = server)