Add intial results screen

t4c/app.R

@@ -7,6 +7,10 @@ library(shinyjs)
 # ---- APP PARAMETERS ----
 APP_TITLE <- "App Title"
 HELP_TEXT <- "Some guidance text can go here"
+SWIPES_MEAN <- c(
+  "left" = -1L,
+  "right" = 1L
+)
 
 top_male_names <- readRDS(here::here("t4c/data/top_male_names.rds"))
 random_name <- function() sample(top_male_names, 1)
@@ -31,6 +35,33 @@ question_itergen <- function(questions) {
 
 next_question <- question_itergen(questions)
 
+plot_swipe_results <- function(questions, results, SWIPES_MEAN) {
+  n_category <- questions %>% group_by(Category) %>% count()
+
+  qx <- questions %>%
+    left_join(results, by = c(id = "question_id")) %>%
+    mutate(score = -SWIPES_MEAN[swipe]) %>%
+    group_by(Category) %>%
+    summarize(score = mean(score)) %>%
+    left_join(n_category, by = "Category")
+
+  ggplot(qx) +
+    aes(x = Category, y = score, color = score) +
+    geom_point(size = 5) +
+    scale_y_continuous(limits = c(-1, 1), breaks = -1:1, labels = c("Acceptable", "Ambivalent", "Undesirable")) +
+    scale_color_gradient2(low = "#82c878", high = "#eb1455", mid = "#ffcd5a", limits = c(-1, 1)) +
+    coord_flip() +
+    guides(color = FALSE) +
+    labs(x=NULL, y=NULL) +
+    hrbrthemes::theme_ipsum_ps(base_size = 24, axis_title_just = "cc") +
+    facet_wrap(~ Category, ncol = 1, scales = "free_y") +
+    theme(
+      panel.grid.minor.x = element_blank(),
+      panel.grid.major.x = element_blank(),
+      axis.text.y = element_blank()
+    )
+}
+
 phone_container <- function(...) {
   div(
     class = "phone-container",
@@ -81,7 +112,7 @@ ui <- fixedPage(
     ),
     div(
       id = "app-intro",
-      class = "app-main bg-white animated",
+      class = "app-main bg-white animated slideOutRight",
       h1(APP_TITLE, class = "app-title text-white bg-moffitt-blue"),
       p(class = "help-text text-moffitt-grey",
         "Guidance about how to approach the questions goes here."),
@@ -137,11 +168,21 @@ ui <- fixedPage(
       class = "app-story animated fadeOutUp",
       div(class = "close-button", actionLink("app_main_hide_story", NULL, icon("times", class = "fa-lg"))),
       htmlOutput("question_story")
+    ),
+    div(
+      id = "app-results",
+      class = "app-main app-results bg-white animated slideOutRight",
+      h1(APP_TITLE, class = "app-title text-white bg-moffitt-blue"),
+      div(class = "app-results-body",
+          h2("Results", class = "help-text text-moffitt-grey"),
+          plotOutput("results_plot", height = "250px")
+      )
     )
   ),
   hr(),
   actionButton("toggle_splash", "Toggle Splash"),
   actionButton("back", "Back"),
+  actionButton("jump_results", "Jump to Last Results"),
   h4("Answer History"),
   dataTableOutput("results_table")
 )
@@ -162,7 +203,8 @@ server <- function(input, output, session) {
   app_screens <- c(
     "splash-overlay" = 1,
     "app-intro" = 2,
-    "app-main" = 3
+    "app-main" = 3,
+    "app-results" = 10
   )
   get_screen_next <- function(x) names(app_screens)[which(names(app_screens) == x) + 1L]
   get_screen_prev <- function(x) names(app_screens)[which(names(app_screens) == x) - 1L]
@@ -215,6 +257,10 @@ server <- function(input, output, session) {
     actionLink("app_main_show_story",
                paste("Read", app_data$male_name, "story..."))
   })
+  output$results_plot <- renderPlot({
+    req(app_data$complete)
+    plot_swipe_results(questions, app_data$results, SWIPES_MEAN)
+  })
 
 
   observe({
@@ -227,7 +273,9 @@ server <- function(input, output, session) {
   # on main app card swipe
   observeEvent(card_swipe(), {
     if (app_data$complete) {
-      cat("\nNothing to do.")
+      # cat("\nNothing to do.")
+      saveRDS(app_data$results, "results.rds")
+      app_data$screen_next <- "app-results"
       return()
     }
     # save swipe event
@@ -261,6 +309,16 @@ server <- function(input, output, session) {
   observeEvent(input$back, {
     if (!is.null(app_data$screen_prev)) app_data$screen_next <- app_data$screen_prev
   })
+  observeEvent(input$jump_results, {
+    last_results_file <- here::here("t4c", "results.rds")
+    if (!file.exists(last_results_file)) {
+      cat("No results saved yet.")
+      return()
+    }
+    app_data$results <- readRDS(last_results_file)
+    app_data$complete <- TRUE
+    app_data$screen_next <- "app-results"
+  })
 
   observeEvent(card_swipe_test(), {
     shinyjs::hide("test-card-swipe-container", anim = TRUE, animType = "fade", time = 1)
@@ -280,10 +338,14 @@ server <- function(input, output, session) {
     shinyjs::addClass("app-story", "fadeOutUp")
     shinyjs::removeClass("app-story", "fadeInDown")
   })
+  observeEvent(app_data$complete, {
+    if (!app_data$complete) return()
+    app_data$screen_next <- "app-results"
+  })
 
   observeEvent(app_data$screen_next, {
     if (is.null(app_data$screen_next)) return()
-    cat("\n", app_data$screen_active, "to", app_data$screen_next)
+    # cat("\n", app_data$screen_active, "to", app_data$screen_next)
     if (app_screens[app_data$screen_active] < app_screens[app_data$screen_next]) {
       # Move forward: active out left, next in right
       shinyjs::removeClass(app_data$screen_active, "slideInLeft slideInRight")

t4c/t4c.css

@@ -170,3 +170,16 @@ a:hover {
   overflow-y: scroll;
   border: white solid 10px;
 }
+.app-results {
+  position: absolute;
+  top: 0;
+}
+.app-results-body {
+  padding: 25px;
+}
+.app-results h2 {
+  margin: 0;
+  padding: 0;
+  font-size: 2.5em;
+  text-align: left;
+}