1

Realizo la siguiente app pero en el gráfico de barras no consigo poner el nombre debajo de las barras.

library(shiny)
library(shinydashboard)

sidebar <- dashboardSidebar(
  sidebarMenu(id="sbmenu",
              menuItem("Apartado1",tabName = "DR" ,
                       menuSubItem('Resumen Apartado1', tabName = 'menu11'),
                       menuSubItem('Apartado 2', tabName = 'menu12'),
                       menuSubItem('Apartado 3', tabName = 'menu13')
              ),

              menuItem("menu2_",tabName = "menu2" ,
                       menuSubItem('Sub Menu 1', tabName = 'menu21'),
                       menuSubItem('Sub Menu 2', tabName = 'menu22'),
                       menuSubItem('Sub Menu 3', tabName = 'menu23')
              ),

              menuItem("menu3_",tabName = "menu3" ,
                       menuSubItem('Sub Menu 1', tabName = 'menu31'),
                       menuSubItem('Sub Menu 2', tabName = 'menu32'),
                       menuSubItem('Sub Menu 3', tabName = 'menu33')
              ),

              menuItem("menu4_",tabName = "menu4" ,
                       menuSubItem('Sub Menu 1', tabName = 'menu41'),
                       menuSubItem('Sub Menu 2', tabName = 'menu42'),
                       menuSubItem('Sub Menu 3', tabName = 'menu43')
              ),

              menuItem("menu5_",tabName = "menu5" ,
                       menuSubItem('Sub Menu 1', tabName = 'menu51'),
                       menuSubItem('Sub Menu 2', tabName = 'menu52'),
                       menuSubItem('Sub Menu 3', tabName = 'menu53')
              ),

              menuItem("menu6_",tabName = "menu6",
                       menuSubItem('Sub Menu 1', tabName = 'menu61'),
                       menuSubItem('Sub Menu 2', tabName = 'menu62'),
                       menuSubItem('Sub Menu 3', tabName = 'menu63')
              ),
              menuItem("menu7_",tabName = "menu7",
                       menuSubItem('Sub Menu 1', tabName = 'menu61'),
                       menuSubItem('Sub Menu 2', tabName = 'menu62'),
                       menuSubItem('Sub Menu 3', tabName = 'menu63')
              ),
              menuItem("menu8_",tabName = "menu8",
                       menuSubItem('Sub Menu 1', tabName = 'menu61'),
                       menuSubItem('Sub Menu 2', tabName = 'menu62'),
                       menuSubItem('Sub Menu 3', tabName = 'menu63')
              )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem("menu11",h1("Apartado 1"), tabsetPanel(type = "tabs",
                                                   tabPanel("Comidas",fluidRow(
                                                     checkboxGroupInput("Comidas_DR", "Comidas DR", inline = TRUE,
                                                                        table(factor(c(rep("Peras", 1000), rep("Naranjas", 560),
                                                                                       rep("Platanos", 2100), rep("Uvas", 700), rep("Melon", 1500),
                                                                                       rep("Sandia", 750), rep("Melocoton", 2200), rep("Pomelo", 1050),
                                                                                       rep("Fresa", 1250)), levels = c("Peras","Naranjas","Platanos","Uvas","Melon","Sandia",
                                                                                                                       "Melocoton","Pomelo","Fresa")))

                                                     ),
                                                     title = "Grafico",
                                                     plotOutput(outputId = "barplot1")
                                                   ))
    )),
    tabItem("menu12",h1("Pagina 2 en construccion")),
    tabItem("menu13",h1("Pagina 3 en construccion")),

    tabItem("menu21",h1("Pagina 1 en construccion")),
    tabItem("menu22",h1("Pagina 2 en construccion")),
    tabItem("menu23",h1("Pagina 3 en construccion")),

    tabItem("menu31",h1("Pagina 1 en construccion")),
    tabItem("menu32",h1("Pagina 2 en construccion")),
    tabItem("menu33",h1("Pagina 3 en construccion")),

    tabItem("menu41",h1("Pagina 1 en construccion")),
    tabItem("menu42",h1("Pagina 2 en construccion")),
    tabItem("menu43",h1("Pagina 3 en construccion")),

    tabItem("menu51",h1("Pagina 1 en construccion")),
    tabItem("menu52",h1("Pagina 2 en construccion")),
    tabItem("menu53",h1("Pagina 3 en construccion")),

    tabItem("menu61",h1("Pagina 1 en construccion")),
    tabItem("menu62",h1("Pagina 2 en construccion")),
    tabItem("menu63",h1("Pagina 3 en construccion")),

    tabItem("menu71",h1("Pagina 1 en construccion")),
    tabItem("menu72",h1("Pagina 2 en construccion")),
    tabItem("menu73",h1("Pagina 3 en construccion")),

    tabItem("menu81",h1("Pagina 1 en construccion")),
    tabItem("menu82",h1("Pagina 2 en construccion")),
    tabItem("menu83",h1("Pagina 3 en construccion"))
  )
)


ui <- dashboardPage(
  dashboardHeader(title = 'Comidas', titleWidth = 290),
  sidebar,
  body
)

server <- function(input, output) {
  observe(print(input$sbmenu))


  output$barplot1 <- renderPlot({
    barplot(as.numeric(input$Comidas_DR),
            xlim = c(0, 10), ylim = c(0, 2500),col = rainbow(9),
            names.arg = names(input$Comidas_DR))


            grid()
  })
}

shinyApp(ui,server)

La interfaz de este ejemplo sería:

introducir la descripción de la imagen aquí

Quisiera incorporar las etiquetas de cada selección debajo de cada barra, lo he intentado mediante names.arg = names(input$Comidas_DR) pero sin éxito.

1

1 respuesta 1

1

El problema es que input$Comidas_DR es un vector sencillo con las opciones seleccionadas, en tu ejemplo es la frecuencia de cada fruta, y names(input$Comidas_DR) lamentablemente, no te retorna los nombres. En primer lugar reformularía los datos en una estructura más amigable para trabajar, colocado a nivel global (al comienzo del script) haría:

x <- table(factor(c(rep("Peras", 1000), rep("Naranjas", 560),
                    rep("Platanos", 2100), rep("Uvas", 700), rep("Melon", 1500),
                    rep("Sandia", 750), rep("Melocoton", 2200), rep("Pomelo", 1050),
                    rep("Fresa", 1250)), levels = c("Peras","Naranjas","Platanos","Uvas","Melon","Sandia",
                                                    "Melocoton","Pomelo","Fresa")))


opciones <- as.data.frame(x, 
                          row.names = names(x),
                          stringsAsFactors = FALSE)[,2,drop=FALSE]

opciones$NR <- 1:nrow(opciones)
opciones

          Freq NR
Peras     1000  1
Naranjas   560  2
Platanos  2100  3
Uvas       700  4
Melon     1500  5
Sandia     750  6
Melocoton 2200  7
Pomelo    1050  8
Fresa     1250  9

En opciones ahora tenemos un data.frame con los nombres de cada fruta como nombres de fila (esto es más amigable con el barplot, si quisieras ver el cuadro de leyendas), la frecuencia, y un número de fila. La configuración del selector sería:

checkboxGroupInput("Comidas_DR", 
                   "Comidas DR", 
                   inline = TRUE,
                   choiceNames = rownames(opciones),
                   choiceValues = opciones$NR)

Configuramos la etiqueta de la opción y el valor a retornar, que será el número de fila. Lo siguiente sería actualizar el barlot:

    x = opciones[as.numeric(input$Comidas_DR),]
    barplot(x[, -2],
            xlim = c(0, 10), 
            ylim = c(0, 2500),
            col = rainbow(9),
            names.arg = rownames(x))

Simplemente filtramos el dta.frame inicial, con las opciones elegidas. En rownames(x) tendremos las leyendas que queremos debajo de cada barra, con x[, -2] nos quedamos solamente con las frecuencias

2
  • Muchas gracias. No encontraba la solución y no era tan difícil de ver. Le estoy muy agradecido. Commented el 27 mar. 2019 a las 18:11
  • Hola @GabrielEsteban, si la respuesta funcionó, sugiero que sea acepta, ¿Cómo funciona la aceptación de respuestas? esto no sólo aumentará tus puntos y la posibilidad de que ganes más medallas, sino que permitirá a la comunidad estar enfocada en ayudar a otros miembros con las preguntas no resueltas. Commented el 28 mar. 2019 a las 15:21

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.