Search code examples
rdynamicshinyreactive-programmingobservers

R Shiny : Observe only works once


I am developing a R shiny dashboard for a school project but I have a problem with the reactive values and observers. I want to update the UI (and more precisely a selectInput) when the user succesfully logged in.

Here is my current code

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

I've tried several tutorials on the Internet, using reactive, observe etc but i can't figure out what's wrong with my code, could you help me guys.

Thanks in advance Alexi


Solution

  • Your want your code to react to the value of isConnected. I suggest you let this variable be local - not global - where there is the possibility to mark it as reactive value via makeReactiveBinding

    Here is my suggestion (in a one-file app):

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

    Note: I edited the call to df since it was not correct in your code sample.