User feedback

Mastering Shiny Book Club

Betsy Cohen & Ariana Bardauil

Objetivos de este encuentro

Recapitular encuentros anteriores

Capítulo 8: User feedback

¿Qué vimos en los encuentros anteriores?

Encuentro 1

Basic APP & Basic UI

Capítulos 1 y 2: Basic APP & Basic UI

Construimos nuestra

primera aplicación

en shiny

Estructura básica


library(shiny)

ui <- fluidPage(
  textInput("name", "¿Cómo te llamás?"),
  textOutput("greeting")
)

server <- function(input, output, session) {
  output$greeting <- renderText({
    paste0("Hola ", input$name, "!")
  })
}

shinyApp(ui, server)
  • ui define la interfaz de usuario.
  • server define la lógica del servidor (cómo responde la app).
  • shinyApp(ui, server) renderiza la app.

Estructura básica


Encuentro 2

Basic reactivity

Basic reactivity

Programación declarativa


Shiny usa programación declarativa

No le indicamos qué hacer sino qué queremos lograr.

Son aplicaciones perezosas: solo actualizan los outputs visibles, y solo cuando es necesario.

Si no está vinculado a una salida visible el código puede no ejecutarse nunca

Encuentro 3

Workflow

Control de flujo & debuggeo

¿Qué puedo usar para saber qué le pasa a mi app ?

print() cat()
# Abre una app interactiva
eventReactive(input$go, {
  browser() 
  input$a + input$b
})
# Al principio del script
reactlog::reactlog_enable()
# Luego de ejecutar la APP y cerrarla:
shiny::reactlogShow()

Encuentro 4

Layout, themes, HTML

Layouts (diseños de página)

Página única

fluidPage(), fixedPage() ,fillPag() (página)

sidebarLayout() , fluidRow() , column() (diseño)

Varias páginas

navbarPage() (página)

tabsetPanel(), tabPanel() , navlistPanel() ,navbarMenu() (diseño)

Aplicación de estilos

HTML

<span style="color:hotpink;">texto de prueba</span>

CSS

.pink-text {
  color: darken($theme-pink, 10%);
  font-weight: bold;
}

texto de prueba

THEME

library(shiny)
library(bslib)

ui <- fluidPage(
  theme = bs_theme(bootswatch = "minty"),
  h2("App con tema Minty"),
  sliderInput("x", "Elegí un número", 1, 100, 50),
  textOutput("valor")
)

server <- function(input, output, session) {
  output$valor <- renderText({
    paste("Número:", input$x)
  })
}

Encuentro 5

HOY HOY HOY HOY HOY

User feedback

El UX no son los padres

Experiencia de usuario

Interactuar de manera visual

Pedagogía refuerzo con estímulo visual

Tipos de feedback

En el capítulo se recorren 5 posibles formas de feedback usando el ayudín de shinyFeedback y waiter.

  • 🛑️ Validación
  • ⚠ Notificación
  • ⌛ Barras de progreso
  • 👌 Diálogos de confirmación
  • 🔙 Botones de deshacer

Validar una entrada

library(shiny)

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  numericInput("n", "n", value = 10),
  textOutput("half")
)

server <- function(input, output, session) {
  half <- reactive({
    even <- input$n %% 2 == 0
    shinyFeedback::feedbackWarning(
      inputId = "n", 
      show = !even,
      text = "Por favor pone un número par")
    input$n / 2    
  })
  
  output$half <- renderText(half())
}

shinyApp(ui, server)
  • Agregamos useShinyFeedback() en el ui.
  • En el usamos alguna de las funciones de retroalimentación feedback(), feedbackWarning(), feedbackDanger()y feedbackSuccess()
  • Todas tienen tres argumentos obligatorios (inputId, show, text) y de manera optativa podemos personalizar con: color y icon

Validar una entrada

library(shiny)

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  numericInput("n", "n", value = 10),
  textOutput("half")
)

server <- function(input, output, session) {
  half <- reactive({
    even <- input$n %% 2 == 0
    shinyFeedback::feedbackWarning("n", !even, "Por favor pone un número par")
    input$n / 2    
  })
  
  output$half <- renderText(half())
}

shinyApp(ui, server)

Pausar la ejecución bajo requisitos

¿Cómo pausamos la ejecución para que no ocurra nada hasta que se cumplan ciertas condiciones en nuestro reactive{}? La función req() nos permite agregar requisitos para la ejecucción dentro del server. Por ej. ponemos como requisito que no muestre el resultado si no es un n° par

library(shiny)

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  numericInput("n", "n", value = 10),
  textOutput("half")
)

server <- function(input, output, session) {
  half <- reactive({
    even <- input$n %% 2 == 0
    shinyFeedback::feedbackWarning(
      inputId = "n", 
      show = !even,
      text = "Por favor pone un número par")
    req(even)
    input$n / 2    
  })
  
  output$half <- renderText(half())
}

shinyApp(ui, server)

Pausar la ejecución bajo requisitos

A veces queremos freezar más de una condición y esperar a que el usuario termine de hacer algo. Por ej. en este caso necesitamos que termine de elegir el idioma (selectInput()) y ponga sunombre (textInput()) para que se ejecute el greetings en el paste0()

ui <- fluidPage(
  selectInput("language", "Language", choices = c("", "English", "Maori")),
  textInput("name", "Name"),
  textOutput("greeting")
)

server <- function(input, output, session) {
  greetings <- c(
    English = "Hello", 
    Spanish = "Hola"
  )
  output$greeting <- renderText({
    req(input$language, input$name)
    paste0(greetings[[input$language]], " ", input$name, "!")
  })
}

req() como condición especial

Se puede usar req() con su propia declaración lógica. Por ejemplo: req(input$a > 0) permitirá que el cálculo continúe cuando sea mayor que 0.

Combinando req() y shinyFeedback

Además, podemos combinar ambas cosas. En este caso, queremos continuar con el cálculo si el usuario ha ingresado un valor, por lo que con req() chequeamos si el nombre existe y en caso de que NO envía un warning avisando.

server <- function(input, output, session) {
  data <- reactive({
    req(input$dataset)
    
    exists <- exists(input$dataset, "package:datasets")
    shinyFeedback::feedbackDanger("dataset", !exists, "Dataset desconocido")
    req(exists, cancelOutput = TRUE)

    get(input$dataset, "package:datasets")
  })
  
  output$data <- renderTable({
    head(data())
  })
}

(*) Ejemplo retomado del capítulo 1

Validar multiples entradas y salidas con validate()

La función integrada de shiny validate() nos va a permitir controlar múltiples entradas y tirar el mensaje.

El siguiente código muestra un ejemplo sencillo donde no queremos registrar ni calcular la raíz cuadrada de valores negativos en x.

ui <- fluidPage(
  numericInput("x", "x", value = 0),
  selectInput("trans", "transformation", 
    choices = c("square", "log", "square-root")
  ),
  textOutput("out")
)

server <- function(input, output, session) {
  output$out <- renderText({
    if (input$x < 0 && input$trans %in% c("log", "square-root")) {
      validate("El valor que elegiste para tu x no admite ser negativo para aplicarle este cálculo")
    }
    
    switch(input$trans,
      square = input$x ^ 2,
      "square-root" = sqrt(input$x),
      log = log(input$x)
    )
  })
}

Cual sería la diferencia entre validate() y req()


Función ¿Qué hace? ¿Dónde se usa? ¿Qué muestra si falla?
req() Verifica que un valor exista o cumpla una condición mínima Cualquier parte del servidor Nada (el output queda en blanco)
validate() Verifica una condición lógica y muestra un mensaje de error personalizado Solo dentro de render*() outputs El mensaje de error que le pongas

Notificaciones

Las notificaciones aparecen apiladas en la parte inferior derecha de la app.

showNotification() tiene los siguientes tipos de notificación:

  • transitoria: desaparece después de un período de tiempo fijo.
  • del proceso: aparece cuando se inicia un proceso y al finalizar desaparece.
  • progresivas: actualiza una sola notificación con actualizaciones progresivas

Notificación transitoria

la forma nás sencilla es showNotification("el mensaje que queres mostrar")

duration permite estipular una duración, la predeterminada es 5 seg.

se puede configurar el argumento type para tunearlo con un css para “message”, “warning” o “error”

library(shiny)

ui <- fluidPage(
  textInput("nombre", "Nombre"),
  actionButton("enviar", "Enviar")
)

server <- function(input, output, session) {
  observeEvent(input$enviar, {
    if (input$nombre == "") {
      showNotification("Por favor ingresá un nombre", type = "error")
    } else {
      showNotification("Formulario enviado correctamente", type = "message")
    }
  })
}

shinyApp(ui, server)

Notificación del proceso

library(shiny)

ui <- fluidPage(
  actionButton("procesar", "Procesar datos")
)

server <- function(input, output, session) {
  observeEvent(input$procesar, {
    # Mostrar notificación persistente mientras se procesa
    id <- showNotification("Procesando datos...", duration = NULL, closeButton = FALSE, type = "message")
    
    # Simular un proceso lento
    Sys.sleep(3)
    
    # Eliminar la notificación al terminar
    removeNotification(id)
    
    # Mostrar notificación de éxito que desaparece sola
    showNotification("¡Datos procesados correctamente!", type = "message")
  })
}

shinyApp(ui, server)

Notificación de actualización progresivas

Para simular una notificación progresiva en lugar de mostrar notis distintas (una debajo de la otra como si fuera un 🥪) podemos jugar con el parámetro id de showNotification() de forma que va a aparecer como si estuviera actualizando el texto de la misma notificación.

👉🏻El parámetro id sirve para ir concatenando esta simulación

ui <- fluidPage(
  actionButton("start", "Iniciar carga de datos"),
  tableOutput("data")
)

server <- function(input, output, session) {
  notify <- function(msg, id = NULL) {
    showNotification(msg, id = id, duration = NULL, closeButton = FALSE)
  }
  
  data <- eventReactive(input$start, { 
    id <- notify("Leyendo datos...")
    on.exit(removeNotification(id), add = TRUE)
    Sys.sleep(1)
    
    notify("Reticulando splines...", id = id)
    Sys.sleep(1)
    
    notify("Agrupando llamas...", id = id)
    Sys.sleep(1)
    
    notify("Ortogonalizando matrices...", id = id)
    Sys.sleep(1)
    
    mtcars  
  })
  
  output$data <- renderTable(head(data()))
}

shinyApp(ui, server)

Barras de progreso

La sensación de paso del tiempo es muy importante desde el punto de vista del UX. Lo que estamos buscando con este tipo de elementos es:

Proveer distracción con imágenes, textos (con un dato curioso por ej.) o sonidos.

Brindar una explicación de por qué estas esperando

Dar certeza respecto de cuánto tiempo llevará.

Barras de progreso

En el libro vemos dos soluciones: una nativa de shiny y otra con el paquete waiter{}

Adicionalmente existe la librería {progress}

Importante

Para ambos casos hay que dividir la tarea principal en un número determinado de partes pequeñas que tomen aproximadamente el mismo tiempo.

Barras de progreso con shiny

Para crear una barra de progreso con Shiny, necesitas usar withProgress() e incProgress()

El primer argumento de incProgress() es la cantidad que se incrementará en la barra de progreso. Por defecto, la barra de progreso empieza en 0 y termina en 1, por lo que el incremento en 1 dividido por el número de pasos garantizará que la barra de progreso esté completa al final del bucle.

ui <- fluidPage(
  numericInput("steps", "How many steps?", 10),
  actionButton("go", "go"),
  textOutput("result")
)

server <- function(input, output, session) {
  data <- eventReactive(input$go, {
    withProgress(message = "Computing random number", {
      for (i in seq_len(input$steps)) {
        Sys.sleep(0.5)
        incProgress(1 / input$steps)
      }
      runif(1)
    })
  })
  
  output$result <- renderText(round(data(), 2))
}

El paquete waiter

El paquete {waiter} tambien nos permite mostrar barras de progreso con waitress y hostess

La acción se define en 4 pasos

  1. Poner useWaiter en cualquier parte de tu UI.

  2. Crear el waiter

  3. Mostrar el waiter

  4. Ocultar el waiter

Spinners con {waiter}

waiter() es ideal para spinners. Permite hacer barras más chulas y editar el html o agregar gifs

👉🏻 Por ej. Acá usamos un spin_flower() para que muestre una 🌻mientras carga el gráfico

library(shiny)
library(waiter)

ui <- fluidPage(
  use_waiter(),  # Necesario para que waiter funcione
  autoWaiter(
    color = "white",
    html = tagList(
      spin_flowers(),
      br(), br(),
      tagAppendAttributes(
        style = "color:black",
        p("Cargando tus gráficos")
      )
    )
  ),
  actionButton("trigger", "Render"),
  plotOutput("plot"),
  plotOutput("plot2")
)

server <- function(input, output) {
  
  observeEvent(input$trigger, {
    
    output$plot <- renderPlot({
      Sys.sleep(3)
      plot(cars)
    })
    
    output$plot2 <- renderPlot({
      Sys.sleep(5)
      plot(runif(100))
    })
    
  })
  
}

shinyApp(ui, server)

Barras con waitress

Por default waiter muestra un spinner (y podemos elegir entre más de 100 modelos!) pero también podemos hacer barras usando la funcion useWaitress()en el UI definiendo el waitress con Waitress$new. Dentro de Waitress$new nos permite setear a que elemento le vamos a aplicar la barra (selector), así como un theme, max y min de la barra.

library(shiny)
library(waiter)

ui <- navbarPage("Waitress aplicado al nav",
                 tabPanel("home",
                          useWaitress(color = "#7F7FFF"),
                          actionButton("go", "Generar gráfico"),
                          plotOutput("plot")
                 )
)

server <- function(input, output, session) {
  
  waitress <- Waitress$new( # Creamos el objeto waitress una sola vez 
    selector = "nav", 
    theme = "overlay-percent", 
    min = 0, 
    max = 10
  )
  
  observeEvent(input$go, {
    
    waitress$start()  # Muestra el loader
    
    output$plot <- renderPlot({
      for (i in 1:10) {
        waitress$inc(1)  # Incrementa 10%
        Sys.sleep(0.5)
      }
      waitress$close()  # Oculta el loader cuando termina
      hist(runif(100))
    })
    
  })
}

shinyApp(ui, server)

Spinners con shinycssloaders

Otra forma muy práctica de hacer spinners es con el paquete {shinycssloaders}. Simplemente agregamos shinycssloaders::withSpinner() para envolver el output que queremos que “spinee” automaticamente y asereje!

library(shinycssloaders)

ui <- fluidPage(
  actionButton("go", "go"),
  withSpinner(plotOutput("plot")),
)
server <- function(input, output, session) {
  data <- eventReactive(input$go, {
    Sys.sleep(3)
    data.frame(x = runif(50), y = runif(50))
  })
  
  output$plot <- renderPlot(plot(data()), res = 96)
}

Dudo luego alt+cntrl+supr: confirmación y arrepentimientos

Pedir la confirmación explicita

Botón deshacer

Papelera de reciclaje

Confirmación explicita

Con la función modalDialog() es como una especie de aduana en la que creamos un nuevo modo de interacción: no se puede interactuar con la app principal hasta que no se haya procesado el diálogo. Lo definimos fuera del server y después lo usamos de manera dinámica como eventos condicionales dentro del mismo

modal_confirm <- modalDialog(
  "Are you sure you want to continue?",
  title = "Deleting files",
  footer = tagList(
    actionButton("cancel", "Cancel"),
    actionButton("ok", "Delete", class = "btn btn-danger")
  )
)


ui <- fluidPage(
  actionButton("delete", "Delete all files?")
)


server <- function(input, output, session) {
  observeEvent(input$delete, {
    ## en vez de desatar el evento borrar corre el dialogo
    showModal(modal_confirm)
  })
  
  observeEvent(input$ok, {
    showNotification("Files deleted")
    removeModal()
  })
  observeEvent(input$cancel, {
    removeModal()
  })
}

shinyApp(ui, server)

Botón de arrepentimiento

A veces confirmar acciones con un “¿estás seguro?” no sirve

Porque los usuarios se acostumbran a clickear

Esta opción permite deshacer luego de ejecutar la acción (como pasa con los mails).

Para eso se puede utilizar observeEvent(), se puede llamar a runLater() esperar X segundos y recién realizar la acción o eliminarla.

Ejemplo de botón de arrepentimiento

ui <- fluidPage(
  textAreaInput("message", 
    label = NULL, 
    placeholder = "What's happening?",
    rows = 3
  ),
  actionButton("tweet", "Tweet")
)

runLater <- function(action, seconds = 3) {
  observeEvent(
    invalidateLater(seconds * 1000), action, 
    ignoreInit = TRUE, 
    once = TRUE, 
    ignoreNULL = FALSE,
    autoDestroy = FALSE
  )
}

server <- function(input, output, session) {
  waiting <- NULL
  last_message <- NULL
  
  observeEvent(input$tweet, {
    notification <- glue::glue("Tweeted '{input$message}'")
    last_message <<- input$message
    updateTextAreaInput(session, "message", value = "")

    showNotification(
      notification,
      action = actionButton("undo", "Undo?"),
      duration = NULL,
      closeButton = FALSE,
      id = "tweeted",
      type = "warning"
    )

    waiting <<- runLater({
      cat("Actually sending tweet...\n")
      removeNotification("tweeted")
    })
  })
  
  observeEvent(input$undo, {
    waiting$destroy()
    showNotification("Tweet retracted", id = "tweeted")
    updateTextAreaInput(session, "message", value = last_message)
  })
}

¡Muchas gracias!