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.
Related
I have create one app that contains a textInput and a selectizeInput. Depending on the user's input and if the input can be found in one dataset, you will see all the possibilities according to that textInput in the selectizeInput.
In this way, if the user introduces a word that it is not in the dataset, the selectizeInput can't display any choice.
Everything works fine, but I found one problem. If the user starts writing a correct word, the user gets a dropdown list... and then, if the input is removed... the dropdown list is still there (the choices from selectizeInput are still there).
Here the code:
library(shiny)
library(dplyr)
library(stringr)
ui <- fluidPage(
textInput("my_input", "Introduce a word"),
selectizeInput(inputId = "dropdown_list", label = "Choose the variable:", choices=character(0)),
)
server <- function(input, output, session) {
my_list <- reactive({
req(input$my_input)
data <- as.data.frame(storms)
res <- subset(data, (grepl(pattern = str_to_sentence(input$my_input), data$name))) %>%
dplyr::select(name)
res <- as.factor(res$name)
return(res)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$my_input, {
updateSelectizeInput(
session = session,
inputId = "dropdown_list",
choices = my_list(), options=list(maxOptions = length(my_list())),
server = TRUE
)
})
}
shinyApp(ui, server)
Do you know how can I remove the choices from the selectizeInput if the user deletes the input?
Thanks very much in advance
Regards
The issue is the req(input$myinput). Hence, if the user deletes the input my_list() does not get updated. Instead of req you could use an if to check whether the input is equal to an empty string:
my_list <- reactive({
if (!input$my_input == "") {
data <- as.data.frame(storms)
res <- subset(data, grepl(pattern = str_to_sentence(input$my_input), data$name), name)
res <- as.factor(res$name)
return(res)
}
})
I'm trying to create a dashboard using shiny in R, but I'm facing some little problems
I have:
db is my data.frame with:
db$domain:chr,
db$date:chr,
db$value:num.
So I've created:
db_4 <- reactive({ subset(db,db$domain %in% input$domain &
db$date<=input$daterange[2] & db$date>=input$daterange[1]})
the inputs are:
input$domain: selectinput with multiple choices,
input$date: daterangeinput.
I'm trying to create a table that gives me the sum of the db$value, aggregated by db$date. I've tried something like:
output$table2 <- rendertable ({aggregate(db_4()["value"], by=list(db_4()["date"]), sum) })
but I get always an empty table.
Can anybody help me in solving this little issue?
Thx a lot
I would highly recommend you to read this article about debugging.
In Shiny you can use the browser() function within both reactive and render functions. It should help you locate the problem (i.e.: data has the expected structure)
It seems the problem is with the aggregate function: db_4()["date"] returns a data.frame, where you need a vector.
Solution:
library(shiny)
db <- data.frame(
domain = letters[1:3],
date = seq(
from = as.Date("2019-01-01"),
to = as.Date("2019-06-01"),
by = "1 months"
),
value = runif(12)
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("domain", "Domain", choices = unique(db$domain)),
dateRangeInput("daterange", "Date",
min = min(db$date), max = max(db$date),
start = min(db$date), end = max(db$date))
),
mainPanel(
tableOutput("table2")
)
)
)
server <- function(input, output, session) {
db_4 <- reactive( {
subset(db,
db$domain %in% input$domain &
db$date<=input$daterange[2] &
db$date>=input$daterange[1]
)
})
output$table2 <- renderTable( {
req(db_4()) # Don't render table when db_4() is NULL
# Uncomment next line to check if everything goes as expected
#browser()
aggregate(
data.frame(value = db_4()$value),
by=list(date = as.factor(db_4()$date)),
sum
)
})
}
shinyApp(ui, server)
Also I would highly recommend sharing the code of your minimal example including some dummy data, so that it can be copy-pasted in an instant. It would increase the chances of someone answering.
A common scenario for many of my shiny apps is that there is a large list of potentially interesting filter variables (often 10 to 20), but I want to avoid confusing the user with too many input widgets.
Therefore, my strategy is usually as follows:
1. Users may select filter variables. 2. If at least one filter variable is selected, a renderUI is triggered, which contains one input widget per selected variable. 3. The filter criteria are applied to the data and some output is generated.
The problem is that any change in step one (by adding or deleting a filter variable) eliminates all previously made choices from step two. This means that all input widgets are unintentionally reset to their default values. This prevents a smooth user experience. Any idea how to improve on this?
Here you can see what happens:
And here is the code to reproduce this behaviour:
library("shiny")
library("dplyr")
library("nycflights13")
df <- flights
filtervarsChoices <- c("origin","carrier")
originChoices <- unique(df$origin)
carrierChoices <- unique(df$carrier)
ui <- fluidPage(
h3("1. Select Filter variables"),
selectInput("filterVars", "Filter variables", filtervarsChoices, multiple = TRUE),
uiOutput("filterConditions"),
h3("Result"),
tableOutput("average")
)
server <- function(input, output, session) {
output$filterConditions <- renderUI({
req(input$filterVars)
tagList(
h3("2. Select Filter values"),
if ("origin" %in% input$filterVars) {
selectInput("originFilter", "Origin", originChoices, multiple = TRUE)
},
if ("carrier" %in% input$filterVars) {
selectInput("carrierFilter", "Carrier", carrierChoices, multiple = TRUE)
}
)
})
output$average <- renderTable({
if ("origin" %in% input$filterVars) {
df <- df %>% filter(origin %in% input$originFilter)
}
if ("carrier" %in% input$filterVars) {
df <- df %>% filter(carrier %in% input$carrierFilter)
}
df %>%
summarise(
"Number of flights" = n(),
"Average delay" = mean(arr_delay, na.rm = TRUE)
)
})
}
shinyApp(ui = ui, server = server)
The problem is that you render the UI element every time it is selected, and thus its selected choices are reset. We can solve this by only rendering the elements a single time, and showing or hiding them when applicable. We can do this with the show and hide functions from the shinyjs package, and by wrapping div's around the selectInputs as we create them. So each filter x gets a corresponding input called xFilter and a div wrapped around it called div_x.
Below is a working example. I have tried to make the code as general as possible, so that you would only have to supply additional elements in filtervarsChoices and in choices_list to extend with additional filters. I also modified the table that is outputted to show that the filters are working correctly.
Note that in the example below, hidden filters are still applied to the resulting data.frame. In order to only apply visible filters, the for loop should run over input$filterVars as shown by Till n the comments below.
I hope this helps!
library("shiny")
library("dplyr")
library("nycflights13")
library(shinyjs)
df <- flights
filtervarsChoices <- c("origin","carrier")
originChoices <- unique(df$origin)
carrierChoices <- unique(df$carrier)
# Create a list with the choices for the selectInputs.
# So the selectInput for 'origin', will get the choices defined in originChoices.
choices_list <- list('origin' = originChoices,
'carrier' = carrierChoices)
ui <- fluidPage(
column(width=3,
h3("1. Select Filter variables"),
selectInput("filterVars", "Filter variables", filtervarsChoices, multiple = TRUE),
uiOutput("filterConditions"),
h3("Result"),
tableOutput("average"),
useShinyjs()
),
column(width=3,
h3("Applied filters"),
htmlOutput('appliedfilters')
)
)
server <- function(input, output, session) {
# Render all selectInput elements.
output$filterConditions <- renderUI({
lapply(filtervarsChoices, function(x){
shinyjs::hidden(div(id=paste0('div_',x),
selectInput(paste0(x,"Filter"), x, choices_list[[x]], multiple = TRUE)
))})
})
# Show all divs that are selected, hide all divs that are not selected.
observeEvent(input$filterVars, ignoreNULL = F,
{
to_hide = setdiff(filtervarsChoices,input$filterVars)
for(x in to_hide)
{
shinyjs::hide(paste0('div_',x))
}
to_show = input$filterVars
for(x in to_show)
{
shinyjs::show(paste0('div_',x))
}
})
output$appliedfilters <- renderText({
applied_filters <- c()
for(x in filtervarsChoices) # for(x in input$filterVars)
{
if(!is.null(input[[paste0(x,'Filter')]]))
{
applied_filters[length(applied_filters)+1] = paste0(x,': ', paste(input[[paste0(x,'Filter')]],collapse=", "))
}
}
paste(applied_filters,collapse='<br>')
})
output$average <- renderTable({
# For all variables, filter if the input is not NULL.
# In the current implementation, all filters are applied, even if they are hidden again by the user.
# To make sure only visible filters are applied, make the loop run over input$filterVars instead of filterVarsChoices
for(x in filtervarsChoices) # for(x in input$filterVars)
{
if(!is.null(input[[paste0(x,'Filter')]]))
{
df <- df %>% filter(get(x) %in% input[[paste0(x,'Filter')]])
}
}
unique(df[,c('origin','carrier')])
})
}
shinyApp(ui = ui, server = server)
I have encountered this problem while developing an app, and reproduced it here in a simplified script using Fruits df.
Basically, i have selectInput box to select a Year, which is a column in Fruits. I create unique list of Years, and feed it into selectInput box.
Then, ideally, i wanted my plot to display only the records for the year I selected. However, as you'll see in my code - the second you uncomment a block of 3 lines to accomplish that, - the plot stops displaying even though there doesn't seem to be any errors. Anybody knows why is this? Thanks in advance!!!
Related question - while debugging this i saw that the input$explore_year is at first "Null". I'm trying to handle this in the code but not sure why the selected="2010" doesn't take care of it automatically.
library(shiny)
library(googleVis)
library(DT)
listOfFruits <- sort(unique(Fruits$Year), decreasing = FALSE)
ui <- fluidPage(title = "Fruits Bug Recreated",
fluidRow(
column(3,
wellPanel(
uiOutput("choose_year"),
br()
)),
column(9,
tags$hr(),
htmlOutput("view")
)),
fluidRow(DT::dataTableOutput("tableExplore"))
)
server <- function(input, output) {
output$view <- renderGvis({
#Uncomment these 3 lines to see how the plot stops displaying.
# local_exloreYear <- input$explore_year
# if (is.null(local_exloreYear)) {local_exloreYear <- "2010"}
# FruitsSubset <- subset(Fruits, Year == local_exloreYear)
#------------I wanted to use the commented line below instead of the
#that follows
#gvisBubbleChart(FruitsSubset, idvar="Fruit",
#-------------
gvisBubbleChart(Fruits, idvar="Fruit",
xvar="Sales", yvar="Expenses",
colorvar="Year", sizevar="Profit",
options=list(
hAxis='{minValue:70, maxValue:125, title:"Sales"}',sortBubblesBySize=TRUE,
vAxis='{title: "Expenses",minValue:60, maxValue:95}'
))
})
# Drop-down selection box for dynamic choice of minutes in the plans to compare
output$choose_year <- renderUI({
selectInput("explore_year", "Select Year", as.list(listOfFruits),selected ="2010")
})
output$tableExplore <- DT::renderDataTable(DT::datatable({
FruitsSubset <- subset(Fruits, Fruits$Year == input$explore_year)
myTable <-FruitsSubset[,c(1,2,3,4,5,6)]
data <- myTable
data
},options = list(searching = FALSE,paging = FALSE)
))
}
shinyApp(ui = ui, server = server)
Like i wrote in the comments you can solve it by make the rendering conditional on the input being non-NULL.
output$view <- renderGvis({
if(!is.null(input$explore_year)){
...
}
})
Nevertheless, I don´t think it is really intended that you have to do that, as in other render functions it is not required e.g. in the DT::renderDataTable(), where you also use the same input (being NULL initially).
Therefore, I would suggest reporting it as a bug.
I am trying to create numeric boxes for all column names in a data set. I have written below code but this displays a blank page. Not sure what the error is. Any suggestions?
library(shiny)
library(readr)
shinyApp(
ui <- fluidPage(
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- read.csv("Data/170210_Flat_File.csv")
output$TestColumns <- renderUI({
for(i in names(data_set)){
numericInput(i, i,30)
}}
)})
First off, when you ask questions you should ALWAYS post a minimal reproducible example. That is basically something that we can run to replicate the issue you are having so that it is much easier for us to help you. This way we don't have to go about using different data, trying to figure out exactly what your error is. See this link for a good intro: How to make a great R reproducible example?
Next to your question - since you didn't explicitly post an error you were seeing or explicitly state what your issue was I'm going to go ahead and assume that your issue is that you don't see any UI's popping up when you run your Shiny App (this is what I got when I tried running your code with different sample data).
The reason you aren't seeing anything is because you aren't returning any objects from your for loop. If you really wanted to do a for loop you would have to loop through, store everything in a list, then return that list. Note that I had to use R's built in data because you didn't provide any. Something like this would work:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
L<-vector("list",length(names(data_set)))
for(i in names(data_set)){
L[[i]]<-numericInput(i, i,30)
}
return(L)
})})
This should give you your desired result. However, the above is unnecessarily complicated. I suggest you use an lapply instead. Something like this is much better in my opinion:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
lapply(names(data_set),function(x){numericInput(x,x,30)})
})})
ui <- bootstrapPage(
fluidRow(
column(4,offset = 2,
tags$h4("numeric inputs"),
uiOutput('mtcars_numerics') # These will be all the numeric inputs for mtcars
),
column(6,
tags$h4("current input values"),
verbatimTextOutput('show_vals') # This will show the current value and id of the inputs
)
)
)
server <- function(input, output, session){
# creates the output UI elements in the loop
output$mtcars_numerics <- renderUI({
tagList(lapply(colnames(mtcars), function(i){ # must use `tagList` `
column(3,
numericInput(
inputId = sprintf("mt_col_%s",i), # Set the id to the column name
label = toupper(i), # Label is upper case of the col name
min = min(mtcars[[i]]), # min value is the minimum of the column
max = max(mtcars[[i]]), # max is the max of the column
value = mtcars[[i]][[1]] # first value set to the first row of the column
))
})
)
})
# So we can see the values and ids in the ui for testing
output$show_vals <- renderPrint({
all_inputs <- names(session$input)
input_vals <- plyr::ldply(all_inputs, function(i){
data.frame(input_name = i, input_value = input[[i]],stringsAsFactors = FALSE)
})
input_vals
})
}
shinyApp(ui, server)
Results in: