Как обновить данные пользователя в R блестящий?

Question

В приведенном ниже примере я создал кнопки Import demo data и GO для иллюстрации форматов данных и графика вывода. Мне интересно, как я могу обновить его, если пользователь загружает input$file1 и input$file2 et c.

rm(list=ls())
library(tidyverse)
library(readxl)
library(shiny)
library(shinyjs)
library(shinyWidgets)

jsResetCode <- "shinyjs.reset = function() {history.go(0)}"

ui <- fluidPage(

  #reset session by reset button
  useShinyjs(),                                           # Include shinyjs in the UI
  extendShinyjs(text = jsResetCode, functions="shinyjs.reset"), 

  #panels
  tabsetPanel(
    ##tabPanel-Input
    tabPanel("Input", fluid = TRUE,

             # tab title ----
             titlePanel("Upload data"),

             # sidebar layout with input and output tables ----
             sidebarLayout(

               # sidebar panel for inputs ----
               sidebarPanel(
                 #show ct demo
                 actionBttn("runexample", "Import demo data", style="simple", size="sm", color = "primary"),

                 # input1: Select a file ----
                 fileInput("file1", "Count matrix File (.xlsx)",
                           multiple = FALSE,
                           accept = c("text/csv",
                                      "text/comma-separated-values,text/plain",
                                      ".csv")),

                 #input2: select a file ----
                 fileInput("file2", "Manifest File (.xlsx)",
                           multiple = FALSE,
                           accept = c("text/csv",
                                      "text/comma-separated-values,text/plain",
                                      ".csv")),

                 #select column name
                 selectInput("design", "Column name for analysis", " "),

                 #select ref group
                 uiOutput("level0"),

                 #select study group
                 uiOutput("level1"),

                 #select column name
                 selectInput("species", "Species", c("Human"="Human", "Mouse"="Mouse")),

                 #action run
                 actionBttn("runbutton", "GO", style="simple", size="sm", color = "primary"),

                 actionBttn("reset", "RESET", style="simple", size="sm", color = "warning"),

               ),
               # Main panel for displaying outputs ----
               mainPanel(
                 # Output: Data file ----
                 span(textOutput("ngene"),style="color:blue"),
                 span(textOutput("nsample"),style="color:blue"),
                 tableOutput("matrix"),
                 tableOutput("pdat")
               )
             )
    ),
    tabPanel("plot", fluid = TRUE,
             plotOutput("plotxy")
    )
  )
)

server <- function(input, output, session) {
  #tabPanel-Input
  ###demo data
  ####count
  ###display demo count matrix
  observeEvent(input$runexample, {
    set.seed(123456)
    n=2000; m=6
    ctobj<- reactive({
      count<-cbind.data.frame(gene=letters[1:20],
                              sample1=rbinom(20, 50, 0.6), 
                              sample2=rbinom(20, 50, 0.6),
                              sample3=rbinom(20, 50, 0.6),
                              sample4=rbinom(20, 50, 0.6),
                              sample5=rbinom(20, 50, 0.6),
                              sample6=rbinom(20, 50, 0.6))
      return(count)
    })

    ####manifest
    pobj<- reactive({
      pheno<-data.frame(ID=paste0("sample", 1:m), 
                        Treatment=rep(c("Dose10", "Control", "Dose20"), each=2), 
                        Gender=sample(c("F", "M"), m, T))
      return(pheno)
    })
    #ngenes
    output$ngene <- renderText({paste("Number of genes: ", dim(ctobj())[1], " [First 10 rows displayed]")})
    #nsamples
    output$nsample <- renderText({paste("Number of samples: ", (dim(ctobj())[2])-1, " [First 10 rows displayed]")})
    #display 10rows count matrix
    output$matrix <- renderTable({
      head(ctobj(), 10)
    })
    #display10rows manifest
    output$pdat <- renderTable({
      head(pobj(), 10)
    })
    #model variables
    ##comparison variable
    observe({
      updateSelectInput(session, "design", choices="Treatment")
    })
    ##ref0
    output$level0 <- renderUI({
      selectInput("ref0", "Reference group", "Control")
    })
    ##ref1
    output$level1 <- renderUI({
      selectInput("ref1", "Study group", "Dose20")
    })
    ##species
    observe({
      updateSelectInput(session, "species", choices="Human")
    })
  })

  observeEvent(input$runbutton, {
    output$plotxy <- renderPlot({
      plot( ctobj()$gene, ctobj()$sample1)
    })
  })
  #RESET for new analysis
  observeEvent(input$reset, {js$reset()}) 
}

shinyApp(ui, server)

Если пользователь загружает локальные наборы данных, при нажатии кнопки GO вывод должен основываться на фрагменте ниже (а не на демонстрационных данных).

#USER'S DATA ANALYSIS
  ##READ COUNT MATRIX
  ctobj <- reactive({
    req(input$file1)
    count <- read_excel(input$file1$datapath)
    return(count)
  })
  ##READ MANIFEST
  pobj <- reactive({
    req(input$file2)
    pheno <- read_excel(input$file2$datapath)
    return(pheno)
  })
  ##SHOW SUMMARY
  output$ngene <- renderText({paste("Number of genes: ", dim(ctobj())[1], ". [First 10 rows displayed]")})

  output$nsample <- renderText({paste("Number of samples: ", (dim(ctobj())[2])-1, ". [First 10 rows displayed]")})

  ##DISPLAY 10 ROWS
  output$matrix <- renderTable({
    head(ctobj(), 10)
  })

  output$pdat <- renderTable({
    head(pobj(),  10)
  })

  ##MODEL VARIABLES
  ###COMPARISON VARIALBE
  observe({
    updateSelectInput(session, "design", choices=names(pobj()))
  })
  ###CONTROL
  output$level0 <- renderUI({
    selectInput("ref0", "Reference group", pobj()[[input$design]])
  })
  ###TARGET
  output$level1 <- renderUI({
    selectInput("ref1", "Study group", pobj()[[input$design]])
  })

Answer 1

Мне кажется, что вы должны поместить свой второй блок только в observeEvent среду:

### ALL OF YOUR FIRST CHUNK

observeEvent(input$runbutton, {

  ## YOUR SECOND CHUNK

})