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:
- for Row Date_time can be inputted directly with dateInput()
- 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)