CODEWITHSUNDEEP
rshinysubsetdt
Ludo Vic
Ludo Vic

Reputation: 17

How to subset DT with edited cells on shiny

i'm trying to get a subseted datatable form shiny DT output where i have edited some cells. dont need to edit the original datatable, just render the values edited. there is how my shiny UI looks :

the fist DT is source data the second is made with selected rows of the first and three lines under is weighted mean ; weighted standart deviation; and sum of the second data table.

i make the col "Poids" of the second DT editable and i would like extract a DT with edited(and others too) DT2 too make my 3 calculation on it.

there is part of my code :

 
 
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()})

as you can see i make the x3 object (expected DT2 (x2) with row edited) with the input$x2_rows_all but that dont work.

is that possible?

exemple with iris data####

Ok sorry there is an exemple with iris data.

I made the 1st col (sepal length) editable ; the sepal length have action on my weighted mean as weight.

How to make my 3 bot lines reactive when I edit the sepal length col?

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)

Upvotes: 0

Views: 791

Answers (1)

starja
starja

Reputation: 10375

The underlying problem is that the edited data in the table is not written back into the reactive/data object x2 you use to generate the table. So you have to add the logic to read out the edited data. I've solved this by storing the data that is used to render the table with the selected rows as a reactiveValues object, dat$x2. Then I added 2 observeEvent:

  • one to listen for edits of the selected rows
  • one to listen for changes which rows are selected. However, as the event I use input$x1_cell_clicked, because input$x1_rows_selected does not trigger when the last selected row gets deselected and no rows are selected at all. Also, it contains the logic to only add new rows but not overwrite rows that were selected before, because otherwise possible edits would be lost
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)

Upvotes: 0

Related Questions