根据闪亮小部件的值向现有数据框添加新行

Question

我有一个闪亮的应用程序，默认情况下通过表格显示数据集。然后在侧边栏中有 5 个小部件对应于表格的 5 列。然后是一个操作按钮。

添加：如果用户按下Add，那么他会在表格中添加一个包含所选小部件值的新行。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
Input<-structure(list(`Security Type` = c("Stock", "Stock", "Load Fund"
), Ticker = c("XOM", "NFLX", "AMCPX"), `Purchase Date` = structure(c(16070, 
                                                                     17084, 17084), class = "Date"), `Sale Date` = structure(c(18627, 
                                                                                                                               NA, 18545), class = "Date"), `Amount Invested` = c("$10,000", 
                                                                                                                                                                                  "$8,000", "$10,000")), class = c("spec_tbl_df", "tbl_df", "tbl", 
                                                                                                                                                                                                                   "data.frame"), row.names = c(NA, -3L))
shinyApp(
  ui = tags$body(class="skin-blue sidebar-mini control-sidebar-open",dashboardPage(
    options = list(sidebarExpandOnHover = TRUE),
    header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading",titleWidth = 450),
    
    sidebar = dashboardSidebar(minified = F, collapsed = F,
                               selectInput("sectype", "Security Type",
                                           c(unique(Input$`Security Type`))),
                               selectInput("sectick", "Ticker",
                                           c(unique(Input$Ticker))),
                               dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
                               dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
                               selectInput("aminv", "Amount Invested",
                                           c(unique(Input$`Amount Invested`))),
                               actionButton("add","Add")
                               #actionButton("edit","Edit"),
                               #actionButton("del","Delete")
                               
    ),
    body = dashboardBody(
      h3('Results'),
      tabsetPanel(id = "tabs",
                  tabPanel("InsiderTraining",
                           dataTableOutput("TBL1")
                  )
      )
    ),
    controlbar = dashboardControlbar(width = 300
    ),
    title = "DashboardPage"
  )),
  server = function(input, output) { 
    
    output$TBL1<-renderDataTable(
      datatable(Input)    )
    
  }
)

Answer 1

您可以创建名为data 的反应值，该值会在单击按钮时更新。然后可以使用shiny::isolate将输入的当前值冻结到表中：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
Input <- structure(list(`Security Type` = c("Stock", "Stock", "Load Fund"), Ticker = c("XOM", "NFLX", "AMCPX"), `Purchase Date` = structure(c(
  16070,
  17084, 17084
), class = "Date"), `Sale Date` = structure(c(
  18627,
  NA, 18545
), class = "Date"), `Amount Invested` = c(
  "$10,000",
  "$8,000", "$10,000"
)), class = c(
  "spec_tbl_df", "tbl_df", "tbl",
  "data.frame"
), row.names = c(NA, -3L))
shinyApp(
  ui = tags$body(class = "skin-blue sidebar-mini control-sidebar-open", dashboardPage(
    options = list(sidebarExpandOnHover = TRUE),
    header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading", titleWidth = 450),
    sidebar = dashboardSidebar(
      minified = F, collapsed = F,
      selectInput(
        "sectype", "Security Type",
        c(unique(Input$`Security Type`))
      ),
      selectInput(
        "sectick", "Ticker",
        c(unique(Input$Ticker))
      ),
      dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
      dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
      selectInput(
        "aminv", "Amount Invested",
        c(unique(Input$`Amount Invested`))
      ),
      actionButton("add", "Add")
    ),
    body = dashboardBody(
      h3("Results"),
      tabsetPanel(
        id = "tabs",
        tabPanel(
          "InsiderTraining",
          dataTableOutput("TBL1")
        )
      )
    ),
    controlbar = dashboardControlbar(width = 300),
    title = "DashboardPage"
  )),
  server = function(input, output) {
    # Init with some example data
    data <- reactiveVal(Input)

    observeEvent(
      input$add,
      {
        # start with current data
        data() %>%
          add_row(
            `Security Type` = isolate(input$sectype),
            Ticker = isolate(input$sectick),
            `Purchase Date` = isolate(input$PurDate),
            `Sale Date` = isolate(input$selDate),
            `Amount Invested` = isolate(input$aminv)
          ) %>%
          # update data value
          data()
      }
    )

    output$TBL1 <- renderDataTable(
      datatable(data())
    )
  }
)