闪亮 - ObserveEvent 和 actionButton 添加一列到 table

Question

我想完成以下任务：

我想 使用 observeEvent 和操作按钮向呈现的 table 添加一列。最初，table 应显示为由用户上传并由操作按钮触发器更改（添加列）。请注意，在此代码中，用户选择哪一列将为添加的列提供参考值（在此示例中，用户选择的变量的最大值）。

重要的一点是，生成的 table（最近添加的列）应该可供将来在此处未显示的选项卡中进行的数据操作使用。

此外，是否可以在每次更改选择输入时隐藏呈现的table？

感谢任何帮助！

library(shiny)
library(shinydashboard)
library(tidyverse)
library(data.table)


upload_tab <-     tabItem(tabName = "FileUpload",
                          titlePanel("Uploading Files"),
                          sidebarPanel(
                            fileInput('file1', 'Choose file to upload',
                                      accept = c('text/csv',
                                                 'text/comma-separated-values',
                                                 'text/tab-separated-values',
                                                 'text/plain','.csv','.tsv')),
                            checkboxInput("header", "Header", TRUE),
                            radioButtons("sep", "Separator",
                                         choices = c(Comma = ",",
                                                     Semicolon = ";",
                                                     Tab = "\t"),
                                         selected = ","),
                            radioButtons("quote", "Quote",
                                         choices = c(None = "",
                                                     "Double Quote" = '"',
                                                     "Single Quote" = "'"),
                                         selected = '"')),
                          mainPanel(
                            DT::dataTableOutput('contents')
                          )
)

splitter_tab <- tabItem(
  tabName = "Splitter",
  fluidPage(
    box(title = "Split means and letters into two separate columns", width = 3, solidHeader = T, status = "primary",
        selectInput("get_let_mean",'Select column:',choices = NULL),
        br(),
        actionButton("splitter", "Split")),
    mainPanel(
      DT::dataTableOutput('contents1')
    )
  )
)

sideBar_content <- dashboardSidebar(
  sidebarMenu(
    menuItem("Upload File", tabName = "FileUpload"),
    menuItem("Splitter", tabName = "Splitter")
  )
)

body_content <- dashboardBody(
  tabItems(
    upload_tab,
    splitter_tab
  )
)

ui <-  dashboardPage(
  dashboardHeader(title = "Test"),
  ## Sidebar content
  sideBar_content,
  ## Body content
  body_content,
  ## Aesthetic
  skin = "blue"
)

server <- function(input, output,session) {
  
  
  data<-reactive({
    if(is.null(input$file1))
      return()
    inFile <- input$file1
    df <- read.csv(inFile$datapath,
                   header = input$header,
                   sep = input$sep,
                   quote = input$quote)
  }) 
  
  
  output$contents <- DT::renderDataTable({
    DT::datatable(data(),
                  options = list(
                    "pageLength" = 40))
  })
  
  observe({
    value <- names(data())
    updateSelectInput(session,"get_let_mean", choices = value)
  })
  
  observeEvent(input$splitter,{
    d1 <- data() %>% 
      mutate(clean_values=max(.data[[input$get_let_mean]]))
    data(d1)
  })
  
  
  output$contents1 <- DT::renderDataTable({
    DT::datatable(data(),
                  options = list("pageLength" = 40))
  })
  
  
}

shinyApp(ui, server)

文件示例：

file<-c(structure(list(trial_id = c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L
), factor_A = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 13L, 14L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 6L), replicates = c(3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 5L, 5L, 5L, 
5L, 5L, 4L, 4L, 4L, 4L, 4L, 4L), means = c(57.5, 22.5, 17.5, 
25, 5, 2, 3, 2, 12.5, 25, 3, 2.8, 1, 0.5, 64.1, 80.7, 83, 84.4, 
83.7, 25, 20, 25, 26, 27, 28), letters = c("a", "b", "bc", "b", 
"de", "e", "e", "e", "cd", "d", "e", "e", "e", "e", "a", "b", 
"b", "b", "b", "a", "b", "a", "a", "a", "a")), class = "data.frame", row.names = c(NA, 
-25L)))

Answer 1

也许您正在寻找这个

library(shiny)
library(shinydashboard)
library(tidyverse)
library(data.table)
library(DT)


upload_tab <-     tabItem(tabName = "FileUpload",
                          titlePanel("Uploading Files"),
                          sidebarPanel(
                            fileInput('file1', 'Choose file to upload',
                                      accept = c('text/csv',
                                                 'text/comma-separated-values',
                                                 'text/tab-separated-values',
                                                 'text/plain','.csv','.tsv')),
                            checkboxInput("header", "Header", TRUE),
                            radioButtons("sep", "Separator",
                                         choices = c(Comma = ",",
                                                     Semicolon = ";",
                                                     Tab = "\t"),
                                         selected = ","),
                            radioButtons("quote", "Quote",
                                         choices = c(None = "",
                                                     "Double Quote" = '"',
                                                     "Single Quote" = "'"),
                                         selected = '"')),
                          mainPanel(
                            DT::dataTableOutput('contents')
                          )
)

splitter_tab <- tabItem(
  tabName = "Splitter",
  fluidPage(
    box(title = "Split means and letters into two separate columns", width = 3, solidHeader = T, status = "primary",
        selectInput("get_let_mean",'Select column:',choices = NULL),
        br(),
        actionButton("splitter", "Split")),
    mainPanel(
      DT::dataTableOutput('contents1')
    )
  )
)

sideBar_content <- dashboardSidebar(
  sidebarMenu(
    menuItem("Upload File", tabName = "FileUpload"),
    menuItem("Splitter", tabName = "Splitter")
  )
)

body_content <- dashboardBody(
  tabItems(
    upload_tab,
    splitter_tab
  )
)

ui <-  dashboardPage(
  dashboardHeader(title = "Test"),
  ## Sidebar content
  sideBar_content,
  ## Body content
  body_content,
  ## Aesthetic
  skin = "blue"
)

server <- function(input, output,session) {
  rv <- reactiveValues(df=NULL)
  
  data<-reactive({
    if(is.null(input$file1))
      return()
    inFile <- input$file1
    df <- read.csv(inFile$datapath,
                   header = input$header,
                   sep = input$sep,
                   quote = input$quote)
  }) 
  
  
  output$contents <- DT::renderDataTable({
    DT::datatable(data(),
                  options = list(
                    "pageLength" = 40))
  })
  
  observe({
    value <- names(data())
    updateSelectInput(session,"get_let_mean", choices = value)
  })
  
  observeEvent(input$file1,{
    rv$df <- data()
  })
  
  
  observeEvent(input$splitter,{
    rv$df <- rv$df %>% 
      mutate(clean_values= max(.data[[input$get_let_mean]]))
    
  })
  
  
  output$contents1 <- DT::renderDataTable({
    DT::datatable(rv$df,
                  options = list("pageLength" = 40))
  })
  
}

shinyApp(ui, server)

闪亮 - ObserveEvent 和 actionButton 添加一列到 table

Shiny - ObserveEvent and actionButton adding a column to table

radio-button

shiny

dt

reactive