R Shiny: Observe работает только один раз

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

Вот мой текущий код

global.R

db <<- dbConnect(SQLite(), dbname = "ahp_data.db")
isConnected <<- 0

#Imagine here that df will contain the model names
df <- data.frame(option1 =c("No model selected),
                 option2 =c("model_1","model_2")
     )

reactValues <<- reactiveValues()
isConnectVar <- NULL

ui.R

library(shinydashboard)

dashboardPage( 
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(

#Authentification Panel
sidebarLayout(
  sidebarPanel(
        titlePanel("Authentification"),
        textInput('username', label="User name"),
        passwordInput('password', label= "password"),
        actionButton("connectButton", label='Connect'),
        actionButton("subscribeButton",label='Subscribe'),
        actionButton("logoutButton", label="Log out")
   ),
  sidebarPanel(
        #Input to update when logged in
        selectInput("selectModelInput", label="Model   selection",choices=list("No model selected")),
        actionButton("newModelButton",label="New model"),
        actionButton("renameModelButton", label="Rename model"),
        actionButton("duplicateModelButton",label="Duplicate model"),
        actionButton("loadModelButton", label='Load model'),
        actionButton("deleteModelButton", label='Delete model')
  )
 )

server.R

connect <- function(userName,pwd){
  isConnected <<- 0;
  qry = paste0("SELECT password from USER where pseudo = \'",userName,"\'")
  res= dbGetQuery(db,qry )
  res = paste0(res)
  if(res==pwd)
  {
    isConnected <<- 1;
    print("CONNECTED")

  }
  else{
    print("unable to connect to the database")
  }

function(input, output, session) {
  isConnectedVar <- reactive({
    isConnected+1
  })

  #Authentification Panel dynamic UI
  observe({
    if(isConnected== 0){
     reactValues$selector <<- updateSelectInput(session,"selectModelInput", label="Model selection", choices = as.character(df[[paste0(option,isConnectedVar())]]))
    }
    else{
      reactValues$selector <<- updateSelectInput(session,"selectModelInput",  label="Model selection", choices = as.character(df[[paste0(option,isConnectedVar())]]))
    }
  })

 observeEvent(input$connectButton, {
    userName= paste0(input$username)
    userPwd = paste0(input$password)
    connect(user = userName,pwd = userPwd)
  })

Я пробовал несколько руководств в Интернете, используя реактивный, наблюдающий и т. Д., Но я не могу понять, что не так с моим кодом, не могли бы вы мне помочь, ребята.

Заранее спасибо Alexi


r dynamic reactive-programming observers shiny
person Alexi Coard    schedule 17.03.2016    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Вы хотите, чтобы ваш код реагировал на значение isConnected. Я предлагаю вам сделать эту переменную локальной, а не глобальной, где есть возможность пометить ее как реактивное значение с помощью makeReactiveBinding

Вот мое предложение (в однофайловом приложении):

library(shiny)
library(shinydashboard)

df <- data.frame(option1 =c("No model selected"),
                 option2 =c("model_1","model_2")
)

runApp(
  shinyApp(
    ui = shinyUI(
      dashboardPage(
        dashboardHeader(),
        dashboardSidebar(),
        dashboardBody(

        #Authentification Panel
        sidebarLayout(
          sidebarPanel(
            titlePanel("Authentification"),
            textInput('username', label="User name"),
            passwordInput('password', label= "password"),
            actionButton("connectButton", label='Connect'),
            actionButton("subscribeButton",label='Subscribe'),
            actionButton("logoutButton", label="Log out")
          ),
          sidebarPanel(
            #Input to update when logged in
            selectInput("selectModelInput", label="Model   selection",choices=list("No model selected")),
            actionButton("newModelButton",label="New model"),
            actionButton("renameModelButton", label="Rename model"),
            actionButton("duplicateModelButton",label="Duplicate model"),
            actionButton("loadModelButton", label='Load model'),
            actionButton("deleteModelButton", label='Delete model')
          )
        )
      )
      )
    ),

    server = function(input, output, session) {

      # function inside such that it has the scope of the server
      connect <- function(userName,pwd){
        isConnected <<- 0;
        qry = paste0("SELECT password from USER where pseudo = \'",userName,"\'")
        res= "12345"
        res = paste0(res)
        if(res==pwd)
        {
          isConnected <<- 1;
          print("CONNECTED")

        }
        else{
          print("unable to connect to the database")
        }
      }

      # set this as per-instance variable and make it reactive
      isConnected <- 0
      makeReactiveBinding("isConnected")

      # now this fires whenever isConnected changes
      isConnectedVar <- reactive({
        isConnected+1
      })

      #Authentification Panel dynamic UI
      observe({
        if(isConnected== 0){
          updateSelectInput(session,"selectModelInput", label="Model selection", choices = as.character(df[[paste0("option",isConnectedVar())]]))
        }
        else{
          updateSelectInput(session,"selectModelInput",  label="Model selection", choices = as.character(df[[paste0("option",isConnectedVar())]]))
        }
      })

      observeEvent(input$connectButton, {
        userName= paste0(input$username)
        userPwd = paste0(input$password)
        connect(user = userName,pwd = userPwd)
      })
    }
  )
)

Примечание. Я отредактировал вызов df, поскольку он был неправильным в вашем примере кода.

person K. Rohde    schedule 17.03.2016
comment
Оно работает ! Большое спасибо, мистер Роде :) Я думаю, проблема возникла из-за того, что я объявил функцию подключения вне функционального сервера (ввод, вывод, сеанс) - person Alexi Coard; 17.03.2016