Do random functions such as sample work when I deploy a Shiny App?-CodePudding

I have created a survey in Shiny and I would like that the options in this survey are always different. To do so, I have used the sample function and each time I run the app on my local machine the possible options for the answers are always different as I want. However, I have recently deployed the app through shinyapps.io and it seems that the there is no more randomness in the possible options. This is the code of my shiny app :

# Loading the needed libraries 
library(shiny)
library(shinythemes)
library(googlesheets4)
library(googledrive)
library(shinyalert)


setwd('C:/Users/alber/Desktop/UniTn/Data Science/Third Semester/Laboraotry of Business and Customer analytics/Project_Real')

#gs4_auth(cache = ".secrets") #for the first time 
gs4_auth(cache = ".secrets", email = TRUE, use_oob = TRUE) # when you deploy 
sheet_id <- "1-l3D2dhWjwv1hWXs97db08pJUKZ3DF1DZ4d4yWAVsik"
#sheet_id <- "1MdqGpii3hfoG1OcvlAQjbQ171UOwxCR3Qfc8aIKfZIo"

# Let0s define the demographic variables that will constitute the first part
# of our survey. These infos could be then used for market segmentation


platform_type <- c('Web App', 'Desktop App', 'Mobile App')
deposit_minmax <-  c('min 0€ max 1000€', 'min 10€ max 10000€', 'min 100€ max infinte')
fees_on_purchases <- c('0%', '0.015%', '0.025%')
#https://www.investopedia.com/terms/f/financialinstrument.asp
financial_instruments <-  c('Stocks', 'Crypto', 'ETFs', 'Commodities')
leverage <-  c('YES', 'NO')
social_copy <-  c('YES', 'NO')
n_a <-  5
# Now that we have defined the attributes and their levels we can implement a function 
# that creates random profiles
create_options <-  function(){
  
  list_prod <-  c()
  
  for(i in 1:1000){
    # initialize the product profile
    prod_prof <- c(
      paste('Platform Type:', sample(platform_type,1), '|',
            'Amount of Deposit:', sample(deposit_minmax,1), '|',
            'Fees on buy & sell orders:', sample(fees_on_purchases,1), '|',
            'Financial Instruments:', sample(financial_instruments,1), '|',
            'Leverage:', sample(leverage,1), '|', 
            'Social/Copy Trading', sample(social_copy,1))
    )
    # in order to avoid clones
    if (is.element(prod_prof, list_prod) == FALSE){
      list_prod <- append(prod_prof, list_prod)
    }
  }
  return  (list_prod)
}


################################################################################

# START DEVELOPING THE APP 

# User Interface
ui <- fluidPage( 
  # Theme
  theme = shinytheme("cerulean"),
  # Creating a navigation bar
  navbarPage( h1('Trading App Survey'),
    tabPanel(
    h3('Survey'),
    


    # 1st Question 
    checkboxGroupInput('Choice1', 'Which product do you prefer ? \n(Please pick ONLY ONE)', sample(create_options(),3, replace = F)),
    
  
    #downloadButton('Results', label = 'Conclude the survye'),
    useShinyalert(),
    
    actionButton("submit", "Submit"),
    
    
    
    
  ), 
  tabPanel(h3('Appendix'),
          
           h2('Glossary'),
           
          
            )) )
  




# Define server function  
server <- function(input, output) {
  
  
  observeEvent(input$submit, {
    
   
    
    results_s <- data.frame(input$Choice1, )
    
    sheet_append(data = results_s, ss = sheet_id, sheet = 'Survey_Answers')
    
    shinyalert("Thank you!", "Your answers have been collected. You can close the survey", type = "success")
  })
 
}

# Create Shiny object
shinyApp(ui = ui, server = server)

How can I make it works also when I deploy the app ? Thank you in advance !

CodePudding user response：

This can be fixed by moving the random calculation inside the server function, otherwise, if you execute a random function outside the server, it will work, but it will be the same for all the users. This behaviour is to prevent large calculations from happening unnecessary times if for example, all users will have access to the same data.

Below is the code for the app i deployed in shinyapps.io. Because i need to execute create_options() inside the server, i will use renderUI(). If I use sample() inside any part of the UI it will only be executed once, hence the static options.

Also, i used prettyRadioButtons from shinyWidgets to prevent that users pick more than one option.

code:

library(shiny)
library(tidyverse)
library(shinythemes)
# library(googlesheets4)
# library(googledrive)
library(shinyalert)
library(shinyWidgets)

platform_type <- c("Web App", "Desktop App", "Mobile App")
deposit_minmax <- c("min 0€ max 1000€", "min 10€ max 10000€", "min 100€ max infinte")
fees_on_purchases <- c("0%", "0.015%", "0.025%")
# https://www.investopedia.com/terms/f/financialinstrument.asp
financial_instruments <- c("Stocks", "Crypto", "ETFs", "Commodities")
leverage <- c("YES", "NO")
social_copy <- c("YES", "NO")
n_a <- 5
# Now that we have defined the attributes and their levels we can implement a function
# that creates random profiles
create_options <- function() {
  list_prod <- c()

  for (i in 1:1000) {
    # initialize the product profile
    prod_prof <- c(
      paste(
        "Platform Type:", sample(platform_type, 1), "|",
        "Amount of Deposit:", sample(deposit_minmax, 1), "|",
        "Fees on buy & sell orders:", sample(fees_on_purchases, 1), "|",
        "Financial Instruments:", sample(financial_instruments, 1), "|",
        "Leverage:", sample(leverage, 1), "|",
        "Social/Copy Trading", sample(social_copy, 1)
      )
    )
    # in order to avoid clones
    if (is.element(prod_prof, list_prod) == FALSE) {
      list_prod <- append(prod_prof, list_prod)
    }
  }
  return(list_prod)
}




# APP ---------------------------------------------------------------------


ui <- fluidPage(
  # Theme
  theme = shinytheme("cerulean"),
  # Creating a navigation bar
  navbarPage(
    h1("Trading App Survey"),
    tabPanel(
      h3("Survey"),


      # 1st Question
      uiOutput("random_choices"),


      # downloadButton('Results', label = 'Conclude the survye'),
      useShinyalert(),
      actionButton("submit", "Submit"),
    )
  ),
  tabPanel(
    h3("Appendix"),
    h2("Glossary"),
  )
)


server <- function(input, output, session) {
  output$random_choices <- renderUI(prettyRadioButtons("Choice1",
    "Which product do you prefer ? \n(Please pick ONLY ONE)",
    sample(create_options(), 3, replace = F),
    icon = icon("check")
  ))

  rv <- reactiveValues(df = data.frame(question = NA, answer = NA))


  observeEvent(input$submit, {
    rv$df <- add_row(rv$df, question = "Choice1", answer = input$Choice1)

    # sheet_append(data = results_s, ss = sheet_id, sheet = 'Survey_Answers')

    shinyalert("Thank you!", "Your answers have been collected. You can close the survey", type = "success")
  })
}

# Create Shiny object
shinyApp(ui = ui, server = server)