R Shiny One actionButton for multiple Output - r

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() })
})

Related

How to group data dynamically in r shiny app

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)

Shiny table formatting

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.

Multiple group_by shiny app making a plot

\
I'm a really beginner in R Shiny.
I have a similar problem as at the link below.
multiple group_by in shiny app
Instead of making a table which worked out/I managed by following the instructions in the link above.
I would like to make a plot, preferably with hchart. In which i would to switch the information because of the group by. The difficult part / or the thing that doesn't work is putting the group_by on the x-axis.
## hier de tabel versie
df2 <- readRDS("Data.rds")
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
uiOutput("groups")
),
mainPanel(
DT::dataTableOutput("summary")
)
)
)
server <- function(input, output) {
mydata <- reactive({
data <- df2
data
})
output$groups <- renderUI({
df <- mydata()
selectInput(inputId = "grouper", label = "Group variable", choices = c("L","Lt","Lp"), selected = "L")
})
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal))
})
output$summary <- DT::renderDataTable({
DT::datatable(summary_data())
})
}
shinyApp(ui, server)
The above code works, but i tried to make a plot like this:
df2 <- readRDS("Data.rds")
library(shiny)
library(highcharter)
library(dplyr)
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
uiOutput("groups")
),
mainPanel(
highchartOutput("plotje")
)
)
)
server <- function(input, output) {
mydata <- reactive({
data <- df2
data
})
output$groups <- renderUI({
df <- mydata()
selectInput(inputId = "grouper", label = "Group variable", choices = c("L","Lt","Lp"), selected = "L")
})
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal))
})
output$plotje <- renderHighchart({
data <- summary_data()
hchart(data, "column", hcaes(x = "grouper" , y = aantal)) # --> de plot zelf komt in het output deel van de UI
})
}
shinyApp(ui, server)
Could someone help me out?!
Thanks in advance!
Kind regards,
Steffie
You have the grouper column in the input$grouper var.
It's just a matter of unquoting it.
The line hchart(data, "column", hcaes(x = "grouper" , y = aantal)) should be:
hchart(data, "column", hcaes(x = !!input$grouper , y = aantal))
Full example (with iris data as you didn't provide an example of your own data):
library(shiny)
library(DT)
library(highcharter)
library(dplyr)
ui <- fluidPage(titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(uiOutput("groups")),
mainPanel(DT::dataTableOutput("summary"),
highchartOutput("plot"))
))
server <- function(input, output) {
mydata <- reactive({
iris
})
output$groups <- renderUI({
df <- mydata()
selectInput(
inputId = "grouper",
label = "Group variable",
choices = c("Petal.Length", "Species"),
selected = "Species"
)
})
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal))
})
output$summary <- DT::renderDataTable({
DT::datatable(summary_data())
})
output$plot <- renderHighchart({
req(input$grouper)
data <- summary_data()
hchart(data, "column", hcaes(x = !!input$grouper, y = aantal))
})
}
shinyApp(ui, server)

different number of column name in selectIput Shiny

I have one problem with create dynamic UI (selectInput). I mean, I have two dataframes and one selectInput button which should change number of output (column name) depending on dataframe which I choose.
I just get error: Error: == only defined for equally-sized data frames when I choose df2 dataframe. Could anyone tell me what I do wrong? This is my if function:
output$xvars <- renderUI({
if (datasetInput() == df1){
axis_vars_x <- colnames(df1[c(1,2)])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
else{
axis_vars_x <- colnames(df2[1])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
})
ui.R
library(dplyr)
library(shiny)
library(ggvis)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Product level"),
choices = list("Item" = "df1", "Task" = "df2")),
uiOutput("xvars"),
),
mainPanel(
ggvisOutput("plot")
)
)
))
server.R
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34), ds = c(1,2,3,42,2))
df2 <- data.frame(id = c(1,2), number = c(33,40), ds = c(1,2))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
df1 = df1,
df2 = df2)
})
output$xvars <- renderUI({
if (datasetInput() == df1){
axis_vars_x <- colnames(df1[c(1,2)])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
else{
axis_vars_x <- colnames(df2[1])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
})
data <- reactive({
df <- datasetInput()
})
vis <- reactive({
data %>%
ggvis(~id, ~number) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black"))
})
vis %>% bind_shiny("plot")
})
From you comments, I assumed you wanted to change the y-axis to whatever was selected in the selectInput boxes. To do this with ggvis you need to change the data you pass to the plot.
You can try the following code, I changed a few of your variables:
server.R
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34), ds = c(1,2,3,42,2))
df2 <- data.frame(id = c(1,2), number = c(33,40), ds = c(1,2))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"df1" = df1,
"df2" = df2)
})
output$yvars <- renderUI({
if (identical(df1,datasetInput())){
axis_vars_y <- colnames(df1[-1])
selectInput("yvar", "X-axis variable", axis_vars_y, selected = "id")
}
else{
axis_vars_y <- colnames(df2[-1])
selectInput("yvar", "X-axis variable", axis_vars_y, selected = "id")
}
})
yVarName<-reactive({
yValue<-"number"
if(!is.null(input$yvar)){
yValue<-input$yvar
}
yValue
})
data <- reactive({
df<-datasetInput()
yValue<-"number"
if(!is.null(input$yvar)){
yValue<-input$yvar
}
df <- datasetInput()[,c("id",yValue)]
names(df)<-c("id","yVar")
df
})
vis <- reactive({
data %>%
ggvis(~id, ~yVar) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black")) %>%
add_axis("y", title = yVarName())
})
vis %>% bind_shiny("plot")
})
ui.R
library(dplyr)
library(shiny)
library(ggvis)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Product level"),
choices = list("Item" = "df1", "Task" = "df2")),
uiOutput("yvars")
),
mainPanel(
ggvisOutput("plot")
)
)
))

Develop Reactive change of min / max values of sliderInput

Thanks to this solution I finally figured out how create dynamic SliderInput button. Unfortunately I have a problem with use this input value after all ( to change subset condition in dplyr). Could anyone tell me what I do wrong?
ui.R
library(dplyr)
library(shiny)
library(ggvis)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Product level"),
choices = list("Item" = "df1", "Task" = "df2")),
uiOutput("slider")
),
mainPanel(
ggvisOutput("plot")
)
)
))
server.R
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34))
df2 <- data.frame(id = c(1,2), number = c(33,40))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
df1 = df1,
df2 = df2)
})
output$slider <- renderUI({
sliderInput("inslider","Slider", min = min(datasetInput()$number),
max = max(datasetInput()$number),
value = c(min(datasetInput()$number),
max(datasetInput()$number))
})
data <- reactive({
datasetInput %>%
filter(number >= input$inslider[1],
number <= input$inslider[2])
})
vis <- reactive({
data %>%
ggvis(~id, ~number) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black"))
})
vis %>% bind_shiny("plot")
})
Since you are using renderUI to make the slider, you have to check that input$inslider exists before filtering the data. When you load it for the first time, it doesn't because it is created by the renderUI
Try this for your server.R:
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34))
df2 <- data.frame(id = c(1,2), number = c(33,40))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"df1" = df1,
"df2" = df2)
})
output$slider <- renderUI({
sliderInput("inslider","Slider", min = min(datasetInput()$number),
max = max(datasetInput()$number),
value = c(min(datasetInput()$number),
max(datasetInput()$number))
)})
data <- reactive({
filteredData<-datasetInput()
if(!is.null(input$inslider)){
filteredData<-filteredData %>%
filter(number >= input$inslider[1] ,
number <= input$inslider[2] )
}
filteredData
})
vis <- reactive({
data()%>%
ggvis(~id, ~number) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black"))
})
vis %>% bind_shiny("plot")
})

Resources