Bläddra i källkod

Add intial results screen

master
Garrick Aden-Buie 8 år sedan
förälder
incheckning
75875abd61
2 ändrade filer med 79 tillägg och 4 borttagningar
  1. +66
    -4
      t4c/app.R
  2. +13
    -0
      t4c/t4c.css

+ 66
- 4
t4c/app.R Visa fil

# ---- APP PARAMETERS ---- # ---- APP PARAMETERS ----
APP_TITLE <- "App Title" APP_TITLE <- "App Title"
HELP_TEXT <- "Some guidance text can go here" 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")) top_male_names <- readRDS(here::here("t4c/data/top_male_names.rds"))
random_name <- function() sample(top_male_names, 1) random_name <- function() sample(top_male_names, 1)


next_question <- question_itergen(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(...) { phone_container <- function(...) {
div( div(
class = "phone-container", class = "phone-container",
), ),
div( div(
id = "app-intro", 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"), h1(APP_TITLE, class = "app-title text-white bg-moffitt-blue"),
p(class = "help-text text-moffitt-grey", p(class = "help-text text-moffitt-grey",
"Guidance about how to approach the questions goes here."), "Guidance about how to approach the questions goes here."),
class = "app-story animated fadeOutUp", class = "app-story animated fadeOutUp",
div(class = "close-button", actionLink("app_main_hide_story", NULL, icon("times", class = "fa-lg"))), div(class = "close-button", actionLink("app_main_hide_story", NULL, icon("times", class = "fa-lg"))),
htmlOutput("question_story") 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(), hr(),
actionButton("toggle_splash", "Toggle Splash"), actionButton("toggle_splash", "Toggle Splash"),
actionButton("back", "Back"), actionButton("back", "Back"),
actionButton("jump_results", "Jump to Last Results"),
h4("Answer History"), h4("Answer History"),
dataTableOutput("results_table") dataTableOutput("results_table")
) )
app_screens <- c( app_screens <- c(
"splash-overlay" = 1, "splash-overlay" = 1,
"app-intro" = 2, "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_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] get_screen_prev <- function(x) names(app_screens)[which(names(app_screens) == x) - 1L]
actionLink("app_main_show_story", actionLink("app_main_show_story",
paste("Read", app_data$male_name, "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({ observe({
# on main app card swipe # on main app card swipe
observeEvent(card_swipe(), { observeEvent(card_swipe(), {
if (app_data$complete) { 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() return()
} }
# save swipe event # save swipe event
observeEvent(input$back, { observeEvent(input$back, {
if (!is.null(app_data$screen_prev)) app_data$screen_next <- app_data$screen_prev 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(), { observeEvent(card_swipe_test(), {
shinyjs::hide("test-card-swipe-container", anim = TRUE, animType = "fade", time = 1) shinyjs::hide("test-card-swipe-container", anim = TRUE, animType = "fade", time = 1)
shinyjs::addClass("app-story", "fadeOutUp") shinyjs::addClass("app-story", "fadeOutUp")
shinyjs::removeClass("app-story", "fadeInDown") 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, { observeEvent(app_data$screen_next, {
if (is.null(app_data$screen_next)) return() 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]) { if (app_screens[app_data$screen_active] < app_screens[app_data$screen_next]) {
# Move forward: active out left, next in right # Move forward: active out left, next in right
shinyjs::removeClass(app_data$screen_active, "slideInLeft slideInRight") shinyjs::removeClass(app_data$screen_active, "slideInLeft slideInRight")

+ 13
- 0
t4c/t4c.css Visa fil

overflow-y: scroll; overflow-y: scroll;
border: white solid 10px; 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;
}

Laddar…
Avbryt
Spara