agregando sweetalert, cicerone, creditos y contextbuttons

R/data/movid_data.R

@@ -176,6 +176,23 @@ mv <- mv %>%
   )
 
 
+# -------------------------------------------------------------------------
+# mv <- mv %>%
+#   select(
+#     -contains("TEXT"),
+#     -starts_with("sa3"),
+#     -starts_with("sa2"),
+#     -starts_with("c7"),
+#     -starts_with("c6"),
+#     -starts_with("pr"),
+#     -edad_65,
+#     -RM,
+#     -comuna,
+#     -semana,
+#     -semana0,
+#     -region
+#     )
+
 
 # exportar ----------------------------------------------------------------
 saveRDS(mv, "data/movid.rds")

global.R

@@ -1,3 +1,4 @@
+# setup -------------------------------------------------------------------
 message("global.R")
 
 suppressPackageStartupMessages({
@@ -12,6 +13,8 @@ suppressPackageStartupMessages({
   library(highcharter)
   library(shinyWidgets)
   library(ggsci)
+  library(shinyWidgets)
+  library(cicerone)
 
 })
 
@@ -71,7 +74,7 @@ OPTS_RAZONES <- c(
 )
 
 
-# PRACTICAS ---------------------------------------------------------------
+# practicas ---------------------------------------------------------------
 PRACTICAS_DF <- tibble(
   tipo = c("p1_pra_trabajo", "p1_pra_tramite", "p1_pra_recrea", "p1_pra_visita", 
     "p1_pra_invitado", "p1_pra_transporte"),
@@ -83,17 +86,30 @@ PRACTICAS_DF <- tibble(
 
 
 # highcharter -------------------------------------------------------------
-newlang_opts <- getOption("highcharter.lang")
-newlang_opts$weekdays <- c("domingo", "lunes", "martes", "miércoles", "jueves", "viernes", "sábado")
-newlang_opts$months <- c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", 
+hc_lang <- getOption("highcharter.lang")
+hc_lang$weekdays <- c("domingo", "lunes", "martes", "miércoles", "jueves", "viernes", "sábado")
+hc_lang$months <- c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", 
                          "agosto", "septiembre", "octubre", "noviembre", "diciembre")
-newlang_opts$shortMonths <- c("ene", "feb", "mar", "abr", "may", "jun", "jul", "ago", "sep", 
+hc_lang$shortMonths <- c("ene", "feb", "mar", "abr", "may", "jun", "jul", "ago", "sep", 
                               "oct", "nov", "dic")
-newlang_opts$thousandsSep <- "."
-newlang_opts$decimalPoint <- ","
+hc_lang$thousandsSep <- "."
+hc_lang$decimalPoint <- ","
+hc_lang$downloadJPEG <- "Descargar imagen"
+hc_lang$downloadXLS <- "Descargar excel"
+hc_lang$viewFullscreen <- "Ver en pantalla completa"
+
+
+hc_chart <- getOption("highcharter.chart")
+hc_chart$exporting <- list(enabled = TRUE)
+hc_chart$credits <- list(
+  enbled = TRUE,
+  href = "https://www.movid19.cl/",
+  text = "MOVID19"
+)
 
 options(
-  highcharter.lang = newlang_opts,
+  highcharter.chart = hc_chart,
+  highcharter.lang  = hc_lang,
   highcharter.google_fonts = TRUE,
   highcharter.theme = 
     hc_theme_smpl(
@@ -133,6 +149,53 @@ options(
         itemStyle =  list(
           fontWeight = "normal"
         )
+      ),
+      exporting = list(
+        buttons = list(
+          contextButton = list(
+            symbol = "url(https://icon-library.com/images/3-dots-icon/3-dots-icon-28.jpg)",
+            symbolSize = 18,
+            symbolX = 21,
+            symbolY = 20,
+            titleKey = "Descargar",
+            y = -05,
+            menuItems = c("downloadJPEG", "downloadXLS", "viewFullscreen")
+            )
+          )
+        )
       )
-    )
-)
+  )
+
+
+# tour --------------------------------------------------------------------
+guide <- Cicerone$
+  new(
+    next_btn_text = "Siguiente",
+    stage_background = "#F5F5F5",
+    prev_btn_text = "Anterior",
+    done_btn_text = "¡Listo!",
+    close_btn_text = "Cerrar"
+  )$ 
+  step(
+    el = "sidebarItemExpanded",
+    title = "Secciones del dashboard",
+    description = "Cada sección esta asociada a ciertos estudios relevantes
+    de la encuesta MOVID19",
+    position = "right-center"
+  )$
+  step(
+    "shiny-tab-inicio",
+    "Sección",
+    "Cadad sección posee visualizaciones las cuales puedes controlar con 
+    selectores que aparecen en la misma sección.",
+    position = "mid-center"
+  )$
+  step(
+    "inc_respuestas",
+    "Gráficos",
+    "Cada uno de los gráficos es interactivo, y en cada uno de ellos puedes
+    descargar tanto la visualización como imagen o los datos como excel haciendo click 
+    en el ícono superior derecho.",
+    position = "mid-center"
+  )
+

server.R

@@ -6,6 +6,33 @@ input <- list(
 
 shinyServer(function(input, output, session) {
 
+  ask_confirmation(
+    inputId = "tour",
+    type = "info",
+    # title = "¡Bienvenido a MOVID-app!",
+    text = tags$span(
+      tags$h3("Bienvenido a MOVID-app"),
+      tags$small("Si eres nuevo te invitamos a tomar el tour 
+      para conocer como usar el app")
+    ),
+    btn_labels = c("Cerrar", "A Tomar el tour"),
+    btn_colors = c("", "#093C66"),
+    showCloseButton = TRUE,
+    html = TRUE
+  )
+
+  observeEvent(input$tour, {
+
+    # TRUE
+    if(input$tour) {
+
+      # initialise then start the guide
+      guide$init()$start()
+
+    }
+
+  })
+
 # inicio ------------------------------------------------------------------
 
   cifras <- function() {
@@ -530,7 +557,7 @@ shinyServer(function(input, output, session) {
   output$pcsoc_frec_salida <- renderHighchart({
 
     d <- movid %>% 
-      select(semana_fecha, contains("p1_pra"), -p1_pra_otro_TEXT, -p1_pra_otro) %>% 
+      select(semana_fecha, contains("p1_pra"), -contains("p1_pra_otro_TEXT"), -contains("p1_pra_otro")) %>% 
       gather(tipo, valor, -semana_fecha) %>% 
       group_by(semana_fecha, tipo) %>% 
       summarise(promedio = mean(valor, na.rm = TRUE), .groups = "drop") %>% 
@@ -551,7 +578,7 @@ shinyServer(function(input, output, session) {
   output$pcsoc_prop2 <- renderHighchart({
 
     d <- movid %>% 
-      select(semana_fecha, contains("p1_pra"), -p1_pra_otro_TEXT, -p1_pra_otro) %>% 
+      select(semana_fecha, contains("p1_pra"), -contains("p1_pra_otro_TEXT"), -contains("p1_pra_otro")) %>% 
       gather(tipo, valor, -semana_fecha) %>%
       mutate(valor = valor >= 2) %>% 
       group_by(semana_fecha, tipo) %>% 
@@ -573,7 +600,7 @@ shinyServer(function(input, output, session) {
   output$pcsoc_nosalen <- renderHighchart({
 
     d <- movid %>% 
-      select(semana_fecha, contains("p1_pra"), -p1_pra_otro_TEXT, -p1_pra_otro) %>% 
+      select(semana_fecha, contains("p1_pra"), -contains("p1_pra_otro_TEXT"), -contains("p1_pra_otro")) %>% 
       gather(tipo, valor, -semana_fecha) %>%
       mutate(valor = valor == 0) %>% 
       group_by(semana_fecha, tipo) %>% 
@@ -596,6 +623,23 @@ shinyServer(function(input, output, session) {
 
   output$persgo_alto <- renderHighchart({
 
+    movid$cr1_per_riesgo
+
+    d <- movid %>% 
+      count(semana_fecha, tipo_lbl = cr1_per_riesgo) %>% 
+      filter(!is.na(tipo_lbl)) %>% 
+      group_by(semana_fecha) %>% 
+      mutate(proporcion = round(100 * n/sum(n), 2))
+
+    hchart(
+      d,
+      "line",
+      hcaes(semana_fecha, proporcion, group = tipo_lbl)
+    ) %>%
+      hc_tooltip(table = TRUE, sort = TRUE) %>%
+      hc_xAxis(title = list(text = "")) %>%
+      hc_yAxis(title = list(text = ""), labels = list(format = "{value}%"), min = 0, max = 100)  
+
 
   })
 

ui.R

@@ -1,5 +1,5 @@
 bs4DashPage(
-    enable_preloader = TRUE,
+    enable_preloader = FALSE,
     loading_duration = 1.5,
     loading_background = "white",
     sidebar_collapsed = TRUE,
@@ -42,6 +42,11 @@ bs4DashPage(
                 tabName = "mapas",
                 icon = "map-marked-alt"
             ),
+            bs4SidebarMenuItem(
+                text = "Participantes",
+                tabName = "particpantes",
+                icon = "user-friends"
+            ),
             bs4SidebarMenuItem(
                 text = "Acerca de",
                 tabName = "acerca",
@@ -51,9 +56,13 @@ bs4DashPage(
     ),
 # body --------------------------------------------------------------------
     body = bs4DashBody(
+
+        useSweetAlert(theme = "minimal"),
+        use_cicerone(),
         tags$head(tags$link(rel="shortcut icon", href="fa.png")),
         tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "css/movid19.css")),
         tags$script(src = "js/movid19.js"),
+
         bs4TabItems(
 # inicio ------------------------------------------------------------------
             bs4TabItem(
@@ -224,7 +233,7 @@ bs4DashPage(
                     ),
                     bs4Card(
                         width = 12,
-                        title = "Proporción de personas que consideran el COVID19 un problea de alto riesgo",
+                        title = "Proporción de personas que consideran el COVID19 un problema de alto riesgo",
                         highchartOutput("persgo_alto") 
                     )
                 )

www/css/movid19.css

@@ -1,4 +1,26 @@
 .sidebar-dark-primary .nav-sidebar>.nav-item>.nav-link.active, .sidebar-light-primary .nav-sidebar>.nav-item>.nav-link.active {
     background-color: #093C66;
     color: #fff;
+}
+
+.driver-popover-description,
+.driver-popover-title,
+.driver-close-btn,
+.driver-prev-btn,
+.driver-next-btn {
+  font-family: 'Source Sans Pro' !important;
+  font: none !important;
+}
+
+.driver-close-btn,
+.driver-prev-btn,
+.driver-next-btn {
+  font-size: 13px !important;
+}
+
+.swal2-styled,
+.swal2-confirm,
+.swal2-styled,
+.swal2-cancel {
+  font-size: 1rem !important;
 }