I am creating a shiny App where it will do two things on mtcars dataset
group data based on user selected values and calculate the mean mpg
and then filter based on selected values to display the output
library(shiny)
library(dplyr)
ui <- fluidPage(
titlePanel(" APP"),
sidebarLayout(
sidebarPanel(selectInput("x","Select cylinder",choices = c(mtcars$cyl),multiple = TRUE),
selectInput("y","Select gear",choices = c(mtcars$gear),multiple = TRUE),
submitButton("Submit")),
mainPanel(
tableOutput("m")
)))
server <- function(input,output){
check <- reactive({
if(is.null(input$x) & is.null(input$y)){
mtcars %>% summarise(Average_mpg = mean(mpg))
}else if(!is.null(input$x) & is.null(input$y)){
a <- mtcars %>% group_by(cyl) %>% summarise(Average_mpg = mean(mpg))
a %>% filter(cyl==input$x)
}else if(is.null(input$x) & !is.null(input$y)){
a <- mtcars %>% group_by(gear) %>% summarise(Average_mpg = mean(mpg))
a %>% filter(gear==input$y)
}else{
a <- mtcars %>% group_by(gear,cyl) %>% summarise(Average_mpg = mean(mpg))
a %>% filter(cyl==input$x & gear==input$y)
}
})
output$m <- renderTable(
check()
)
}
shinyApp(ui = ui, server = server)
Currently I have hard coded all possible combination using if else statement and then realized its not efficient way. If the filters/widgets increase then its difficult to manage
for e.g. If I add one more filter here for variable "carb" in mtcars dataset I have to include all possible scenarios what the user will select and hard code it.
My actual app is having 5 -6 more filters.
Is there any way where whatever the user selects the app will group by on the fly and then filter and show results.
This is not a perfect approach as it still involves some copy & paste and duplicated code. But as a first step it gets rid of the if-else to filter your data:
library(shiny)
library(dplyr)
choices_cyl <- unique(mtcars$cyl)
choices_gear <- unique(mtcars$gear)
ui <- fluidPage(
titlePanel(" APP"),
sidebarLayout(
sidebarPanel(
selectInput("x", "Select cylinder", choices = choices_cyl, multiple = TRUE),
selectInput("y", "Select gear", choices = choices_gear, multiple = TRUE),
submitButton("Submit")
),
mainPanel(
tableOutput("m")
)
)
)
server <- function(input, output) {
check <- reactive({
cyls <- input$x
gears <- input$y
grps <- c("cyl", "gear")[c(!is.null(cyls), !is.null(gears))]
if (is.null(cyls)) cyls <- choices_cyl
if (is.null(gears)) gears <- choices_gear
mtcars %>%
filter(cyl %in% cyls, gear %in% gears) %>%
group_by(across(all_of(grps))) %>%
summarise(Average_mpg = mean(mpg))
})
output$m <- renderTable(
check()
)
}
shinyApp(ui = ui, server = server)
Related
I want to update a dataframe with user input in an R Shiny app. The user selects a row of data, and then chooses the value to update the Species column with using selectInput. The updates need to accumulate each time, i.e., the new updates update the previously updated data. I tried using reactiveValues as per this answer, but couldn't get it to work.
library(shiny)
library(reactable)
library(tidyverse)
iris_df = iris %>%
mutate(
id = row_number(),
Species = as.character(Species)
)
ui <- fluidPage(
navbarPage(
"HELP!",
tabPanel(
"Iris",
sidebarLayout(
sidebarPanel(
selectInput("update_species", "Update species", choices = c("Rose", "Daffodil"))
),
mainPanel(fluidRow(reactableOutput("iris")))
)
)
)
)
server <- function(input, output) {
observeEvent(input$update_species, {
iris_df = iris_df %>%
mutate(Species = case_when(id == selected_row() ~ input$update_species, TRUE ~ Species))
})
selected_row = reactive(getReactableState("iris", "selected"))
output$iris = renderReactable({
reactable(
iris_df,
selection = "single",
)
})
}
shinyApp(ui = ui, server = server)
The first issue with your code is that the observeEvent is triggered by input$update_species which results in an error if no row was selected in which case selected_row() is NULL. To prevent that you could add a req(selected_row()) or use selected_row() to trigger the observeEvent as I do in my code below.
Next, as you already realized you need a reactiveVal or a reactiveValues to actually update the dataframe inside the observeEvent based on the user choice.
library(shiny)
library(reactable)
library(tidyverse)
iris_df <- iris %>%
mutate(
id = row_number(),
Species = as.character(Species)
)
ui <- fluidPage(
navbarPage(
"HELP!",
tabPanel(
"Iris",
sidebarLayout(
sidebarPanel(
selectInput("update_species", "Update species", choices = unique(iris_df$Species))
),
mainPanel(fluidRow(reactableOutput("iris")))
)
)
)
)
server <- function(input, output) {
iris_df <- reactiveVal(iris_df)
observeEvent(selected_row(), {
iris_df(iris_df() %>%
mutate(Species = case_when(id == selected_row() ~ input$update_species, TRUE ~ Species)))
})
selected_row <- reactive(getReactableState("iris", "selected"))
output$iris <- renderReactable({
reactable(
iris_df(),
selection = "single",
)
})
}
shinyApp(ui = ui, server = server)
And this is an example output after updating rows 1, 4 and 7:
I'm trying to display two tables separately (dt2 and dt3) on Shiny mainPanel after clicking on an actionButton. dt2 involves the first five cars for the chosen type (mpg dataset), while dt3 calculates the mean cty for a chosen year. Unfortunately it doesn't work as I get only this tiny table:
How can I display both table on the main panel separately? (e.g dt2 on the left side, dt3 on the right)
Note: dt2 and dt3 are related in a sense that dt3 derived from dt2
UI side:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("manufacturer", "Car Type:", c("audi","chevrolet")),
selectInput("year", "Year:", c("1999","2008")),
actionButton("action", "Go!")
),
mainPanel(tableOutput("cty_mean"))
)
))
Server side:
shinyServer(function(input, output) {
mydata <- eventReactive(input$action, {
library(ggplot2)
library(dplyr)
dt <- mpg
dt2 <- dt %>%
filter(manufacturer==input$manufacturer) %>%
mutate(mean = mean(cty)) %>% slice(1:5)
dt2
dt3 <- dt2 %>% group_by(input$year) %>%
summarise(mean = mean(cty))
dt3
})
output$cty_mean <- renderTable({ mydata() })
})
In your code, mydata() is a reactive function with output dt3 (the last line of the function), this is why you only get one table as result.
You could use reactiveValues combined with observeEvent:
library(shiny)
library(ggplot2)
library(dplyr)
ui <-shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("manufacturer", "Car Type:", c("audi","chevrolet")),
selectInput("year", "Year:", c("1999","2008")),
actionButton("action", "Go!")
),
mainPanel(tableOutput("dt2"),
tableOutput("dt3"))
)
))
server <-shinyServer(function(input, output) {
mydata <- reactiveValues()
observeEvent(input$action, {
dt <- mpg
mydata$dt2 <- dt %>%
filter(manufacturer==input$manufacturer) %>%
mutate(mean = mean(cty)) %>% slice(1:5)
mydata$dt3 <- mydata$dt2 %>% group_by(input$year) %>%
summarise(mean = mean(cty))
})
output$dt2 <- renderTable({ mydata$dt2 })
output$dt3 <- renderTable({ mydata$dt3 })
})
shinyApp(ui,server)
I would split the mydata() into two different reactive events:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("manufacturer", "Car Type:", c("audi","chevrolet")),
selectInput("year", "Year:", c("1999","2008")),
actionButton("action", "Go!")
),
mainPanel(tableOutput("cty_mean1"),
tableOutput("cty_mean2"))
)
))
shinyServer(function(input, output) {
library(ggplot2)
library(dplyr)
mydata1 <- eventReactive(input$action, {
dt <- mpg
dt2 <- dt %>%
dplyr::filter(manufacturer==input$manufacturer) %>%
dplyr::mutate(mean = mean(cty)) %>% slice(1:5)
dt2
})
mydata2 <- eventReactive(input$action, {
dt3 <- mydata1() %>% group_by(input$year) %>%
summarise(mean = mean(cty))
dt3
})
output$cty_mean1 <- renderTable({ mydata1() })
output$cty_mean2 <- renderTable({ mydata2() })
})
I've been at this for awhile and have read a bunch but I still can't wrap my head around how to make this work. Is there a simple solution?
I want to edit a DT table in my shiny app and, upon editing, I'd like there to be a change in a column that aggregates two values.
Here is an example:
library(tidyverse)
library(shiny)
library(DT)
mt <- mtcars %>%
select(mpg, cyl) %>%
head()
ui <- fluidPage(
DTOutput(outputId = "final_tbl")
)
server <- function(input, output){
dat <- reactive({
d <- mt %>%
mutate(total = mpg + cyl)
d
})
output$final_tbl <- renderDT({
dat() %>%
datatable(editable = TRUE)
})
}
shinyApp(ui, server)
This produces a simple editable table with a total column that adds up mpg and cyl. What I'd like to be able to do is edit the cyl value and have the change reflected in the summed total column. Is there an easy solution to this?
You need to use _cell_edit as shown below in a ObserveEvent.
mt <- mtcars %>%
select(mpg, cyl) %>%
head()
ui <- fluidPage(
DTOutput(outputId = "final_tbl")
)
server <- function(input, output){
df1 <- reactiveValues(data=NULL)
dat <- reactive({
d <- mt %>%
mutate(total = mpg + cyl)
d
})
observe({
df1$data <- dat()
})
output$final_tbl <- renderDT({
df1$data %>%
datatable(editable = TRUE)
})
observeEvent(input$final_tbl_cell_edit, {
info = input$final_tbl_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# Without this line the table does not change but with it it jumps to row 1 after an edit.
df1$data[i, j] <<- (DT::coerceValue(v, df1$data[i, j]))
df1$data[,"total"] <<- df1$data[,"mpg"] + df1$data[,"cyl"] ## update the total column
})
}
shinyApp(ui, server)
I am new to Shiny and have a basic shiny app using mtcars. I have multiple tabs with some input dropdowns and presenting the output as DT tables. This is all working fine, but I would now like to use some formatting like formattable. Some of the formatting I would like to include is basic percentage, decimal. Also, I would like to add some cell based highlighting. I have tried multiple formatting functions without any luck. I have added functions within the server side output, but I can not get the right combination. Below is my Shiny code:
library(shiny)
library(dplyr)
library(DT)
ui <- fluidPage(
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
selectInput("cyl",
"cyl:",
c(unique(as.character(mtcars$cyl)))),
selectInput("gear",
"gear:",
c("All",
unique(as.character(mtcars$gear)))), width=2),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("Summary", DT::dataTableOutput("Summary")),
tabPanel("Detail", DT::dataTableOutput("Detail"))))))
server <- function(input, output) {
output$Detail <- renderDataTable(datatable({
data <- mtcars
if (input$cyl != "All") {
data <- data[data$cyl == input$cyl,]
}
if (input$gear != "All") {
data <- data[data$gear == input$gear,]
}
data
}))
output$Summary <- renderDataTable({
mtcars %>%
filter(cyl==input$cyl) %>%
group_by(gear) %>%
summarise(mpg = median(mpg),
count = n()) %>%
ungroup() %>%
arrange(desc(count))
})}
shinyApp(ui = ui, server = server)
I'm not sure what you've tried so far with formattable, but you should be able to use it with DT in your shiny app.
Here is a quick example you can try. This makes the mpg column a percentage. Also, if colors the count column a shade of green.
Other vignettes are available for other options with formattable package.
output$Summary <- renderDataTable({
my_data <- mtcars %>%
filter(cyl==input$cyl) %>%
group_by(gear) %>%
summarise(mpg = median(mpg),
count = n()) %>%
ungroup() %>%
arrange(desc(count))
# Make percent, for example
my_data$mpg <- percent(my_data$mpg)
# Return formattable datatable
return(
as.datatable(
formattable(
my_data,
list(
count = color_tile("transparent", "green")
)
)
)
)
})
To complete Ben's answer, even if you say you want to use formattable, I think there are enough options in DT to customize the tables the way you want.
Here's your example (randomly customized since you didn't specify the formatting of the cells):
library(shiny)
library(dplyr)
library(DT)
ui <- fluidPage(
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
selectInput("cyl",
"cyl:",
c(unique(as.character(mtcars$cyl)))),
selectInput("gear",
"gear:",
c("All",
unique(as.character(mtcars$gear)))), width=2),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("Summary", DT::dataTableOutput("Summary")),
tabPanel("Detail", DT::dataTableOutput("Detail"))))))
server <- function(input, output) {
output$Detail <- renderDataTable(datatable({
data <- mtcars
if (input$cyl != "All") {
data <- data[data$cyl == input$cyl,]
}
if (input$gear != "All") {
data <- data[data$gear == input$gear,]
}
data
}))
output$Summary <- renderDataTable({
your_data <- mtcars %>%
filter(cyl==input$cyl) %>%
group_by(gear) %>%
summarise(mpg = median(mpg),
count = n()) %>%
ungroup() %>%
arrange(desc(count))
datatable(your_data) %>%
formatPercentage(columns = c("mpg", "gear")) %>%
formatRound(columns = c("count"), digits = 3) %>%
formatStyle(columns = "mpg",
valueColumns = "gear",
backgroundColor = styleEqual(c(3, 4, 5), c("red", "blue", "green")))
})}
shinyApp(ui = ui, server = server)
See here for more details, and here for several examples of color-styling.
I am trying to build a shiny app that gives user the flexibility to choose the variables for group by and summarize. Checkbox will have an option for selecting group by variables. Right now I haven't given measure variables as selections, since I struggling with group by. I want the numbers to be aggregated basis the selection.
library(shiny)
library(ggplot2) # for the diamonds dataset
library(shinydashboard)
library(dplyr)
y1<-diamonds
ui <- fluidPage(
checkboxGroupInput("variable", "Variables to show:",
c("cut","color","clarity"),selected = "cut"),
tableOutput("data"),
textOutput("result")
)
server <- function(input, output, session) {
base <- reactive({
groupby <- enquo(input$variable)
print(groupby)
res <-y1%>% group_by(!!!groupby,x) %>%
tally() %>%
ungroup() %>%
summarise(sum = sum(x)) %>%
pull()
res
})
output$result <- renderText({
input$variable
})
output$data<-renderTable({
base()
}
)
}
shinyApp(ui, server)
Thanks,
Hema
I'm not sure that I understood your question exactly, but maybe something like this:
library(shiny)
library(ggplot2) # for the diamonds dataset
library(shinydashboard)
library(dplyr)
y1<-diamonds
ui <- fluidPage(
checkboxGroupInput("variable", "Variables to show:",
c("cut","color","clarity"),selected = "cut"),
tableOutput("data"),
textOutput("result")
)
server <- function(input, output, session) {
base <- reactive({
res <- y1 %>% group_by(eval(parse(text = input$variable)),x) %>%
tally() %>%
#ungroup() %>%
summarise(sum = sum(x)) %>%
pull()
res
})
output$result <- renderText({
input$variable
})
output$data<-renderTable({
base()
})
}
shinyApp(ui, server)
if it's possible to select multiple from the check boxes such that you'd want something like group_by(x,y) this may help you get what you want:
group_by(across(all_of(input$group)))