Re-add Quiz to prod app (#35)

* Add back in quiz (#34)
appliedbinf · Apr 27, 2023 · f89cbc1 · f89cbc1
1 parent 7a635e3
commit f89cbc1
Show file tree

Hide file tree

Showing 4 changed files with 52 additions and 63 deletions.
diff --git a/R/app_server.R b/R/app_server.R
@@ -26,9 +26,18 @@ app_server <- function(input, output, session) {
   # Global variables to pass around modules
   r <- reactive
   globals <- list(
+    consent = r(input[["cookies"]][["consent"]]),
+    atitude = r(input[["lat"]]),
+    longitude = r(input[["long"]]),
+    ip = r(input[["ip_data"]]),
+    nav = r(input[["nav-page"]]),
+    setGeo = r(input[["setGeo"]]),
+    geolocation = r(input[["geolocation"]]),
     session = session
   )
 
   mod_usa_risk_map_server("usa_risk_map", globals)
   mod_show_data_server("to_data", globals)
+  mod_risk_quiz_server("quiz", globals)
+  mod_take_quiz_button_server("to_quiz_map", globals)
 }
diff --git a/R/app_ui.R b/R/app_ui.R
@@ -17,6 +17,8 @@ app_ui <- function(request) {
     header = NAVPAGE_HEADER,
     footer = NAVPAGE_FOOTER,
     mod_usa_risk_map_ui("usa_risk_map"),
+    mod_risk_quiz_ui("quiz"),
+
     tutorial_tab(),
     about_tabset(),
     bslib::nav_item(HTML(

diff --git a/R/mod_risk_quiz.R b/R/mod_risk_quiz.R
@@ -347,53 +347,6 @@ mod_risk_quiz_server <- function(id, globals) {
         )
       }
 
-      if (globals$consent() == "yes") {
-        sql <-
-          "INSERT INTO risk_game_results
-        (
-          GEOID, data_ts, pred_20, pred_50,
-          pred_100, pred_1000, g_20, g_50,
-          g_100, g_1000, ip, latitude,
-          longitude, utm_source, utm_medium,
-          utm_content, utm_campaign
-        )
-        VALUES (?geoid, ?data_ts, ?p20,
-                ?p50, ?p100, ?p1000, ?g20,
-                ?g50, ?g100, ?g1000, ?ip,
-                ?lat, ?long, NULLIF(?utm_source, 'NULL'),
-                NULLIF(?utm_medium, 'NULL'),
-                NULLIF(?utm_content, 'NULL'),
-                NULLIF(?utm_campaign, 'NULL')
-        )"
-        latitude <- globals$latitude()
-        longitude <- globals$longitude()
-        query <-
-          DBI::sqlInterpolate(
-            DBI::ANSI(),
-            gsub("\\n\\w+", " ", sql),
-            geoid = pred_risk$GEOID,
-            data_ts = pred_risk$data_ts,
-            p20 = pred_risk$pred_20,
-            p50 = pred_risk$pred_50,
-            p100 = pred_risk$pred_100,
-            p1000 = pred_risk$pred_1000,
-            g20 = pred_risk$g_20,
-            g50 = pred_risk$g_50,
-            g100 = pred_risk$g_100,
-            g1000 = pred_risk$g_1000,
-            ip = globals$ip(),
-            lat = ifelse(is.null(latitude), "Unknown", latitude),
-            long = ifelse(is.null(longitude), "Unknown", longitude),
-            utm_source = globals$ref_content()$utm_source,
-            utm_medium = globals$ref_content()$utm_medium,
-            utm_content = globals$ref_content()$utm_content,
-            utm_campaign = globals$ref_content()$utm_campaign
-          )
-        conn <- pool::poolCheckout(db)
-        DBI::dbSendQuery(conn, query)
-        pool::poolReturn(conn)
-      }
-
       tweet_url <- glue::glue(
         "https://twitter.com/intent/tweet?text={tweet_msg}&url=https://covid19risk.biosci.gatech.edu/?quiz"
       )
@@ -457,21 +410,6 @@ mod_risk_quiz_server <- function(id, globals) {
 
 
     observeEvent(input$game_will, {
-      save_willingness(
-        db = globals$db,
-        source = "game",
-        asc_bias = -1,
-        event_size = -1,
-        answer = input$quiz_followup,
-        ip = globals$ip(),
-        vacc_imm = -1,
-        latitude = globals$latitude(),
-        longitude = globals$longitude(),
-        utm_source = globals$ref_content()$utm_source,
-        utm_medium = globals$ref_content()$utm_medium,
-        utm_content = globals$ref_content()$utm_content,
-        utm_campaign = globals$ref_content()$utm_campaign
-      )
       shinyjs::hide("game_interactive_elem")
       shinyjs::hide("game_will")
     })

diff --git a/R/mod_usa_risk_map.R b/R/mod_usa_risk_map.R
@@ -85,7 +85,47 @@ mod_usa_risk_map_ui <- function(id) {
             "<p>(Note: This map uses a Web Mercator projection that inflates the area of states in northern latitudes. County boundaries are generalized for faster drawing.)</p>"
           )
         )
-      )
+      ),
+      shinypanels::panel(
+         class = "col-sm-12 col-md-2 hidden-sm hidden-xs",
+         body = div(
+           class = "",
+           htmlOutput(ns("risk_context_us")),
+           fluidRow(
+             align = "center",
+             column(
+               12,
+               HTML(
+                 "<h3>Can you guess the risk levels in YOUR community?  Try the Risk Quiz and share your score!</h3>"
+               ),
+             )
+           ),
+           fluidRow(
+             align = "center",
+             column(
+               12,
+               mod_take_quiz_button_ui("to_quiz_map")
+             )
+           ),
+           fluidRow(
+             align = "center",
+             column(
+               12,
+               div(
+                 div(style = "height: 10px;"),
+                 div(
+                   class = "well fake-sidebar",
+                   HTML(
+                     "<p class='intro-text'><a href='https://duke.qualtrics.com/jfe/form/SV_0SZR4fPxyUAg9Ke', rel='noopener' target='_blank'>Fill out this 5-minute survey</a> for a chance to win a $50 Amazon gift card!</p>"
+                   )
+                 )
+               )
+             )
+           )
+         ),
+         title = "Risk context",
+         collapsed = F
+       )
     ))
   )
 }