0

Need Help, I have a table with two rows namely date_time and Risk, what I want to do is User can editable directly on the output table Shiny, where:

  1. for Row Date_time can be inputted directly with dateInput()
  2. Row Risk can be inputted with a dropdown list with options c('high', 'medium', 'low')

Is this possible or not?

Thanks a lot for any help

library(tidyverse)
library(shiny)
library(DT)



mydata = data.frame(
  date_time = as.Date(c('30-12-2000', '30-12-1999', '30-12-1998'), format = '%d-%m-%Y'),
  risk = c('high', 'medium', 'low')
)

mydata_t <- t(mydata)


ui <- fluidPage(
  
  DTOutput(outputId = "final_tbl")
)

server <- function(input, output){
  df1 <- reactiveValues(data=NULL)
  dat <- reactive({
    mydata_t
  })
  
  observe({
    df1$data <- dat()
  })
  
  output$final_tbl <- renderDT({
    
    df1$data %>%
      datatable(editable = list(target = "cell", disable = list(columns = c(0))), options = list(paging = FALSE, searching = FALSE))
    
  })
  
  observeEvent(input$final_tbl_cell_edit, {
    info = input$final_tbl_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    
    
    df1$data[i, j] <<- (DT::coerceValue(v, df1$data[i, j]))
    ## I don't know what to write in here

  })
  
}

shinyApp(ui, server)

UPDATE :

I modified the script refer to example and it's worked now...thanks

library(shiny)
library(DT)
library(dplyr)



data = data.frame(
  Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G')
)
  
  

if (interactive()) {
  ui <- fluidPage(
    DT::dataTableOutput('interface_table'),
    br(),
    actionButton("do", "Apply"),
    br(),
    hr(),
    tabsetPanel(
      tabPanel("contents", DT::dataTableOutput('contents')),
      tabPanel("it_contents", DT::dataTableOutput('it_contents'))
    ),
    br()    
  )
  
  server <- function(input, output, session) {
    
    output$contents <- DT::renderDataTable(
      data)
    
  
  
  # create a character vector of shiny inputs
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- numeric(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
    }
    inputs
  }
  
  # obtain the values of inputs
  shinyValue <- function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
      value <- input[[paste0(id, i)]]
      if (is.null(value)) NA else value
    }))
  }
  
  
  
  it_df <- reactive({
    data.frame(
      Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G'),
      date_time = shinyInput(textInput, nrow(data),
                        "date1", value = NULL, width = "150px", placeholder = 'yyyy-mm-dd'),
      risk = shinyInput(selectInput, nrow(data),
                        'select_risk', choices = c('high', 'medium', 'low' ), width = "100px"),
      Nmonth = shinyInput(numericInput, nrow(data),
                        'number_month', value = 12,
                        width = '100%', min = 0, max = 12),
      stringsAsFactors = FALSE
    )
  })
  
  
  output$interface_table <- DT::renderDataTable(
    it_df(), rownames = FALSE, escape = FALSE, options = list(
      autoWidth = TRUE, scrollX = TRUE, #scrollY = '400px',
      dom = 't', ordering = FALSE,
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
  )
  
  it_data <- reactive({
    if (input$do > 0) {
      dat <- data.frame(
        Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G'),
        year = substr(shinyValue('date1', nrow(data)), start = 1, stop = 4),
        date_time=shinyValue('date1', nrow(data)),
        risk = shinyValue('select_risk', nrow(data)),
        Nmonth = shinyValue('number_month', nrow(data)),
        weight = (12/ shinyValue('number_month', nrow(data)))
        
      )
      return(dat)
    }
    else { return() }
  })
  
  output$it_contents <- DT::renderDataTable(
    it_data(),  options = list( dom = 't', ordering = FALSE),
    rownames = TRUE, selection = 'none')
  }
}


shinyApp(ui, server)

Reza AM
  • 73
  • 6
  • It is possible, you can either make the entire table editable or add columns with input elements. From your question it seems you are interested in the latter. [See here for an example](https://stackoverflow.com/questions/48160173/r-shiny-extract-values-from-numericinput-datatable-column). If you get stuck, please let me know and I will try to help. – Tom Aug 25 '21 at 14:33
  • Thanks a lot Tom I think I can use your solution @Tom – Reza AM Aug 25 '21 at 15:38

0 Answers0