Reputation: 30
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
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