After I fixed the rendering problem of {gtsummary} with your help: How to use {gtsummary} package in r shiny app !thanks to stefan again,
I try to construct reactivity in my app.
After construction of the summary table with {gtsummary} I would like to pass the y variable from a select input field to change the summary table.
I get this error: no applicable method for 'as_factor' applied to an object of class "c('double', 'numeric')"
That exceeds my limits. Can someone please help?
My Code:
library(shiny)
library(gtsummary)
library(gt)
# make dataset with a few variables to summarize
iris2 <- iris %>% select(Sepal.Length, Sepal.Width, Species)
# summarize the data with our package
table1 <- tbl_summary(iris2) %>% as_gt()
table1
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = names(iris2),
selected = "Sepal.Length"),
gt_output('table')
)
)
),
server = function(input, output) {
varY <- reactive({input$y})
output$table <- render_gt({
table1 <- tbl_summary(iris2[, varY()]) %>% as_gt()
})
})
The issue is that tbl_summary expects a dataframe as its first argument, while your are passing a numeric vector iris2[, varY()]. If I got you right you want to select column varY() which could be achieved by:
table1 <- tbl_summary(select(iris2, all_of(varY()))) %>% as_gt()
I have been trying to create a general function to use in Shiny apps that will allow a dataframe to be filtered by an arbitrary list of conditions using a sidebar menu. So you can use the sidebar menu to pick both the columns you want to filter on and the conditions you wish to filter by.
Here is a trimmed down reproducible example of the Rmd that I have created which currently works for my purposes, using the mtcars dataset:
https://github.com/keithmcnulty/flexfiltering/blob/master/index.Rmd
Refer to my functions filter1_by, filter2_by, etc, built using dplyr::filter_at because I have to treat the column names differently from the values in non-standard evaluation. This has forced me to have to create several functions depending on how many filters I want. For example:
filter2_by <- function(df, f1, fv1, f2, fv2) {
filter_f1 <- quo(f1)
filter_f2 <- quo(f2)
df %>%
dplyr::filter_at(vars(!!filter_f1), all_vars(. == fv1)) %>%
dplyr::filter_at(vars(!!filter_f2), all_vars(. == fv2))
}
What I really want to do is just create a single function filter_by(df, ...) which will accept an arbitrary set of filter conditions, for example:
filter_by(mtcars, input$filter1 == input$filter1val,
input$filter2 == input$filter2val)
Would love any advice on how to code filter_by.
Thanks!
dplyr is not the only option to achieve your goal. With a simple Google search, it is possible to find many distinct ways to filter a data frame in R . In fact, the key to solving your problem here is the knowledge of the Shiny framework (i.e. return types, reactivity, etc) as you need to adapt any filtering method to your needs in the context.
Below is a concise Shiny example that includes everything you want. In addition to the filtering issue you stated, your code was very complicated. updateSelectInput will be your friend.
library(shiny)
library(kableExtra)
ui <- fluidPage(
selectInput(
inputId = "column",
label = "Choose a column",
choices = names(mtcars),
selected = "mpg"
),
selectInput(
inputId = "value",
label = "Filter by:",
choices = sort(mtcars$mpg),
multiple = T
),
htmlOutput(
outputId = "table"
)
)
server <- function(input, output, session) {
observeEvent(input$column, {
updateSelectInput(
session = session,
inputId = "value",
choices = sort(mtcars[[input$column]]),
selected = sort(mtcars[[input$column]])[1]
)
})
output$table <- renderText({
if(length(input$value) != 0) {
kable(
mtcars[mtcars[[input$column]] %in% as.numeric(input$value), ]
## just chain any additional conditions using &:
# mtcars[
# mtcars[[input$column]] %in% as.numeric(input$value) &
# mtcars[[input$column2]] %in% as.numeric(input$value2) &
# mtcars[[input$column3]] %in% as.numeric(input$value3)
# , ]
)
}
})
}
shinyApp(ui = ui, server = server)
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 am trying to use Rhandsontable in a Shiny app to make a 8x12 table that will be used as input matched to a 97 column dataframe. Each cell in the table corresponds to 1 column in the dataframe (-1 for the x-axis).
This is my current code for testing:
server <- function(input, output) {
mat = matrix(, nrow=8, ncol=12, dimnames= list(LETTERS[1:8],1:12))
output$table = renderRHandsontable({
rhandsontable(mat, readOnly = T, selectCallback = T) %>%
hot_cols(colWidths=22) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
output$selected=renderPrint({
cat('Selected Row:',input$table_select$select$r)
cat('\nSelected Column:',input$table_select$select$c)
cat('\nSelected Cell Value:',input$table_select$data[[input$table_select$select$r]][[input$table_select$select$c]])
cat('\nSelected Range: R',input$table_select$select$r,'C',input$table_select$select$c,':R',input$table_select$select$r2,'C',input$table_select$select$c2,sep="")
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=5,
rHandsontableOutput("table"),
verbatimTextOutput("selected")
),
mainPanel(
)
)
)
shinyApp(ui,server)
This works great for shift-click based multiple selection, selection of whole rows, whole columns, and single cells. However, I need to be able to select also in the standard cntrl+click way to select discontinuous blocks of cells. Is this not feasible in rhandsontable package? I can't find any documentation on it, nor can I find anything else on SO. Help or recommendations on what packages/tools can accomplish this would be greatly appreciated.
I use
output$hot <- renderRHandsontable(rhandsontable(DF))
to get a table.
All works fine but I would like to allow the user to select certain columns only (implemented with shiny::updateSelectizeInput()). the data should then be updated in the full data table and not only in the columns selected. I googled but could only find a very bad description in java. Can someone help me out with this?
as requested an example:
DF = data.frame(matrix(rnorm(20), nrow=10))
rhandsontable(DF)
This is a few years late, and I will note that I don't think this will completely solve the issue as it doesn't use "updateSelectizeinput()" as requested by the OP, plus I must not be handling the select input correctly as one column always shows, but for anyone looking for a start, here is an example:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
selectInput("Select", "Select", names(mtcars), multiple = T, selected = names(mtcars)),
rHandsontableOutput("cars")
)
server <- function(input, output, session) {
DF<-reactiveValues(DF = mtcars, Select = NULL)
observeEvent(input$Select,{
DF$Select <- input$Select
})
output$cars<-renderRHandsontable({
rhandsontable(DF$DF, rowHeaders = NULL)%>%
hot_cols(colWidths = ifelse(names(DF$DF) %in% DF$Select == T, 150, 0.1))
})
}
shinyApp(ui, server)
It uses 0.1 as a column width to effectively hide the column, leaving the original data frame in tact.