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

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

` 

    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
  })
}

r shiny action-button
person Narendra Sahu    schedule 18.03.2018    source источник
comment
Пожалуйста, покажите нам, что вы сделали? Если вы еще не начали, ознакомьтесь с руководствами   -  person Agaz Wani    schedule 18.03.2018

Ответы (1)


arrow_upward
4
arrow_downward

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

длинный_код.R

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

приложение.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!"))
    })
  }
)
person Gregor de Cillia    schedule 18.03.2018