Tips

• Antes de hacer la app con Shiny, dibuja un esquema del resultado final (con todo y títulos).

• Ten paciencia si no sale todo de un jalón. Ir poco a poco es importante.

Interfás de Usuario (ui)

Es la parte con la que el usuario puede interactuar (escrita en código).

Las posibles cosas que quieras que el usuario vea en tu app son:

• Título. Esto se hace con el comando titlePanel("Mi título") dentro de la función fluidPage()

• Input (dónde moverle). Existen muchas opciones que se verán con detalle en Inputs.

• Output (el resultado de lo que le moví). Al igual que lo anterior, veremos que hay muchas posibles salidas según tengamos interés. Estas posibilidades se encuentran en el apartado de Outputs

Servidor (server)

Es lo que se va a manipular de la interacción del usuario con la app (para que se generen los outputs requeridos). Es como “detrás del telón”.

Acomodar la Shiny

Las funciones de Layout cumplen el objetivo de ordentar las entradas o salidas de la app en las diversas posibilidades.

sidebarLayout(
  titlePanel("Nombre de la app"),
  sidebarPanel(p("Lo que está adentro de aquí va a la izquierda")),
  mainPanel(p("lo que esté dentro de este panel irá a la derecha"))
)

Inputs

Outputs

Tema

• shinythemes::themeSelector() dentro de fluidPage (como un parámetro).

• Si uno sabe qué tema quiere para su app, puede añadirlo de manera definitiva como: theme = shinythemes::shinytheme("nombre_del_tema") dentro de la función fluidPage.

  Generalmente este parámetro se pone después del título del panel (titlePanel) y antes de SidebarLayout.

Añadir pestañas

Dentro de la interfás de usuario (fluidPage -> sidebarLayout -> mainPanel)

...
mainPanel(
  
    tabsetPanel(
      tabPanel("Primer panel", plotOutput("id_output_1"))
      tabPanel("Segundo panel", plotOutput("id_output_2"))
    )
  
)
...

Ejemplos

1. Una Shiny más bonita

set.seed(111)

ui <- fluidPage(
  titlePanel("Histogramas de diversas distribuciones"),
  theme = shinythemes::shinytheme("flatly"),
  sidebarLayout(
    sidebarPanel(sliderInput("cortes", "# Cortes", min = 0, max = 100, value = 30),
                 selectInput("n", "Tamaño de la muestra", choices = seq(0, 1000, by = 100) )
                 ),
    mainPanel(
      tabsetPanel(
        tabPanel("Normal", plotly::plotlyOutput("h_normal")),   #Pestaña 1
        tabPanel("Exponencial", plotly::plotlyOutput("h_exp")), #Pestaña 2
        tabPanel("Gamma", plotly::plotlyOutput("h_gam")),       #Pestaña 3
        tabPanel("Poisson", plotly::plotlyOutput("h_pois"))     #Pestaña 4
      )
    )
  )
)

server <- function(input, output, session){
  output$h_normal <- plotly::renderPlotly({
    ggplot(data.frame(rnorm(input$n)), aes(x = rnorm(input$n))) + geom_histogram(bins = input$cortes, fill = "orange") + theme_minimal()
  })
  
  output$h_exp <- plotly::renderPlotly({
    ggplot(data.frame(rexp(input$n, 4)), aes(x = rexp(input$n, 4))) + geom_histogram(bins = input$cortes, fill = "pink") + theme_minimal()
  })
  
  output$h_gam <- plotly::renderPlotly({
    ggplot(data.frame(rgamma(input$n, 3, 4)), aes(x = rgamma(input$n, 3, 4))) + geom_histogram(bins = input$cortes, fill = "green") + theme_minimal()
  })
  
  output$h_pois <- plotly::renderPlotly({
    ggplot(data.frame(rpois(input$n, 2)), aes(x = rpois(input$n, 2))) + geom_histogram(bins = input$cortes, fill = "yellow") + theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

2. Una shiny bonita

#El UI o interfas con el usuario es "La shiny" en el sentido que es lo único que ve y toca el usuario. Por eso aquí es donde debemos hacer que se vea bonito.

ui <- fluidPage( # Lo que esté aquí se verá por el usuario
  titlePanel("Nombres más famosos de la historia"),
  sidebarLayout( # Permite dividir la pantalla en dos lados
    sidebarPanel(# Aquí irán cosas _en la izquierda_
    selectInput('name', 'Select Name',head(unique(babynames$name)), 15)),
    # El Input tipo select es lo que el usuario "elige" dentro de las opc.
    mainPanel(  # Aquí irán las cosas de la derecha 
     tabsetPanel( #Para hacer pestañas dentro del lado derecho
      #Primer pestaña
      tabPanel("Histograma",plotly::plotlyOutput('plot_trendy_names')),
      #Segunda pestaña
      tabPanel("Información",DT::DTOutput('table_trendy_names'))
     )
    )
  )
)

#Digamos que el server es para mover lo que el usuario le pique y dar 
#una salida según la entrada
server <- function(input, output, session){
    #Función auxiliar para manejar más rápido el input
      plot_trends <- function(){
         babynames %>% 
          filter(name == input$name) %>% 
          ggplot(aes(x = year, y = n)) +
          geom_col()
      }
  #Siempre aparecen los outputs$NOMBRE_OUTPUT que vienen 
      #renderizados (con algú tipo de render)
  output$plot_trendy_names <- plotly::renderPlotly({
    plot_trends()
  })
  
  #Este es el otro output
  output$table_trendy_names <- DT::renderDT({
    babynames %>% 
      filter(name == input$name)
  })
}

shinyApp(ui = ui, server = server)

Ejemplos:

server <- function(input, output, session) {
  rval_bmi <- reactive({
    input$weight/(input$height^2)
  })
  
  output$bmi <- renderText({
    paste("Your BMI is", round(rval_bmi(), 1))
  })
  output$bmi_range <- renderText({
      bmi_status <- cut(rval_bmi(), 
      breaks = c(0, 18.5, 24.9, 29.9, 40),
      labels = c('underweight', 'healthy', 'overweight', 'obese')
    )
    paste("You are", bmi_status)
  })
}
ui <- fluidPage(
  titlePanel('BMI Calculator'),
  sidebarLayout(
    sidebarPanel(
      numericInput('height', 'Enter your height in meters', 1.5, 1, 2),
      numericInput('weight', 'Enter your weight in Kilograms', 60, 45, 120)
    ),
    mainPanel(
      textOutput("bmi"),
      textOutput("bmi_range")
    )
  )
)

shinyApp(ui = ui, server = server)

Podemos hacer un reactive con otro reactive:

server <- function(input, output, session) {
  rval_bmi <- reactive({
    input$weight/(input$height^2)
  })
  # CODE BELOW: Add a reactive expression rval_bmi_status to 
  # return health status as underweight etc. based on inputs
  rval_bmi_status <- reactive({cut(rval_bmi(), 
      breaks = c(0, 18.5, 24.9, 29.9, 40),
      labels = c('underweight', 'healthy', 'overweight', 'obese')
    )
  })
    
  output$bmi <- renderText({
    bmi <- rval_bmi()
    paste("Your BMI is", round(bmi, 1), "You are", rval_bmi_status())
  })
  output$bmi_status <- renderText({
    # MODIFY CODE BELOW: Replace right-hand-side with 
    # reactive expression rval_bmi_status
   rval_bmi_status()
  })
}
ui <- fluidPage(
  titlePanel('BMI Calculator'),
  sidebarLayout(
    sidebarPanel(
      numericInput('height', 'Enter your height in meters', 1.5, 1, 2),
      numericInput('weight', 'Enter your weight in Kilograms', 60, 45, 120)
    ),
    mainPanel(
      textOutput("bmi"),
      textOutput("bmi_status")
    )
  )
)

shinyApp(ui = ui, server = server)

Observes vs Reactives

Primero definamos que uuna observe u observación es una forma de dar a conocer algo al usuario de la app pero que no es parte del progrmaa en sí mismo. Por ejemplo se puede observar una notificación después de que el usuario ingrese su nombre:

ui <- fluidPage(
  textInput("nombre", "Por amor, escribe tu nombre")
)

server <- function(input, output, session){
  observe({
    showNotification(
      paste("Bienvenuti a la app de Shiny,", input$nombre)
    )
  })
}
shinyApp(ui = ui, server = server)

Por ende ya podemos deducir las diferencias.

server <- function(input, output, session){
  output$saludo <- renderText({
    paste(
      isolate({input$tipo_saludo}), input$name, sep = " ," 
    )
  })
}

 server <- function(input, output, session){
  rv_saludo <- eventReactive(input$muestra_saludo,{
    paste("Hola", input$name)
  })
  output$saludo <- renderText({
    rv_saludo()
  })
}

 server <- function(input, output, session){
  observeEvent(input$muestra_saludo,{
    showModal(modalDialog(paste("Hola", input$name)))
  })
}

ui <- fluidPage(
  titlePanel('BMI Calculator'),
  sidebarLayout(
    sidebarPanel(
      textInput('name', 'Enter your name'),
      numericInput('height', 'Enter your height (in m)', 1.5, 1, 2, step = 0.1),
      numericInput('weight', 'Enter your weight (in Kg)', 60, 45, 120)
    ),
    mainPanel(
      textOutput("bmi")
    )
  )
)

server <- function(input, output, session) {
  rval_bmi <- reactive({
    input$weight/(input$height^2)
  })
  output$bmi <- renderText({
    bmi <- rval_bmi()
    paste("Hi", isolate({input$name}), ". Your BMI is", round(bmi, 1))
  })
}

shinyApp(ui = ui, server = server)

bmi_help_text <- "Body Mass Index is a simple calculation using a person's height and weight. The formula is BMI = kg/m2 where kg is a person's weight in kilograms and m2 is their height in metres squared. A BMI of 25.0 or more is overweight, while the healthy range is 18.5 to 24.9."

server <- function(input, output, session) {
  # MODIFY CODE BELOW: Wrap in observeEvent() so the help text 
  # is displayed when a user clicks on the Help button.
  observeEvent(input$show_help, {
     # Display a modal dialog with bmi_help_text
     # MODIFY CODE BELOW: Uncomment code
     showModal(modalDialog(bmi_help_text))
  })
  rv_bmi <- eventReactive(input$show_bmi, {
    input$weight/(input$height^2)
  })
  output$bmi <- renderText({
    bmi <- rv_bmi()
    paste("Hi", input$name, ". Your BMI is", round(bmi, 1))
  })
}

ui <- fluidPage(
  titlePanel('BMI Calculator'),
  sidebarLayout(
    sidebarPanel(
      textInput('name', 'Enter your name'),
      numericInput('height', 'Enter your height in meters', 1.5, 1, 2),
      numericInput('weight', 'Enter your weight in Kilograms', 60, 45, 120),
      actionButton("show_bmi", "Show BMI"),
      # CODE BELOW: Add an action button named "show_help"
      actionButton("show_help", "Help")
    ),
    mainPanel(
      textOutput("bmi")
    )
  )
)

shinyApp(ui = ui, server = server)

server <- function(input, output, session) {
 
  rval_height_cm <- eventReactive(input$show_height_cm, {
    input$height * 2.54
  })
  
  output$height_cm <- renderText({
    height_cm <- rval_height_cm()
        paste("Your height in centimeters is", height_cm, "cm")
    })
}

ui <- fluidPage(
  titlePanel("Inches to Centimeters Conversion"),
  sidebarLayout(
    sidebarPanel(
      numericInput("height", "Height (in)", 60),
      actionButton("show_height_cm", "Show height in cm")
    ),
    mainPanel(
      textOutput("height_cm")
    )
  )
)

shinyApp(ui = ui, server = server)

1. Aliens

#Información de los avistamientos de aliens

#NO se cuenta con la información de usa_ufo_sightings

#Así que no se correrá esta app

ui <- fluidPage(
  titlePanel("UFO Sightings"),
  sidebarPanel(
    selectInput("state", "Choose a U.S. state:", choices = unique(usa_ufo_sightings$state)),
    dateRangeInput("dates", "Choose a date range:",
      start = "1920-01-01",
      end = "1950-01-01"
    )
  ),
  mainPanel(
    tabsetPanel(
      tabPanel(
        "Plot", plotOutput("shapes")
      ),
      tabPanel(
        "Table", tableOutput("duration_table")
      )
    )
  )
)

server <- function(input, output) {
  output$shapes <- renderPlot({
    usa_ufo_sightings %>%
      filter(
        state == input$state,
        date_sighted >= input$dates[1],
        date_sighted <= input$dates[2]
      ) %>%
      ggplot(aes(shape)) +
      geom_bar() +
      labs(
        x = "Shape",
        y = "# Sighted"
      )
  })

  output$duration_table <- renderTable({
    usa_ufo_sightings %>%
      filter(
        state == input$state,
        date_sighted >= input$dates[1],
        date_sighted <= input$dates[2]
      ) %>%
      group_by(shape) %>%
      summarize(
        nb_sighted = n(),
        avg_duration_min = mean(duration_sec) / 60,
        median_duration_min = median(duration_sec) / 60,
        min_duration_min = min(duration_sec) / 60,
        max_duration_min = max(duration_sec) / 60
      )
  })
}

shinyApp(ui, server)

2. Encuesta sobre salud mental en Tecnología

server <- function(input, output, session) {
  output$age <- renderPlot({
    # MODIFY CODE BELOW: Add validation that user selected a 3rd input
    validate(
      need(input$mental_vs_physical != "", "Be sure to select an response")
    )  
   mental_health_survey %>%
      filter(
        work_interfere == input$work_interfere,
        mental_health_consequence %in% input$mental_health_consequence,
        mental_vs_physical %in% input$mental_vs_physical
      ) %>%
      ggplot(aes(Age)) +
      geom_histogram()
  })
}

ui <- fluidPage(
  titlePanel("2014 Mental Health in Tech Survey"),
  sidebarPanel(
    sliderTextInput(
      inputId = "work_interfere",
      label = "If you have a mental health condition, do you feel that it interferes with your work?", 
      grid = TRUE,
      force_edges = TRUE,
      choices = c("Never", "Rarely", "Sometimes", "Often")
    ),
    checkboxGroupInput(
      inputId = "mental_health_consequence",
      label = "Do you think that discussing a mental health issue with your employer would have negative consequences?", 
      choices = c("Maybe", "Yes", "No"),
      selected = "Maybe"
    ),
    pickerInput(
      inputId = "mental_vs_physical",
      label = "Do you feel that your employer takes mental health as seriously as physical health?", 
      choices = c("Don't Know", "No", "Yes"),
      multiple = TRUE
    )    
  ),
  mainPanel(
    plotOutput("age")  
  )
)

shinyApp(ui, server)

3. Cocinas en el mundo y sus platillos más comidos

recipies
ui <- fluidPage(
  titlePanel('Explore Cuisines'),
  sidebarLayout(
    sidebarPanel(
      selectInput('cuisine', 'Select Cuisine', unique(recipes$cuisine)),
      sliderInput('nb_ingredients', 'Select No. of Ingredients', 5, 100, 20),
    ),
    mainPanel(
      tabsetPanel(
        # CODE BELOW: Add `d3wordcloudOutput` named `wc_ingredients` in a `tabPanel`
        tabPanel('Word Cloud', d3wordcloud::d3wordcloudOutput('wc_ingredients', height = '400')),
        tabPanel('Plot', plotly::plotlyOutput('plot_top_ingredients')),
        tabPanel('Table', DT::DTOutput('dt_top_ingredients'))
      )
    )
  )
)
server <- function(input, output, session){
  # CODE BELOW: Render an interactive wordcloud of top distinctive ingredients 
  # and the number of recipes they get used in, using 
  # `d3wordcloud::renderD3wordcloud`, and assign it to an output named
  # `wc_ingredients`.
  output$wc_ingredients <- d3wordcloud::renderD3wordcloud({
     ingredients_df <- rval_top_ingredients()
     d3wordcloud(ingredients_df$ingredient, ingredients_df$nb_recipes, tooltip = TRUE)
  })
  rval_top_ingredients <- reactive({
    recipes_enriched %>% 
      filter(cuisine == input$cuisine) %>% 
      arrange(desc(tf_idf)) %>% 
      head(input$nb_ingredients) %>% 
      mutate(ingredient = forcats::fct_reorder(ingredient, tf_idf))
  })
  output$plot_top_ingredients <- plotly::renderPlotly({
    rval_top_ingredients() %>%
      ggplot(aes(x = ingredient, y = tf_idf)) +
      geom_col() +
      coord_flip()
  })
  output$dt_top_ingredients <- DT::renderDT({
    recipes %>% 
      filter(cuisine == input$cuisine) %>% 
      count(ingredient, name = 'nb_recipes') %>% 
      arrange(desc(nb_recipes)) %>% 
      head(input$nb_ingredients)
  })
}
shinyApp(ui = ui, server= server)

4. Disparos en EU

ui <- bootstrapPage(
  theme = shinythemes::shinytheme('simplex'),
  leaflet::leafletOutput('map', width = '100%', height = '100%'),
  absolutePanel(top = 10, right = 10, id = 'controls',
    sliderInput('nb_fatalities', 'Minimum Fatalities', 1, 40, 10),
    dateRangeInput(
      'date_range', 'Select Date', "2010-01-01", "2019-12-01"
    ),
    # CODE BELOW: Add an action button named show_about
    actionButton("show_about", "About")
  ),
  tags$style(type = "text/css", "
    html, body {width:100%;height:100%}     
    #controls{background-color:white;padding:20px;}
  ")
)
server <- function(input, output, session) {
  # CODE BELOW: Use observeEvent to display a modal dialog
  # with the help text stored in text_about.
observeEvent(input$show_about, {
    showModal(modalDialog("This data was compiled by Mother Jones, nonprofit founded in 1976. Originally covering cases from 1982-2012, this database has since been expanded numerous times to remain current.", title = 'About'))
})
  
  
  output$map <- leaflet::renderLeaflet({
    mass_shootings %>% 
      filter(
        date > input$date_range[1],
        date < input$date_range[2],
        fatalities >= input$nb_fatalities
      ) %>% 
      leaflet() %>% 
      setView( -98.58, 39.82, zoom = 5) %>% 
      addTiles() %>% 
      addCircleMarkers(
        popup = ~ summary, radius = ~ sqrt(fatalities)*3,
        fillColor = 'red', color = 'red', weight = 1
      )
  })
}

shinyApp(ui, server)

Añadir mensajes de error.