我在 Shiny 中創建了一個調查,我希望這個調查中的選項總是不同的。為此,我使用了該sample功能,每次我在本地機器上運行該應用程式時,答案的可能選項總是隨我所愿而不同。但是,我最近通過 Shinyapps.io 部署了該應用程式,似乎在可能的選項中沒有更多的隨機性。這是我閃亮的應用程式的代碼:
# 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)
當我部署應用程式時,如何讓它也能正常作業?先感謝您 !
uj5u.com熱心網友回復:
這可以通過在函式內部移動隨機計算來解決server,否則,如果您在 外部執行隨機函式server,它會起作用,但對所有用戶都是一樣的。此行為是為了防止發生不必要的大型計算,例如,如果所有用戶都可以訪問相同的資料。
下面是我在shinyapps.io. 因為我需要執行create_options()里面的server,我會用renderUI()。如果我sample()在 UI 的任何部分使用它只會執行一次,因此靜態選項。
另外,我用prettyRadioButtons從shinyWidgets防止用戶隨到隨多個選項。
代碼:
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)

轉載請註明出處,本文鏈接:https://www.uj5u.com/net/373017.html
