I need to apply a filter on data frame in my Shiny App.
I am looking for some button (small one) that opens a multiselect list of values of a specific column. Something like Excel's table filter
As an example (from another topic):
library(shiny)
shiny::runApp(list(
ui = fluidPage(
checkboxGroupInput("specy", "Specy", choices = levels(iris$Species)),
tableOutput("content")
),
server = function(input, output, session) {
output$content <- renderTable({
iris[iris$Species == input$specy, ]
})
}
))
Some idea from the widget fallery: use checkboxGroupInput that appears clicking on actionButton
All kind of suggestions are welcome. Thank's
This gets you most of the way, but it doesn't have a way to hide the checkbox once you have selected an option:
library(shiny)
shiny::runApp(list(
ui = fluidPage(
actionButton("show_checkbox", "Show Choices"),
uiOutput("checkbox"),
tableOutput("content")
),
server = function(input, output, session) {
output$checkbox <- renderUI({
if ( is.null(input$show_checkbox) ) { return(NULL) }
if ( input$show_checkbox == 0 ) { return(NULL) }
return(checkboxGroupInput("specy", "Specy", choices = levels(iris$Species)))
})
output$content <- renderTable({
if ( is.null(input$specy) ) { return(iris) }
if ( length(input$specy) == 0 ) { return(iris) }
iris[iris$Species == input$specy, ]
})
}
))
Related
I am trying to pass a value assigned in an observeEvent to another observeEvent in shiny. In addition to the codes below, I also attempted to use my_dynamic_table(), but unfortunately I couldn't achieve my goal.
My aim is to have "Something 1" on the screen if my_dynamic_table is not empty.
library(shiny)
library(DT)
my_dynamic_table = data.frame(NA)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
observeEvent (input$call ,{
my_dynamic_table <- mtcars
output$table_out <- DT::renderDataTable(
my_dynamic_table
) # renderDataTable : table_out
})
observeEvent (input$save,{
output$text <- renderText({
if(nrow(my_dynamic_table)>1) {
"Something 1"
}else {
"Something 2"
}
}) #renderText
}) #observeEvent
} #server
) #shinyApp
One option to achieve that would be to use a reactiveVal or reactiveValues:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call", "Call"),
actionButton("save", "Save"),
verbatimTextOutput("text"),
DT::dataTableOutput("table_out")
),
server = function(input, output, session) {
my_dynamic_table <- reactiveVal(data.frame())
observeEvent(input$call, {
my_dynamic_table(mtcars)
output$table_out <- DT::renderDataTable(
my_dynamic_table()
)
})
observeEvent(input$save, {
output$text <- renderText({
if (nrow(my_dynamic_table()) > 0) {
"Something 1"
} else {
"Something 2"
}
}) # renderText
}) # observeEvent
} # server
) # shinyApp
While I do think that using reactiveValues is a good solution to this problem, I'd say its never a good idea to use an output inside an observeEvent(). I would rearrange the code as below. In the observeEvent we observe the action buttons, and when clicked, update the reactiveValues. Those are again intermediates for your output.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
my <- reactiveValues(dynamic_table = data.frame(NA),
text = NA)
observeEvent(input$call, {
my$dynamic_table <- mtcars
})
observeEvent(input$save, {
if (nrow(my$dynamic_table) > 1) {
my$text <- "Something 1"
} else {
my$text <-"Something 2"
}
})
output$text <- renderText({
req(input$save)
my$text
})
output$table_out <- DT::renderDataTable({
req(input$call)
my$dynamic_table
})
} #server
) #shinyApp
I am looking for some help please to develop a solution to return the filtered rows in a reactable table in a Shiny app module.
I am looking to identify which rows are the subset of mtcars after the columns have been filtered with free text in the filter fields. The closest solution that I have found is at https://github.com/glin/reactable/issues/104#issuecomment-1262273788, however, I just can’t get it to sing inside a Shiny module.
I have placed calls to the ns() function in the jsCode string where I believe they should be, but can’t get the verbatimTextOutput 'out' element to show which rows, by index, are selected.
Any help would be appreciated. TIA
library(shiny)
library(reactable)
library(shinyjs)
firecastUI <- function(id) {
ns <- NS(id)
jsCode <- paste('shinyjs.getSortedData = function() {
try {
var idx = Reactable.getInstance("', ns('a_table'),'").sortedFlatRows.map(x => x.index + 1);
Shiny.onInputChange("', ns('sorted_data'),'", idx);
} catch {}
}')
tagList(
useShinyjs(),
extendShinyjs(text = jsCode, functions = "getSortedData"),
reactableOutput(ns('a_table')),
br(),
verbatimTextOutput(ns("out"))
)
}
firecastServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
output$a_table <- renderReactable({
reactable(
data = mtcars,
filterable = TRUE
)
})
observe({
invalidateLater(100)
js$getSortedData()
})
output$out <- renderPrint({
input$sorted_data
})
}
)
}
ui <- fluidPage(
firecastUI('fire')
)
server <- function(input, output, session) {
firecastServer('fire')
}
shinyApp(ui, server)
I have this shiny app. The main aim is to upload excel sheet with data and plot some graphs in tabs. User is able to select a sheet to make the graph. The seet will render to observe the selected data. This works well.
But I am struggling to manipulate with input data to make the graph.
I tried to use reactive value named data and then make the graph from that. I am quite new with shiny apps.
library(shiny)
library(readxl)
library(dplyr)
library(tidyverse)
library(lubridate)
ui <- fluidPage(
titlePanel("OTD project update"),
sidebarPanel(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
textInput('file1sheet','Name of Sheet (Case-Sensitive)')),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("Data", tableOutput("value")),
tabPanel("OTD", plotOutput("OTD"))
)
)
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
output$value <- renderTable({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$file1$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
data <- reactive({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
}
shinyApp(ui, server)
It may be better to use the sheet names in radio buttons to pick instead of typing it. Also, there was a typo. Try this
library(shiny)
library(readxl)
library(dplyr)
library(tidyverse)
library(lubridate)
library(DT)
ui <- fluidPage(
titlePanel("OTD project update"),
sidebarPanel(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
#textInput('file1sheet','Name of Sheet (Case-Sensitive)')
uiOutput("sheet")
),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("Data", DTOutput("table")),
tabPanel("OTD", plotOutput("plot"))
)
)
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
data <- reactive({
req(sheets_name())
if (!is.null(input$file1)) {
return(read_excel(input$file1$datapath, sheet = input$mysheet))
} else {
return(NULL)
}
})
output$sheet <- renderUI({
req(sheets_name())
radioButtons("mysheet", "Select a Sheet", choices = sheets_name())
})
output$table <- renderDT(data())
output$plot <- renderPlot({plot(cars)})
}
shinyApp(ui, server)
I'm trying to display a table in the mainpanel based on selection by the user from drop down.
Ex. The "selectInput" dropdown will have the values from table789 (options are 123, xyz, ...)
If user selects 123 then "table123" has to be displayed else "table456" to be displayed.
I'm very new to shiny, tried the below and got "attempt to replicate an object of type 'closure'" error. I'm not sure what I'm missing. Can anyone help?
Server:
server = function(input, output, session) {
output$outputtable = reactive({ifelse(input$selction == '123', DT::renderDataTable(table123), DT::renderDataTable(table456)) })
}
UI:
ui <- fluidPage(
sidebarPanel(selectInput("selction", "Select", choices = table789$column1, selected = "xyz")),
mainPanel(
tabsetPanel(
tabPanel("select", DT::dataTableOutput("outputtable")),
)
)
)
I think you're mixing things up here, you shouldn't be putting renderDataTable into reactive, this should work:
library(shiny)
table789 <- mtcars
table456 <- iris
table123 <- mtcars
table789$column1 <- sample(c("123","456"),nrow(table789),replace = T)
ui <- fluidPage(
sidebarPanel(selectInput("selection", "Select", choices = unique(table789$column1), selected = "xyz")),
mainPanel(
tabsetPanel(
tabPanel("select",
DT::dataTableOutput("outputtable")
)
)
)
)
server = function(input, output, session) {
data <- eventReactive(input$selection,{
if(input$selection == "123"){
return (table123)
}
table456
})
output$outputtable <- DT::renderDataTable(
data()
)
}
#Run the app
shinyApp(ui = ui, server = server)
I am using R Shiny to output a table, but I am having trouble filtering in the reactive part for the renderDataTable. I am using the mtcars table in this example, and I am trying to filter by type:
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("MTCARS"),
sidebarLayout(
sidebarPanel(id="sidebar",
textInput("type",
label = "Type",
placeholder = "Type"),)
,
mainPanel(
dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
selected <- reactive({
if (length(input$type) != 0) {
mtcars$type %in% input$type
} else {
TRUE
}
})
output$data <- renderDataTable(mtcars[selected(),])
}
shinyApp(ui = ui, server = server)
Currently, mtcars$type %in% input$type filters the table based on what the user inputs as the type. However, I want to modify this so that:
The text does not have to match exactly. Rows that contain Honda Civic will show up if the user types Hond.
The table needs to start out with the full table. Currently it has no row when it is starting despite having the if/else statement.
mtcars does not have any column type so I had to create one. I used stringr::str_detect to include also partially matched types.
library(shiny)
library(DT)
data <- mtcars %>%
rownames_to_column(var = "type")
ui <- fluidPage(
titlePanel("MTCARS"),
sidebarLayout(
sidebarPanel(id="sidebar",
textInput("type",
label = "Type",
placeholder = "Type"),)
,
mainPanel(
dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
selected <- reactive({
if (length(input$type) != 0) {
stringr::str_detect(data$type, input$type)
} else {
TRUE
}
})
output$data <- renderDataTable(data[selected(),])
}
shinyApp(ui = ui, server = server)