Paula Macedo
Paula Macedo

Reputation: 30

I can't manage creating a reactive boxplot that takes two different inputs in shiny

I've managed to filter a DataTable with two SelectInput in my code. But, when I try to do the same in my boxplot and histogram it doesn't seem to filter. Is there, by any chance, someone to help me with this? I'm new to shiny.

My code is something like this:

afastamentos <- readr::read_csv("base_afastamentos.csv", locale = locale(encoding = "latin1"))

colnames(afastamentos) <- c(
  "Descrição do Cargo", "Nome do Órgão de Origem", "UF", "Cidade da Residência",
  "Nível da Escolaridade", "Início do Afastamento", "Ano/Mês Referência",
  "Valor do Rendimento Líquido", "Descrição do Afastamento", "Ano Início Afastamento",
  "Mês Início Afastamento", "Rendimento Líquido Hora")


    ui <- dashboardPage(
  
  dashboardHeader(title = "COBRADI", 
                  titleWidth = 500,
                  tags$li(class = "dropdown",
                          tags$a(href = "https://www.ipea.gov.br/portal/index.php?option=com_content&view=article&id=39285&Itemid=343",
                                 icon("globe", lib = "glyphicon"),
                                 "Site COBRADI", 
                                 target = "_blank"))
  ),
  dashboardSidebar(
    sidebarMenu(
      id = "sidebar",

      menuItem("Dataset",
               tabName = "data",
               icon = icon("database")),

      menuItem("Visualização",
               tabName = "viz",
               icon = icon("chart-line")),

      menuItem("Informações",
               tabName = "info",
               icon = icon("info-circle"))
    )
  ),dashboardBody(
  tabItems(
     tabItem(tabName = "viz",
          tabBox(id = "t2", width = 12, 
             tabPanel(title = "Distribuição Amostral",
                          icon = icon("fas fa-chart-area"),
                          value = "trends",
                          
                          fluidRow(
                            column(width = 12,
                                   box(title = "Filtros", width = "100%",
                                       column(width = 6,
                                              box(width = "100%",
                                                  selectizeInput(inputId = "select_UF",
                                                                 label =  "Estados:",
                                                                 choices = c("TODOS", unique(afastamentos$UF)),
                                                                 multiple = T, 
                                                                 selected = "TODOS"))
                                       ),
                                       
                                       column(width = 6,
                                              box(width = "100%",
                                                  selectizeInput(inputId = "descricao_2",
                                                                 label = "Descrição do Afastamento:",
                                                                 choices = c("TODOS", unique(afastamentos$`Descrição do Afastamento`)),
                                                                 multiple = T, options = list(maxItems = 5),
                                                                 selected = "TODOS"))),
                                   )
                            )     
                          ),
                          fluidRow(
                            column(width = 12,
                                   box(title = "BoxPlot - Valor do Rendimento Bruto Mensal",
                                       status = "primary", 
                                       solidHeader = TRUE, 
                                       collapsible = TRUE, 
                                       width = "100%",
                                       plotlyOutput("boxplot"))
                            ),
                          
                          
                          
                            column(width = 12,
                                   box(title = "Histograma - Valor do Rendimento Bruto Mensal",
                                       status = "primary", 
                                       solidHeader = TRUE, 
                                       collapsible = TRUE,
                                       width = "100%",
                                       plotlyOutput("histplot")))
        )
      )
    )
  )
)
  )
)

And the server is:

server <- function(input, output, session){

meus_dados <-  reactive({
    ## filtro UF
    print(input)
    if (! "TODOS" %in% input$select_UF){
      a <- a |> 
        filter(`UF` %in% input$select_UF)
    }
    #Filtro Descricao 
    if(! "TODOS" %in% input$descricao_2){
      a <- a |>
        filter(`Descrição do Afastamento` %in% input$descricao_2)
      return(a)
    }
    })


output$boxplot <- renderPlotly({
    boxplot <- meus_dados()|>
      plot_ly() |>
      add_boxplot(~`Valor do Rendimento Líquido`) |> 
      layout(xaxis = list(title = "Valor do Rendimento Bruto"))
  })

  output$histplot <- renderPlotly({
    hist <- meus_dados() |> 
    plot_ly() |> 
    add_histogram(~`Rendimento Líquido Hora`) |> 
    layout(xaxis = list(title = "Valor da Hora Técnica"))})
}

And I get the following error: First argument data must be a data frame or shared data.

Data is available here: https://www.dropbox.com/s/kjilkkskggi27vo/base_afastamentos.csv?dl=0

Upvotes: 0

Views: 45

Answers (1)

YBS
YBS

Reputation: 21297

Your reactive object was the problem. This works fine for me using the original names.

ui <- dashboardPage(
  
  dashboardHeader(title = "COBRADI", 
                  titleWidth = 500,
                  tags$li(class = "dropdown",
                          tags$a(href = "https://www.ipea.gov.br/portal/index.php?option=com_content&view=article&id=39285&Itemid=343",
                                 icon("globe", lib = "glyphicon"),
                                 "Site COBRADI", 
                                 target = "_blank"))
  ),
  dashboardSidebar(
    sidebarMenu(
      id = "sidebar",
      
      menuItem("Dataset",
               tabName = "data",
               icon = icon("database")),
      
      menuItem("Visualização",
               tabName = "viz",
               icon = icon("chart-line")),
      
      menuItem("Informações",
               tabName = "info",
               icon = icon("info-circle"))
    )
  ),dashboardBody(
    tabItems(
      tabItem(tabName = "viz",
              tabBox(id = "t2", width = 12, 
                     tabPanel(title = "Distribuição Amostral",
                              icon = icon("fas fa-chart-area"),
                              value = "trends",
                              
                              fluidRow(
                                column(width = 12,
                                       box(title = "Filtros", width = "100%",
                                           column(width = 6,
                                                  box(width = "100%",
                                                      selectizeInput(inputId = "select_UF",
                                                                     label =  "Estados:",
                                                                     choices = c("TODOS", unique(afastamentos$UF_da_UPAG_de_vinculacao)),
                                                                     multiple = T, 
                                                                     selected = "TODOS"))
                                           ),
                                           
                                           column(width = 6,
                                                  box(width = "100%",
                                                      selectizeInput(inputId = "descricao_2",
                                                                     label = "Descrição do Afastamento:",
                                                                     choices = c("TODOS", unique(afastamentos$Descricao_do_afastamento)),
                                                                     multiple = T, options = list(maxItems = 5),
                                                                     selected = "TODOS"))),
                                       )
                                )     
                              ),
                              fluidRow(
                                column(width = 12,
                                       box(title = "BoxPlot - Valor do Rendimento Bruto Mensal",
                                           status = "primary", 
                                           solidHeader = TRUE, 
                                           collapsible = TRUE, 
                                           width = "100%",
                                           plotlyOutput("boxplot"))
                                ),
                                
                                
                                
                                column(width = 12,
                                       box(title = "Histograma - Valor do Rendimento Bruto Mensal",
                                           status = "primary", 
                                           solidHeader = TRUE, 
                                           collapsible = TRUE,
                                           width = "100%",
                                           plotlyOutput("histplot")))
                              )
                     )
              )
      )
    )
  )
)

server <- function(input, output, session){
  
  meus_dados <-  reactive({
    ## filtro UF
    print(input)
    a <- afastamentos
    if (! "TODOS" %in% input$select_UF){
      a <- a |> 
        filter(UF_da_UPAG_de_vinculacao %in% input$select_UF)
    }
    #Filtro Descricao 
    if(! "TODOS" %in% input$descricao_2){
      a <- a |>
        filter(Descricao_do_afastamento %in% input$descricao_2)
      
    }
    return(a)
  })
  
  
  output$boxplot <- renderPlotly({
    boxplot <- meus_dados()|>
      plot_ly() |>
      add_boxplot(~Valor_rendimento_liquido) |> 
      layout(xaxis = list(title = "Valor do Rendimento Bruto"))
  })
  
  output$histplot <- renderPlotly({
    hist <- meus_dados() |> 
      plot_ly() |> 
      add_histogram(~Rendimento_Liquido_Hora) |> 
      layout(xaxis = list(title = "Valor da Hora Técnica"))})
}

shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions