Запуск кодов при нажатии на кнопку действия в R блестящий

Question

Я бегу кучу кодов (около 100 строк) в R блестящий. Сначала я хочу, чтобы интерфейс Shiny открывался, и там должна быть кнопка "Action", нажав на которую, он выполнит код и покажет всплывающее окно с завершением. коды не должны выполняться до тех пор, пока не будет нажата кнопка действия.

`

    ui <-navbarPage("Calculator",
       tabPanel("Cal 1", fluidPage(
           headerPanel("Calculation 1"), 
                    sidebarLayout(
                        sidebarPanel(selectInput("Segment","Select Segment",list("Micro"="Micro","PF"="PF","Retail"="Retail",
                                                                      "Corporate"="Corporate"))
                        ),

                        mainPanel(
                          actionButton("Run_1","Run 1"),
                          actionButton("Summary", "Summary"),
                          hr(),
                          tableOutput("variable"),
                          plotOutput("plot1"),
                          plotOutput("plot2"),
                          verbatimTextOutput("Finish_1")
                        )))),
   tabPanel("Cal 2", fluidPage(headerPanel("Calculation 2"),
                        sidebarLayout(
                        sidebarPanel(textInput("CustomerId","Enter Customer ID",value = NULL),
                                     submitButton(text = "Submit")
                        ),

                        mainPanel(
                          actionButton("Run_2","Run 2"),
                          tableOutput("Variable"),
                          verbatimTextOutput("Finish_2")

                        )))),
  )

У меня есть 2 панели, которые выполняют различные вычисления в каждой панели.

server <- function(input, output) {
  model <- reactiveValues(Data=NULL) 
observeEvent(input$Run_1,{
    model$Finish_1<-
  ##### Run  Codes 1##########
})
output$Finish_1<-renderPrint({
  model$Finish_1
   print("Calculation 1 Finished")
 })

####table1 is a table created during run of above codes
observeEvent(input$Summary,{
  model$plot1<-ggplot(table1,aes(x=Stage,y=`Number`,label=`Number of Cust.`))+
    geom_bar(stat = "identity",width=0.7, fill = "#FF6667")+
    geom_text(size = 6, position = position_stack(vjust = 0.5))+ggtitle("Stage")

})
output$plot1 <- renderPlot({
  model$plot1
})
observeEvent(input$Segment,{
  model$plot2<-ggplot(filter(table,Segment==input$Segment), aes(Stage, `Number of Cust`,label=`Number of Cust`)) +
    geom_bar(aes(fill = Stage), position = "dodge", stat="identity")+ggtitle(input$Segment)+
    geom_text(size = 6, position = position_stack(vjust = 0.5))

})
output$plot2<-renderPlot({
  model$plot2
})
model1 <- reactiveValues(Data=NULL) 

  observeEvent(input$Run_2,{
    model1$Finish_2<-

##### Run Codes 2####################
})
  output$Finish_2<-renderPrint({
    model1$Finish_2
    print("Calculation 2 Finished")
    })
  observeEvent(input$CustomerId,{
    model1$Variable<-which(total3$CUSTOMER_ID==input$CustomerId)
  })
####total3 is a table

  output$Variable = renderTable({
    total3[model1$Variable(), ]    #use the search.critera() reactive to determine rows to display
  })
}

Answer 1

Я бы порекомендовал превратить ваш длинный код в функцию и вызвать ее через observeEvent,

long_code.R

function(){
  ## perform actions here
  message("running code...")
  return("some output")
}

app.R

long_code <- source("long_code.R")$value
library(shiny)

shinyApp(
  fluidPage(actionButton("run", "run code")),
  function(input, output, session){
    vals <- reactiveValues()

    observeEvent(input$run, {
      vals$long_code_out <- long_code()
      showModal(modalDialog("calculation finished!"))
    })
  }
)