如何使用闪亮的编辑单元对 DT 进行子集化

Question

我正在尝试从闪亮的 DT 输出中获取子集数据表，其中我编辑了一些单元格。 不需要编辑原始数据表，只需渲染编辑的值。 这就是我闪亮的 UI 的外观：

第一个DT是源数据 第二个是用第一行的选定行制作的 和下面的三行是加权平均值；加权标准差；和第二个数据表的总和。

我使第二个 DT 的 col “Poids” 可编辑，我想提取一个带有已编辑（以及其他）DT2 的 DT 也对它进行我的 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)，行已编辑），但这不起作用。

这可能吗？

以虹膜数据为例####

好吧抱歉有一个虹膜数据的例子。

我使第一列（萼片长度）可编辑；萼片长度对我的加权平均值有影响。

当我编辑萼片长度列时如何让我的 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)

Answer 1

根本问题是表中编辑的数据没有写回您用来生成表的反应/数据对象x2。所以你必须添加逻辑来读出编辑过的数据。我通过将用于呈现具有选定行的表的数据存储为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)