Dear all,
My problem is similar to this topic that was posted a while ago but following the advice given in that topic did not solve my issue. I have written a webpage for a class project and I intend to share this with other students (hence the long comments along codes). I can run this app locally without any problems but I run into error when deploying on shinyapps.io.
Here is my R code:
library(shiny)
library(dplyr)
library(tidyr)
# getwd()
# setwd("C:/Users/Mary/Desktop/university related/English Communication TA")
class_data_raw <- read.csv("English Communication Class Survey Complete.csv")
data_long <- pivot_longer(class_data_raw,
cols = c(Rated_1, Rated_2, Rated_3, Rated_4,
Score_1, Score_2, Score_3, Score_4,
Comment_1, Comment_2, Comment_3, Comment_4),
names_to = c(".value", "id"),
names_pattern = "(.*)_(\\d)")
#above I imported my wide data, then I made it into a long data where the columns specified in cols are all put under one column that comes in the ".value". But then I have too many columns so I will only select what I need.
data <- data_long %>%
select(Week, Rater, Self_score, Rated, Score, Comment)
#Shiny needs UI
ui <- fluidPage(
titlePanel("Student Performance Report"),
sidebarLayout(
sidebarPanel(
textInput("student_name", "Enter your codename exactly as you typed it in the Google form (sensitive to uppercase/lowercase) or if you didn't choose a codename, enter your student number.", value = ""),
actionButton("submit", "Show Results")
),
mainPanel(
h2("Summary"),
textOutput("summary_desc"),
# textOutput("mean_other_rating"),
# textOutput("mean_self_rating"),
# textOutput("mean_contribution"),
conditionalPanel(
condition = "input.submit > 0", # Checks if student_name is not empty
tags$h5(
tags$span(style = "color: #DAA520;", tags$strong("Mean Class Score"))
),
textOutput("class_mean"),
tags$hr(),
tags$h5(
tags$span(style = "color: #FF6347;", tags$strong("Mean Score Given by Others"))
),
textOutput("mean_other_rating"),
tags$hr(),
tags$h5(
tags$span(style = "color: #4682B4;", tags$strong("Mean Self-Rated Score"))
),
textOutput("mean_self_rating"),
tags$hr(),
tags$h5(
tags$span(style = "color: #32CD32;", tags$strong("Mean Contribution Score"))
),
textOutput("mean_contribution"),
tags$hr()
),
h2("Plots"),
textOutput("plot_desc"),
# Plot 1 Section
fluidRow(
column(9,
plotOutput("self_rating_plot")),
column(3,
textOutput("plot_1")),
tags$hr()
),
# Plot 2 Section
fluidRow(
column(9,
plotOutput("presentation_plot")),
column(3,
textOutput("plot_2")),
tags$hr()
),
# Plot 3 Section
fluidRow(
column(9,
plotOutput("self_vs_other_plot")),
column(3,
textOutput("plot_3")),
tags$hr()
),
h2("Comments"),
textOutput("comments_desc"),
verbatimTextOutput("comments")
)
)
)
#fluidpage created a fluid webpage that adjusts size as it sees fit. Sizebarlayout creates a sidebar and main panel. note that we only need sidebar and main panel for this project and depending on project we might not need it. note that here we just define the variables to show and we create the formula for the variables in the server part. the fluid row separates plots into three separate parts for aesthetics
server <- function(input, output) {
#this data is based on student name. EvenReactive means this will happen after clicking submit and req ensures that this doesn't happen unless student name is entered
rated_data <- eventReactive(input$submit, {
req(input$student_name)
subset(data, Rated == input$student_name)
})
rater_data <- eventReactive(input$submit, {
req(input$student_name)
subset(data, Rater == input$student_name)
})
self_score_data <- eventReactive(input$submit, {
req(input$student_name)
subset(data[data$Rater == input$student_name & data$Rated == data$Rater, ])
})
#Summary text outputs. Rendertext literally renders a textual output. we defined class_mean and other variables above
output$summary_desc <- renderText({
paste("In this section, you will see some numerical scores that give you a general idea about your performance.")
})
output$class_mean <- renderText({
paste("The class mean score shows what the students think about all of the teachers in general. A higher score means that students have generally enjoyed the presentations so far. Class mean score:", round(mean(data$Score), 2))
})
output$mean_other_rating <- renderText({
rated_data <- rated_data()
paste(" Your mean score given by others shows what other students think about your performance. A higher score means that most students think you did quite well. Your mean score given by others:",
round(mean(rated_data$Score), 2))
})
output$mean_self_rating <- renderText({
self_score_data <- self_score_data()
paste("Your mean self-rated score for your performance shows how much you rated your own performance when giving a lecture. A higher score means you were satisfied with your own work, but a lower score means you didn't like your own lecture very much. The last plot may help you compare your ratings to other students' ratings. If you don't see anything here, it means that you didn't rate yourself. Your mean self-rated score for your performance:",
round(mean(self_score_data$Score), 2))
})
output$mean_contribution <- renderText({
rater_data <- rater_data()
paste("Your mean contribution score shows how much you rated your contribution in general. A higher score means you were more active, and a lower score means you were not very active. Your mean contribution score:",
round(mean(rater_data$Self_score, na.rm = TRUE), 2))
})
#Progressive contribution barplot. the unique command is to keep only one score for week since we have 4 redundant scores + description + reactive value to control the display of text
output$plot_desc <- renderText({
paste("In this section, you will see some plots to help you understand your performance.")
})
output$plot_1 <- renderText({
if (nrow(rated_data()) > 0) {
"This plot shows you how you scored your contribution for each weak. If you didn't submit the form for any week, you won't see a bar associaed with that week. Try to see if your contribution score improved over time, or if you can notice some kind of pattern."
} else {
""
}
})
output$self_rating_plot <- renderPlot({
rater_data <- rater_data()
unique_scores <- unique(rater_data[, c("Week", "Self_score")])
barplot(
unique_scores$Self_score,
names.arg = unique_scores$Week,
main = "Contribution Score for Each Week",
ylab = "Score",
xlab = "Week",
col = "dodgerblue",
ylim = c(0, 10),
border = "white", #remove borders around bars
las = 1, #make y-axis labels horizontal
cex.names = 0.8, #change x-axis label size
cex.axis = 0.8 #change y-axis tick label size
)
#gridlines for better readability
grid(nx = NA, ny = NULL, col = "gray", lty = "dotted")
})
output$plot_2 <- renderText({
if (nrow(rated_data()) > 0) {
"This plot shows you your mean score assigned by the other students for both of your lectures. If you haven't had your second lecture yet, you will only see a single bar. Try to see if your second lecture was better than the first or vice versa."
} else {
""
}
})
#week 1 vs week2
output$presentation_plot <- renderPlot({
rated_data <- rated_data()
if (nrow(rated_data) > 0) {
presentation_means <- tapply(rated_data$Score, rated_data$Week, mean)
barplot(
presentation_means,
names.arg = names(presentation_means),
main = "Scores by Week",
ylab = "Mean Rating",
xlab = "Week",
col = "tomato",
ylim = c(0, 10),
border = "white",
las = 1,
cex.names = 0.8,
cex.axis = 0.8
)
#gridlines for esthetics
grid(nx = NA, ny = NULL, col = "gray", lty = "dotted")
}
})
output$plot_3 <- renderText({
if (nrow(rated_data()) > 0) {
"This plot shows the distribution of your score assigned by other students. The right half of the bar shows higher scores, and the left half is lower scores. The red line shows what other students think about yout lecture in general, and the blue line shows what you think about your own lecture. Try to see what kind of difference you can spot between the red and blue line. Note that you won't see this plot unless you gave yourself a score in your lecture week."
} else {
""
}
})
#self vs others ratings hist
output$self_vs_other_plot <- renderPlot({
rated_data <- rated_data()
self_score_data <- self_score_data()
if (nrow(rated_data) > 0 && nrow(self_score_data) > 0) {
#filter out self score
other_ratings <- rated_data[rated_data$Rater != rated_data$Rated, ]
#median other rating and self-rating
median_other_rating <- median(other_ratings$Score)
median_self_rating <- median(self_score_data$Score)
#create the bar plot
hist(other_ratings$Score,
xlab = "Score",
ylab = "Number of Students",
main = "Distribution of Scores",
col = "lightblue1",
breaks = c(0,1,2,3,4,5,6,7,8,9,10),
)
# Add horizontal lines for medians
abline(v = median_other_rating - 0.06, col = "red", lty = 1, lwd = 3)
abline(v = median_self_rating + 0.06, col = "blue", lty = 1, lwd = 3)
legend("topright", legend = c("Median score given by other students", "Median self-score"),
col = c("red", "blue"), lty = 1)
}
})
#Comments section
output$comments_desc <- renderText({
paste("In this section, you will see the comments given by other students about your lectures. You can see what other thought about your lecture and think of ways to improve yourself.")
})
output$comments <- renderText({
rated_data <- rated_data()
if (nrow(rated_data) > 0) {
paste(rated_data$Comment, collapse = "\n")
} else {
"No comments available."
}
})
}
# Run the app
shinyApp(ui = ui, server = server)
rsconnect::showLogs()
And here is the log file for my deployed app. (note that the app is successfully deployed but gives an error when I try to access the webpage. [Error:The application failed to start. exit status 1])
2025-02-06T13:36:58.304603+00:00 shinyapps[13923204]:
2025-02-06T13:36:58.308113+00:00 shinyapps[13923204]: The following objects are masked from ‘package:base’:
2025-02-06T13:36:58.312348+00:00 shinyapps[13923204]:
2025-02-06T13:36:58.315995+00:00 shinyapps[13923204]: intersect, setdiff, setequal, union
2025-02-06T13:36:58.319395+00:00 shinyapps[13923204]:
2025-02-06T13:36:58.323523+00:00 shinyapps[13923204]: ── Preparing for deployment ────────────────────────────────────────────────────
2025-02-06T13:36:58.327124+00:00 shinyapps[13923204]: Error in rsconnect::deployApp() : No accounts registered.
2025-02-06T13:36:58.331042+00:00 shinyapps[13923204]: ℹ Call `rsconnect::setAccountInfo()` to register an account.
2025-02-06T13:36:58.334634+00:00 shinyapps[13923204]: Calls: local ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
2025-02-06T13:36:58.338318+00:00 shinyapps[13923204]: Execution halted
2025-02-06T13:36:58.341859+00:00 shinyapps[13923204]: Shiny application exiting ...
2025-02-06T13:37:01.202163+00:00 shinyapps[13923204]: Running on host: 988c54db93d6
2025-02-06T13:37:01.206424+00:00 shinyapps[13923204]: Running as user: uid=10001(shiny) gid=10001(shiny) groups=10001(shiny)
2025-02-06T13:37:01.210350+00:00 shinyapps[13923204]: Connect version: 2024.05.0
2025-02-06T13:37:01.213904+00:00 shinyapps[13923204]: LANG: C.UTF-8
2025-02-06T13:37:01.217543+00:00 shinyapps[13923204]: Working directory: /srv/connect/apps/engcomm
2025-02-06T13:37:01.221299+00:00 shinyapps[13923204]: Using R 4.4.2
2025-02-06T13:37:01.224769+00:00 shinyapps[13923204]: R.home(): /opt/R/4.4.2/lib/R
2025-02-06T13:37:01.228511+00:00 shinyapps[13923204]: Content will use current R environment
2025-02-06T13:37:01.232142+00:00 shinyapps[13923204]: R_LIBS: (unset)
2025-02-06T13:37:01.235882+00:00 shinyapps[13923204]: .libPaths(): /usr/lib/R, /opt/R/4.4.2/lib/R/library
2025-02-06T13:37:01.239628+00:00 shinyapps[13923204]: shiny version: 1.10.0
2025-02-06T13:37:01.243076+00:00 shinyapps[13923204]: httpuv version: 1.6.15
2025-02-06T13:37:01.246875+00:00 shinyapps[13923204]: rmarkdown version: (none)
2025-02-06T13:37:01.250724+00:00 shinyapps[13923204]: knitr version: (none)
2025-02-06T13:37:01.254286+00:00 shinyapps[13923204]: jsonlite version: 1.8.9
2025-02-06T13:37:01.257830+00:00 shinyapps[13923204]: RJSONIO version: (none)
2025-02-06T13:37:01.261268+00:00 shinyapps[13923204]: htmltools version: 0.5.8.1
2025-02-06T13:37:01.264872+00:00 shinyapps[13923204]: reticulate version: (none)
2025-02-06T13:37:01.268742+00:00 shinyapps[13923204]: Using pandoc: /opt/connect/ext/pandoc/2.16
2025-02-06T13:37:02.208032+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.212415+00:00 shinyapps[13923204]: Starting R with process ID: '48'
2025-02-06T13:37:02.216784+00:00 shinyapps[13923204]: Shiny application starting ...
2025-02-06T13:37:02.220175+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.223753+00:00 shinyapps[13923204]: Attaching package: ‘dplyr’
2025-02-06T13:37:02.227985+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.231626+00:00 shinyapps[13923204]: The following objects are masked from ‘package:stats’:
2025-02-06T13:37:02.235317+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.239496+00:00 shinyapps[13923204]: filter, lag
2025-02-06T13:37:02.243087+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.246721+00:00 shinyapps[13923204]: The following objects are masked from ‘package:base’:
2025-02-06T13:37:02.250659+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.254183+00:00 shinyapps[13923204]: intersect, setdiff, setequal, union
2025-02-06T13:37:02.257741+00:00 shinyapps[13923204]:
2025-02-06T13:37:02.261716+00:00 shinyapps[13923204]: ── Preparing for deployment ────────────────────────────────────────────────────
2025-02-06T13:37:02.265032+00:00 shinyapps[13923204]: Error in rsconnect::deployApp() : No accounts registered.
2025-02-06T13:37:02.268272+00:00 shinyapps[13923204]: ℹ Call `rsconnect::setAccountInfo()` to register an account.
2025-02-06T13:37:02.271789+00:00 shinyapps[13923204]: Calls: local ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
2025-02-06T13:37:02.275346+00:00 shinyapps[13923204]: Execution halted
2025-02-06T13:37:02.278901+00:00 shinyapps[13923204]: Shiny application exiting ...
I would be grateful if you could help because I was able to run this same app a while ago but not anymore.