This is the log form shiny:
2022-02-23T04:02:51.206794+00:00 shinyapps[5712896]: shiny version: 1.7.1
2022-02-23T04:02:51.206801+00:00 shinyapps[5712896]: httpuv version: 1.6.5
2022-02-23T04:02:51.206830+00:00 shinyapps[5712896]: rmarkdown version: (none)
2022-02-23T04:02:51.206838+00:00 shinyapps[5712896]: knitr version: (none)
2022-02-23T04:02:51.206842+00:00 shinyapps[5712896]: jsonlite version: 1.7.3
2022-02-23T04:02:51.206864+00:00 shinyapps[5712896]: RJSONIO version: (none)
2022-02-23T04:02:51.206871+00:00 shinyapps[5712896]: htmltools version: 0.5.2
2022-02-23T04:02:51.207131+00:00 shinyapps[5712896]: Using pandoc: /opt/connect/ext/pandoc/2.11
2022-02-23T04:02:51.529870+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.523962+00:00 shinyapps[5712896]: Using jsonlite for JSON processing
2022-02-23T04:02:51.529871+00:00 shinyapps[5712896]: Starting R with process ID: '45'
2022-02-23T04:02:51.530315+00:00 shinyapps[5712896]: Shiny application starting ...
2022-02-23T04:02:51.551855+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.551857+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.551856+00:00 shinyapps[5712896]: Attaching package: ‘rsconnect’
2022-02-23T04:02:51.552424+00:00 shinyapps[5712896]: The following object is masked from ‘package:shiny’:
2022-02-23T04:02:51.552425+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.552425+00:00 shinyapps[5712896]: serverInfo
2022-02-23T04:02:51.589524+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.552425+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.589526+00:00 shinyapps[5712896]: Attaching package: ‘shinyjs’
2022-02-23T04:02:51.589526+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.589766+00:00 shinyapps[5712896]: The following object is masked from ‘package:shiny’:
2022-02-23T04:02:51.589766+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.589767+00:00 shinyapps[5712896]: runExample
2022-02-23T04:02:51.589767+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.589981+00:00 shinyapps[5712896]: The following objects are masked from ‘package:methods’:
2022-02-23T04:02:51.589982+00:00 shinyapps[5712896]:
2022-02-23T04:02:51.589983+00:00 shinyapps[5712896]: removeClass, show
2022-02-23T04:02:51.589983+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189094+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189091+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189093+00:00 shinyapps[5712896]: Attaching package: ‘dplyr’
2022-02-23T04:02:52.189344+00:00 shinyapps[5712896]: The following objects are masked from ‘package:data.table’:
2022-02-23T04:02:52.189345+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189346+00:00 shinyapps[5712896]: between, first, last
2022-02-23T04:02:52.189346+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189549+00:00 shinyapps[5712896]: The following objects are masked from ‘package:stats’:
2022-02-23T04:02:52.189550+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189550+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189755+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.189755+00:00 shinyapps[5712896]: intersect, setdiff, setequal, union
2022-02-23T04:02:52.189550+00:00 shinyapps[5712896]: filter, lag
2022-02-23T04:02:52.189755+00:00 shinyapps[5712896]: The following objects are masked from ‘package:base’:
2022-02-23T04:02:52.189756+00:00 shinyapps[5712896]:
2022-02-23T04:02:52.586211+00:00 shinyapps[5712896]: Error in value[[3L]](cond) :
2022-02-23T04:02:52.586213+00:00 shinyapps[5712896]: Input type 'date' from the supplied data frame of questions is not recognized by {shinysurveys}.
2022-02-23T04:02:52.586214+00:00 shinyapps[5712896]: Did you mean to register a custom input extension with `extendInputType()`?
2022-02-23T04:02:52.586215+00:00 shinyapps[5712896]: Calls: local ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
2022-02-23T04:02:52.586233+00:00 shinyapps[5712896]: Execution halted
2022-02-23T04:02:52.586250+00:00 shinyapps[5712896]: Shiny application exiting ...
this is the code from app
#install.packages("rsconnect")
library(rsconnect)
library(shiny)
library(shinysurveys)
#install.packages("Shinyjs")
library(shinyjs)
library(DBI)
#install.packages("pool")
library(pool)
#install.packages("data.table")
library(data.table)
library(dplyr)
library(tidyr)
#install.packages("shinymanager")
library(shinymanager)
#install.packages("keyring")
library(keyring)
#install.packages("RPostgreSQL")
library(shiny)
library(shinymanager)
library(DBI)
#install.packages("glue")
library(glue)
rsconnect::deployApp("C:\Users\c_jim\OneDrive\Documents\R_project\Survey\survey_1")
if (interactive()) {
# Register a date input to {shinysurveys},
# limiting possible dates to a twenty-day period.
shinysurveys::listInputExtensions()
extendInputType("slider", {
shiny::sliderInput(
inputId = surveyID(),
label = surveyLabel(),
min = 0,
max = 100,
value = 0
)
})
extendInputType("slider1", {
shiny::sliderInput(
inputId = surveyID(),
label = surveyLabel(),
min = 0,
max = 100,
value = 100
)
})
# Register a slider input to {shinysurveys}
# with a custom minimum and maximum value.
extendInputType("date", {
shiny::dateInput(
inputId = surveyID(),
value = Sys.Date(),
label = surveyLabel(),
min = Sys.Date(),
max = Sys.Date()
)
})
listInputExtensions()
}
date <- data.frame(question = "Date of survey",
option = NA,
input_type = "date",
input_id = "date",
dependence = NA,
dependence_value = NA,
required = FALSE)
sleep <- data.frame(question = "Rate the quality of your sleep (0 - Little to no sleep at all. 100 - Great,
no problem falling or staying asleep)",
option = NA,
input_type = "slider",
input_id = "sleep_quality",
dependence = NA,
dependence_value = NA,
required = TRUE)
sleep_hours <- data.frame(question = "How many hours did you sleep?",
option = "# of hours",
input_type = "numeric",
input_id = "sleep_hours",
dependence = NA,
dependence_value = NA,
required = TRUE)
recovery <- data.frame(question = "How physically strong and recovered does your body feel? (0 - Not recovered at all.
100 - fully recovered)",
option = NA,
input_type = "slider",
input_id = "recovery",
dependence = NA,
dependence_value = NA,
required = TRUE)
mood <- data.frame(question = "How is your mood? (0 - Low, Down. 100- Awesome, Happy)",
option = NA,
input_type = "slider",
input_id = "mood",
dependence = NA,
dependence_value = NA,
required = TRUE)
alertness <- data.frame(question = "How is your energy (0 - No energy. 100 - Energized)?",
option = NA,
input_type = "slider",
input_id = "alertness",
dependence = NA,
dependence_value = NA,
required = TRUE)
soreness <- data.frame(question = "Do you have any muscle or joint soreness, stiffness, or tightness?",
option = c("Yes", "No"),
input_type = "y/n",
input_id = "soreness",
dependence = NA,
dependence_value = NA,
required = TRUE)
body_part <- data.frame(question = "What body part?",
option = c("Left foot","Left shin", "Left ankle","Left knee", "Left thigh", "Left groin",
"Right foot","Right shin", "Righ ankle", "Right knee", "Right thigh", "Right groin",
"Spine", "Abdomen", "Left chest", "Right chest", "Left shoulder", "Right shoulder",
"Neck", "Head", "Face"),
input_type = "select",
input_id = "body_part",
dependence = "soreness",
dependence_value = "Yes",
required = TRUE)
academy <- data.frame(question = "How academically stressed are you? (0 - No stress. 100 - Very stressed)",
option = NA,
input_type = "slider1",
input_id = "academy",
dependence = NA,
dependence_value = NA,
required = TRUE)
other <- data.frame(question = "Is there anything else you want to share with us?",
option = "Thank you",
input_type = "text",
input_id = "other",
dependence = NA,
dependence_value = NA,
required = FALSE)
css <- HTML(".btn-primary {
color: #fffff;
background-color: #00205C;
border-color: #C10230;
font-family: 'Open Sans';
}
.panel-primary {
border-color: #C10230;
background-color: #00205C;
color: white;
font-family: 'Open Sans';
font-size: 10pt;
}
")
set_labels(
language = "en",
"Please authenticate" = ""
)
# Combine both custom input types:
my_custom_check_creds <- function(dbname, host, port, db_user, db_password) {
# finally one function of user and password
function(user, password) {
db_pool <- DBI::dbConnect (odbc::odbc(),
Driver = "SQL Server",
Server = "########",
Database = "#####",
UID ="#####",
PWD = "###########",
Port = 1433)
on.exit(dbDisconnect(db_pool))
req <- glue_sql("SELECT * FROM credentials WHERE \"user\" = ({user}) AND \"password\" = ({password})",
user = user, password = password, .con = db_pool
)
req <- dbSendQuery(db_pool, req)
res <- dbFetch(req)
if (nrow(res) > 0) {
list(result = TRUE, user_info = list(user = user, something = 123))
} else {
list(result = FALSE)
}
}
}
ui <- fluidPage(
useShinyjs(),
div(
id = "form",
surveyOutput(df = rbind(date,sleep, sleep_hours, recovery,mood,alertness,soreness,body_part,academy,other),
survey_title = "Daily wellness questionnaire",
theme = "#00205C")
)
)
ui <- secure_app(ui = ui,
tags_top =
tags$div(
tags$h3("Daily wellness questionaire", style = "align:center"),
tags$head(tags$style(css)),
tags$img(
src = "https://raw.githubusercontent.com/jimenezcj31/uofa/main/arizona-logo.svg", width = 100
)
),
# add information on bottom ?
tags_bottom = tags$div(
tags$p(
"For any question, please contact ",
tags$a(
href = "mailto:##############@gmail.com?Subject=Shiny%20aManager",
target="_top", "administrator"
)
)
)
)
server <- function(input, output, session) {
renderSurvey()
# Upon submission, print a data frame with participant responses
res_auth <- secure_server(
check_credentials = my_custom_check_creds(
dbname = "########",
host = "#######",
port = 1433,
db_user = "######",
db_password = "############"
)
)
auth_output <- reactive({
reactiveValuesToList(res_auth)
})
# access info
observe({
print(auth_output())
})
observeEvent(input$submit, {
db_pool <- DBI::dbConnect (odbc::odbc(),
Driver = "SQL Server",
Server = "##########",
Database = "#######",
UID ="#######",
PWD = "###########",
Port = 1433)
response_data <- getSurveyData()
response_data %>%
select(-question_type) %>%
spread(key = question_id, value = response)-> response_data
response_data[] <- lapply(response_data, readr::parse_guess)
dbWriteTable(db_pool, "wellness", response_data, append = TRUE)
}
)
observeEvent(input$submit, {
reset("form")
})
observeEvent(input$submit, {
showModal(modalDialog(
title = "Thank you for filling out the welllness questionnaire",
"Have a great day and Go Cats! The app will auto close."
))
})
observeEvent(input$submit, {
delay(7000, stopApp())
})
}
shinyApp(ui, server)
I think the error has to do with shinysurvey extended input maybe?