Button to add entry column to r shiny datatable

2019-05-25 03:41发布

问题:

I am looking to find a way to add a button to a datatable in r shiny that: Adds an empty column to the data table each time it is clicked (and dataframe that made the table in the first place Which the user can fill himself With numeric or text values And set their own column name to describe the type of entry values.

To for instance add lab note records to instrument data that is already in the shiny app manually

I am asking in case a more skilled person who has a better clue than me knows how to do this. I have read a bunch of pages, but at best the example I found provides 1 fixed empty column with a fixed name

empty column

A dummy table from the package : library(DT)

ui <- basicPage(
  h2("The mtcars data"),
  DT::dataTableOutput("mytable")
)

server <- function(input, output) {
  output$mytable = DT::renderDataTable({
    mtcars
  })
}

shinyApp(ui, server)

回答1:

You can use a button to add a new column to a R shiny datatable like this:

ui <- fluidPage(
  h2("The mtcars data"),
  DT::dataTableOutput("mytable"),
  textInput('NewCol', 'Enter new column name'),
  radioButtons("type", "Column type:",
               c("Integer" = "integer",
                 "Floating point" = "numeric",
                 "Text" = "character")),
  actionButton("goButton", "Update Table")
)

server <- function(input, output) {
  mydata <- mtcars
  output$mytable = DT::renderDataTable(df())
  df <- eventReactive(input$goButton, {
    if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
      if (input$type == "integer") v1 <- integer(NROW(mydata))
      if (input$type == "numeric") v1 <- numeric(NROW(mydata))
      if (input$type == "character") v1 <- character(NROW(mydata))
      newcol <- data.frame(v1)
      names(newcol) <- input$NewCol
      mydata <<- cbind(mydata, newcol)
    }
    mydata
  }, ignoreNULL = FALSE)
}    
shinyApp(ui,server)

If you also need to edit the contents of the cells interactively, you can use renderRHandsontable instead of renderDataTable. Like this:

library(rhandsontable)

ui <- fluidPage(
  h2("The mtcars data"),
  rHandsontableOutput("mytable"),
  textInput('NewCol', 'Enter new column name'),
  radioButtons("type", "Column type:",
    c("Integer" = "integer",
      "Floating point" = "numeric",
      "Text" = "character")),
  actionButton("goButton", "Update Table")
)

server <- function(input, output) {
  mydata <- mtcars[1:5,]
  output$mytable = renderRHandsontable(df())
  df <- eventReactive(input$goButton, {
    if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
      if (input$type == "integer") v1 <- integer(NROW(mydata))
      if (input$type == "numeric") v1 <- numeric(NROW(mydata))
      if (input$type == "character") v1 <- character(NROW(mydata))
      newcol <- data.frame(v1)
      names(newcol) <- input$NewCol
      mydata <<- cbind(mydata, newcol)
    }
    rhandsontable(mydata, stretchH = "all")
  }, ignoreNULL = FALSE)
  observe(if (!is.null(input$mytable)) mydata <<- hot_to_r(input$mytable))
}

shinyApp(ui,server)