Если заявление в Shiny на основе значений в реактив - PullRequest
0 голосов
/ 07 сентября 2018

Я создаю часть аутентификации в своем приложении, сравнивая код, отправленный по электронной почте, и код, который отправляют пользователи. Я попытался добавить оператор if с помощью любого из реактивных (), isolate (), renderTable (). Я либо получаю значение должно быть в ошибке реактивной части, либо приложение не отвечает вообще. Ниже, что у меня есть в Server.R , приложение не отвечает вообще без ошибок.

            shinyServer(function(input, output, session) {      
              myData <- reactive({
                req(input$Id)
                #connect to the database, get the data, res
                #send an email with random number, rnd
                list(res,rnd)
              })

              output$tbTable <- renderTable({req(input$Auth)
                  if (input$AuthCode==myData()$rnd) {
                myData()$res
              }
              else{
                as.data.frame(c("Authentication Failed"))
              }
              })
              output$downloadData <- downloadHandler(
                filename = function() {
                  paste(input$Id, " filname.xlsx", sep = "")
                },
                content = function(file) {
                  write.csv(myData(), file, row.names = FALSE)
                }
              )#this part need to depend on the if-statement as well
            }
            )

UI.R

                ui <- shinyUI(fluidPage(title = "aaa",
                titlePanel("aaa"),
                sidebarLayout(
                  sidebarPanel(

                    textInput("Id", "Enter Acct Name below"),
                    submitButton(text="Submit"),
                    tags$hr(),
                    numericInput("AuthCode",label="Authentication",value=""),
                    actionButton("Auth",label="Submit"),
                    tags$hr(),
                    tags$hr(),
                    downloadButton("downloadData", "Download Data")
                  ),
                  mainPanel(
                    tabsetPanel(
                      tabPanel("Data", tableOutput("tbTable"))
                    )) 
                ),
            )
            )

1 Ответ

0 голосов
/ 07 сентября 2018

Я думаю, у меня есть решение сделать то, что вы хотите. Пожалуйста, проверьте. Я сделал следующие изменения

  • Заменили ваш submitButton на actionButton на Acc и используйте observeEvent для его вызова.

  • Аутентификация теперь также запускается observeEvent при нажатии второй кнопки

  • Расширение Excel не будет работать в write.csv, поэтому изменило расширение.

server.R

shinyServer(function(input, output, session) {      


# the first button will trigger this  


  observeEvent(input$Acc,{
  #  myData <- reactive({
      req(input$Id)
      #connect to the database, get the data, res
      #send an email with random number, rnd
      #list(res,rnd)
     myData <<- list(res = 123,rnd = 345) #passing test value and storing it as global variable for accessing in other functions
   # })

    cat("mydata done")

  })


  # the second button will trigger this
  observeEvent(input$Auth,{

    output$tbTable <- renderTable({
      #req(input$Auth)
      if (input$AuthCode==myData$rnd) {
        myData$res
      }
      else{
        #as.data.frame(c("Authentication Failed"))
        shiny::showModal(modalDialog(
          title = "Important message",
          "Authentication Failed!"
        ))
      }
    })
  })


  output$downloadData <- downloadHandler(
    filename = function() {
      paste(input$Id, " filname.csv", sep = "") #renamed it to csv because write.csv writes to csv not excel
    },
    content = function(file) {
      write.csv(myData, file, row.names = FALSE)
    }
  )#this part need to depend on the if-statement as well
}
)

ui.R

ui <- shinyUI(fluidPage(title = "aaa",
                        titlePanel("aaa"),
                        sidebarLayout(
                          sidebarPanel(

                            textInput("Id", "Enter Acct Name below"),
                            actionButton("Acc",label="Click to send code"),
                            tags$hr(),
                            numericInput("AuthCode",label="Authentication",value=000),
                            actionButton("Auth",label="Submit"),
                            tags$hr(),
                            tags$hr(),
                            downloadButton("downloadData", "Download Data")
                          ),
                          mainPanel(
                            tabsetPanel(
                              tabPanel("Data", tableOutput("tbTable"))
                            )) 
                        )
)
)
...