I want to build a shiny application that allows the user to interact with different plots and tables that are linked. To be precise, plot1 shows the raw data as a scatter plot, plot2 shows the data in an aggregated barplot, and finally table1 shows the data aggregated by another variable.
For example using ggplot2::mpg, I want hwy vs cty in plot1; plot2 shows the average hwy by manufacturer; and table1 shows the average hwy by drv.
The important bit is that when the user selects drv == "r" in the table, plot1 and plot2 should be reactive to that. Similarly, if a range is selected in plot1, then plot2 and table1 should show the values for the filtered data only, similarly, if a group is excluded by clicking on the legend in plot2, eg drv != "r", then that should be applied to the other data as well.
Using basic shiny I would create a reactive dataset which is filtered by the selection of each plot/table, but this feels a little bit too complicated for the task at hand.
This seems to be the perfect example for crosstalk but I am not able to get it to work.
For a simple example, I was using echarts4r for the interactivity.
MWE
An MWE looks like this:
library(dplyr) # for aggregating the data
library(ggplot2) # for the mpg dataset
library(shiny) # ...
library(crosstalk) # ...
library(reactable) # interactive tables
library(echarts4r) # interactive charts
# 1. Create the shared datasets =====
sd_raw <- SharedData$new(mpg, group = "mpg")
sd_by_man <- as_tibble(mpg) |>
group_by(manufacturer, drv) |>
summarise(n = n(), mean_hwy = mean(hwy)) |>
SharedData$new(group = "mpg")
sd_by_drv <- as_tibble(mpg) |>
group_by(drv) |>
summarise(n = n(), mean_hwy = mean(hwy)) |>
SharedData$new(group = "mpg")
# 2. Define shiny UI ====
ui <- fluidPage(
fluidRow(
column(4, echarts4rOutput("plot1")),
column(4, echarts4rOutput("plot2")),
column(4, reactableOutput("table1"))
)
)
# 3. Define shiny Server ====
server <- function(input, output, session) {
output$plot1 <- renderEcharts4r({
# apparently echarts4r and group_by do not play well with sd_raw, but need
# the $data() element
sd_raw$data() |>
group_by(drv) |>
e_charts(hwy) |>
e_scatter(cty, ) |>
e_tooltip() |>
e_brush()
})
output$plot2 <- renderEcharts4r({
sd_by_man$data() |>
group_by(drv) |>
e_charts(manufacturer, stack = "drv") |>
e_bar(mean_hwy) |>
e_tooltip() |>
e_brush()
})
output$table1 <- renderReactable({
reactable(
sd_by_drv$data(),
selection = "multiple",
onClick = "select",
rowStyle = list(cursor = "pointer"),
minRows = 10
)
})
}
shinyApp(ui, server)
Which results in an app like this
Note that the app looks correct, but for example
selecting a drv in the table does not change the plots, or
de-selecting a drv does not change the other outputs, or
brushing an area on the first plot also does not change the other outputs.
Any idea how to get this interactivity to work? Can this be done using crosstalk or do I need to resort back to using basic shiny reactivity (which of course would make the app a lot more complicated...)
I'm making a Shiny app in which the user can generate a column in a table by clicking on a checkboxInput. The column I would like to create contains the lagged value of the column already present in the table.
The code below shows a reproducible example: there are two individuals (A and B) and three time periods (1, 2 and 3).
library(dplyr)
library(shiny)
data <- head(mtcars)
data$time <- rep(seq(1:3))
data$ID <- rep(c("A", "B"), each = 3)
ui <- fluidPage(
selectInput("choice", "Select a column", choices = c("mpg", "drat", "hp"), multiple = F),
checkboxInput("lag", "Compute lag value"),
tableOutput("table")
)
server <- function(input, output, session) {
data2 <- reactive({
lagged_name <- paste0(input$choice, "_lagged")
if (input$lag){
data %>%
select(ID, time, input$choice) %>%
group_by(ID) %>%
mutate(!!all_of(lagged_name) := lag(data[, input$choice]))
}
else {
data %>%
select(ID, time, input$choice)
}
})
output$table <- renderTable({
data2()
})
}
shinyApp(ui, server)
When I run this code and click on the checkbox, I have the error:
Warning: Error in : Column mpg_lagged must be length 3 (the group size) or one, not 6
Thanks to this answer, I corrected it by adding order_by = ID in the lag function but now there is another problem: for individual 1, it creates the right lagged values, but then those values are repeated for individual 2 as well whereas they do not correspond.
I tried a similar example without the Shiny environment and the right output is produced so I suppose this problem comes from the inputs or reactive environment.
Does anybody have a solution?
There are some (minor) issues with non-standard evaluation (NSE) inside your reactive data object. Fixing these gives
library(dplyr)
library(shiny)
data <- head(mtcars)
data$time <- rep(seq(1:3))
data$ID <- rep(c("A", "B"), each = 3)
ui <- fluidPage(
selectInput("choice", "Select a column", choices = c("mpg", "drat", "hp"), multiple = F),
checkboxInput("lag", "Compute lag value"),
tableOutput("table")
)
server <- function(input, output, session) {
data2 <- reactive({
lagged_name <- paste0(input$choice, "_lagged")
if (input$lag){
data %>%
select(ID, time, input$choice) %>%
group_by(ID) %>%
mutate(!!lagged_name := lag(!!sym(input$choice)))
}
else {
data %>%
select(ID, time, input$choice)
}
})
output$table <- renderTable({
data2()
})
}
shinyApp(ui, server)
resulting in
Explanation:
select takes both evaluated symbols and strings as arguments, so we can directly pass input$choice as an argument to select.
To construct a new column with a name from a variable we need to evaluate the variable as !!lagged_name; we then must use := (instead of =) to do the assignment, as R's grammar does not allow expressions as argument names (the lhs of the assignment). Finally, inside the lag function we first must convert input$choice to a symbol with sym and then evaluate the symbol with !!. That's because of dplyr's NSE, where you would write e.g. mtcars %>% mutate(col = lag(wt)) and not mtcars %>% mutate(col = lag("wt")).
I'm probably going about this the wrong way entirely, but I could really use some direction on how to do this.
My dataset is a data.frame and I have written a reactive script to filter it based on one column when the user clicks the button. The output is a table that I can view when I enter filtered.data() after renderDataTable in the script below, but what I want is to then apply the aggregate function to the output data and view that output.
So in short, I want to filter my data frame, then apply a function to the filtered data, and output the result of that.
An example of what doesn't work:
library(shiny)
library(DT)
library(dplyr)
# Make a data frame
weight <- c(1,3,4,7,8,9,12)
material <- c("Wood", "Wood", "Steel", "Steel", "Rock", "Rock", "Rock")
df <- data.frame(weight, material)
shinyApp(
ui = fluidPage(
selectInput("type", "Material:",
choices = as.character(unique(df$material))),
actionButton("Filter", "Set Filter"),
DT::dataTableOutput("filtered.result")
),
#server.r
server = function(input, output) {
filtered.data <- eventReactive(input$Filter, {
df %>%
filter(material == input$type)
})
output$filtered.result <- DT::renderDataTable({
aggregate(weight~material, filtered.data, mean)
})
})
This gives the error: "cannot coerce class "c("reactiveExpr", "reactive")" to a data.frame" which I understand - I can't apply the aggregate function to the output "filtered.data", but is there a way to output the data following the reactive filter that I can apply the aggregate function to?
you can just use
observeEvent
So replace server code to
server = function(input, output) {
observeEvent(input$Filter, {
output$filtered.result <- DT::renderDataTable({
aggregate(
weight~material,
df %>%
filter(material == input$type),
mean)
})
})
}
Got Error in enc2utf8: argument is not a character vector.
I am using selectInput, checkboxGroupInput, textInput to filter data in the server, and get the above error; I have tried filter(),subset(),which() but they turn to have the same problem when filter the data by over four columns and the arguments are character vectors(eg. corp %in% c('Honda','Nissan'))
In the dataset, there are Market , Corp, Med_type, Med_id, measure, date, value columns.
And in the codes, brands, name_tmp, year are the character vectors used to filter data.
library(shiny)
library(dplyr)
library(DT)
ui<-fluidPage(pageWithSidebar(
headerPanel('Table'),
sidebarPanel(
fileInput('file1', 'Upload Data',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
selectInput('TA',"Market-type",c('Asia','Europe')),
selectInput('Length',"Length",c('1 year'='0','2 years'='1','3 years'='2','4 years'='3','5 years'='4')),
selectInput('NoBrand',"Top Brand/Cor",c('one'='1','two'='2','three'='3','four'='4','five'='5')),
selectInput('Period',"Period",c('Quarter'='Quarter','YR'='year')),
checkboxGroupInput('Measure','Measurement',c('Unit','RMB','Dollar')),
selectInput('Med_type','Med_type',c('Imported','Joint Venture','Local')),
textInput('Med_id','Med_id',value='Honda;Nissan')),
mainPanel(
dataTableOutput('table')
)))
server<-function(input,output){
options(shiny.maxRequestSize=100*1024^2)
## importing dataset
tmp <- reactive({inFile <- input$file1
if (is.null(inFile))
return(NULL)
data<-read_csv(inFile$datapath,na=c("", "NA",'-'))
})
tmp2<-reactive({
## modify the inputs
data_df <- tbl_df(tmp())
year<-(2017-as.numeric(input$Length)):2017
name_tmp<-as.vector(unlist(strsplit(input$Med_id,';')))
temp_data<-summarize(group_by(data_df,Corp),VValue=sum(value,na.rm = TRUE))
brands<-as.vector(arrange(temp_data,desc(VValue))$Corp[1:as.numeric(input$NoBrand)])
## filtering by the input
mod_data<-data_df %>%
select(Market,Corp,Med_type,Med_id,measure,date,value) %>%
filter(Market==input$TA,
Corp%in%brands,
Med_id%in%name_tmp,
Med_type==input$Med_type,
measure==input$Measure,
substr(date,1,4)%in%year
)
## Aggregation() & reformating
if(input$Period=="year"){
mod_data$date<-substr(mod_data$date,1,4)
mod_data<-group_by_if(mod_data,is.character)
mod_data<-summarise(mod_data,Value=sum(value,na.rm = TRUE))
} else {mod_data<-summarise(group_by_if(mod_data,is.character),Value=sum(value,na.rm=TRUE))}
})
## printing table
output$table<-DT::renderDataTable({tmp2()})
}
shinyApp(ui=ui,server = server)
The problem has been solved. The error actually comes from spread() function. When there is a empty data frame, spread() will call Error in enc2utf8: argument is not a character vector. So I add some conditional arguments to prevent the data frame from being empty once I run the shinyapp. Besides, isolate() is also a useful function for user to take in control of the execution of inputs.
Try print(input$measure) before you subset all the data, it is initialized as NULL. You should add:
if(is.null(input$measure))
measure = unique(data_df$measure)
else
measure = input$Measure
and modify
measure==input$Measure,
to
measure==measure
So when the use has made no selection, there will be effectively no filter on that column.
Working example
The following works fine for me. Note that I have created my own dataset 'df' and modified your tmp() reactive so it uses my df as input dataset in this example.
df = data.frame(Market=c("Asia","Asia","Europe","Europe"),
Corp=c("a","b","c","d"),
Med_type = c('Imported','Joint Venture','Local','Local'),
Med_id = c("Honda","Honda","Nissan","Nissan"),
measure=c('Unit','RMB','Dollar','Dollar'),
date = c('2017','2016','2017','2016'),
value=c(1,2,3,4 ))
library(shiny)
library(dplyr)
library(DT)
ui<-fluidPage(pageWithSidebar(
headerPanel('Table'),
sidebarPanel(
fileInput('file1', 'Upload Data',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
selectInput('TA',"Market-type",c('Asia','Europe')),
selectInput('Length',"Length",c('1 year'='0','2 years'='1','3 years'='2','4 years'='3','5 years'='4')),
selectInput('NoBrand',"Top Brand/Cor",c('one'='1','two'='2','three'='3','four'='4','five'='5')),
selectInput('Period',"Period",c('Quarter'='Quarter','YR'='year')),
checkboxGroupInput('Measure','Measurement',c('Unit','RMB','Dollar')),
selectInput('Med_type','Med_type',c('Imported','Joint Venture','Local')),
textInput('Med_id','Med_id',value='Honda;Nissan')),
mainPanel(
dataTableOutput('table')
)))
server<-function(input,output){
options(shiny.maxRequestSize=100*1024^2)
## importing dataset
tmp <- reactive({
df
})
tmp2<-reactive({
## modify the inputs
data_df <- tbl_df(tmp())
year<-(2017-as.numeric(input$Length)):2017
name_tmp<-as.vector(unlist(strsplit(input$Med_id,';')))
temp_data<<-summarize(group_by(data_df,Corp),VValue=sum(value,na.rm = TRUE))
brands<-as.vector(arrange(temp_data,desc(VValue))$Corp[1:as.numeric(input$NoBrand)])
if(is.null(input$measure))
measure = unique(data_df$measure)
else
measure = input$Measure
## filtering by the input
mod_data<-data_df %>%
select(Market,Corp,Med_type,Med_id,measure,date,value) %>%
filter(Market==input$TA,
Corp%in%brands,
Med_id%in%name_tmp,
Med_type==input$Med_type,
measure==measure,
substr(date,1,4) %in% year
)
print(mod_data)
## Aggregation() & reformating
if(input$Period=="year"){
mod_data$date<-substr(mod_data$date,1,4)
mod_data<-group_by_if(mod_data,is.character)
mod_data<-summarise(mod_data,Value=sum(value,na.rm = TRUE))
} else {mod_data<-summarise(group_by_if(mod_data,is.character),Value=sum(value,na.rm=TRUE))}
})
## printing table
output$table<-DT::renderDataTable({tmp2()})
}
shinyApp(ui=ui,server = server)
I'm building a dashboard with a bar graph that displays the average score in a certain skill or group of skills. The data needs to be filtered by several characteristics chosen in selectInput menus, as in this example (http://shiny.rstudio.com/gallery/movie-explorer.html).
Since the menu options are slightly different from the levels of the variable, I'm using the answer to this question as a guide (Filtering from selectInput in R shiny). Using the code below, I get the error in the title: "Error in UseMethod: no applicable method for 'format_vec_csv' applied to an object of class "logical"."
It's a class issue, which seems to be backed up by the one Google result I found for this error (https://github.com/rstudio/ggvis/issues/303). I'm not sure how to go about fixing it.
Ultimately, I'd also like to have the option of presenting choices different from the levels in the data. Found this discussion (Setting shiny selectInput from data.frame) but haven't been able to implement it.
Fake data:
library(dplyr)
SurvDoer <- c(rep("self", 4), rep("coach", 4), rep("mentor", 4))
Competency <- c(rep("vision", 6), rep("goals", 6))
Score <- rep(c(2,3,4,5), 3)
fake<-data_frame(SurvDoer, Competency, Score)
Code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("choose_source")
),
mainPanel(
ggvisOutput("avg_bar")
)
)
)
server <- function(input, output, session) {
#Data
db <- reactive ({
fake <- fake %>%
group_by(Competency) %>%
summarise_(avg = interp(~ mean(x, na.rm=TRUE), x=as.name("Score")))
data.frame(fake)
})
#Render selectInput
output$choose_source <- renderUI({
sourceOpts <- as.vector(unique(db()$SurvDoer))
selectInput("source", "Survey Respondent", choices=sourceOpts, multiple=TRUE)
})
dataset <- reactive({
subset(db(), SurvDoer %in% input$source)
})
vis <- reactive({
dataset %>%
ggvis(~Competency, ~avg) %>%
layer_bars()
})
vis %>% bind_shiny("avg_bar")
}
shinyApp(ui, server)