I am making a shiny app, and in the app one feature is to output text that is generated as a list of character strings.
For example, one function outputs a list of text, for example
("a", "b", "c", "d")
When I render this text, it outputs it as such
a b c d
Instead I would like the text to be rendered so that there is a line in between each value of the list, so instead it would look like
a
b
c
d
How can I accomplish this?
You could try:
library(shiny)
ui <- fluidPage(
htmlOutput("mytext")
)
server <- function(input, output, session) {
output$mytext <- renderUI({
mylist <- c("a", "b", "c", "d")
HTML(paste(mylist, sep = "", collapse = '<br/>'))
})
}
shinyApp(ui, server)
Adding to #AndS. answer, another option would be using renderText() with htmlOutput(), and then simply paste(mylist, collapse = "<br>")
Related
So I have a complex shiny app with some internal default data. I added the possibility to update these internal data with new files (uploaded with fileInput()). I want that only after I click on a button, the default data and the new data merge together. I find this solution (just add any file in fileInput() to make it works).
library(shiny)
ui <- fluidPage(
fluidRow(
column(3, fileInput("fileupaziendedata", "Carica il file csv")), #just load any file
column(3, actionButton("mergeaziende", "Unisci"))), #the button that merges
hr(),
dataTableOutput("summary_table")
)
server <- function(input,output){
data = reactive({
data.frame(id = c(1:5), lett = c("A", "B", "C", "D", "E"))
})
datafromfile = reactive({
data.frame(id = c(6,7), lett = c("F", "G"))
})
data2 = reactive({
if(!is.null(input$fileupaziendedata) && input$mergeaziende > 0){
rbind(data(), datafromfile())
}else{
data()
}
})
output$summary_table <- renderDataTable({
data2()
})
}
shinyApp(ui=ui, server=server)
Now my problem is that since I used input$mergeaziende > 0 condition, after the first button press, it will be always greater than 0. Is there a way to prevent this?
I've seen this type of question come up before. Basically, how to "reset" the action button value. Here's my general solution. I reset a reactiveVal instead of trying to manipulate the input. Here the input will reset after 5, but it can be changed to something else (like when your data reactive triggers):
library(shiny)
ui <- fluidPage(
actionButton('click' ,'Click'),
textOutput('counter_out')
)
server <- function(session, input, output){
# initialize at - 0
# this is the value to observe (not input$click)
counter <- reactiveVal(0)
output$counter_out <- renderText(counter())
#increment per click
observeEvent(input$click, counter(counter() + 1))
observe({
#WHEN you want the count reset
if(counter() > 5) counter(0)
})
}
shinyApp(ui, server)
I'm writing an app that will help wrangle data files into standard formats to feed reusable dashboards. Part of this effort involves creating a user interface to make it easy for users to map the random column names they have in their input files to the "standard" column names that the dashboard is going to expect.
I actually got this code working nicely. But the app needs to do this same mapping exercise for several different input files (each with their own set of standard column names), so it seemed like a good candidate to modularize!
Here's the workflow:
The user loads a "mapping input" file. If they've done this mapping
exercise before, I want to use this file to pre-populate the
drop-downs. I'm also pulling the list of standard column names from
this table. Each standard column name gets an associated drop down.
They load their file to be wrangled - the one with the wackly column
names. The column names in this file will become the options in the
drop-downs.
As the user starts mapping their column names to the different
standard name drop downs, their selections will disappear from the
other drop-down lists. This makes it easier to map columns in files
with many columns.
I feel like I am so close. The issue is when the module runs updateSelectInput. I'm using updateSelectInput to remove options from the drop-downs that have already been used. This works, but it clears out the pre-populated values that were set in the renderUI function.
Here's the code with the pre-populated values working (having removed the problematic updateSelectInput):
# Load libraries and options ----------------------------------------------
library(shiny)
library(dplyr)
library(tidyr)
options(stringsAsFactors = FALSE)
# Modules -----------------------------------------------------------------
input_ui <- function(id, row_label, file_description) {
ns <- NS(id)
fluidRow(
uiOutput(ns("colmapping")) # References the dynamic dropdowns created by the server module.
)
}
# Creates dynamic dropdowns which ultimately will be used to rename columns from a number of different files.
input_server <- function(input, output, session, parent) {
# Create a fake file with misnamed columns that need remapped.
input_file <- reactive({
return(data.frame(Account.Number = 1:2,
Account.Name = c("Account 1", "Account 2"),
Quota.2018 = c(1000, 2000)))
})
# Get a list of what the columns SHOULD be named. These will also do double-duty as the labels for our dropdown inputs.
standard_columns <- reactive({
c("AccountId", "AccountName", "SalesGoal")
})
# Get the actual column names from the file with misnamed columns.
actual_columns <- reactive({
colnames(input_file())
})
# A separate input can be loaded that documents how the misnamed columns have been mapped to the correct names in the past.
# We want to pre-populate the dropdowns with these selections.
quickstart_columns <- reactive({
c("Account.Number", "Account.Name", "Quota")
})
# Create a drop-down selectInput for each of the "standard" column names, allowing the user to choose from the column names in their own misnamed file.
output$colmapping <- renderUI({
ns <- session$ns
dropdowns = tagList()
for (i in seq_len(length(standard_columns()))) { # For i in 1:number of standard names associated with this table
dropdowns[[i]] = selectInput(ns(paste0("input_", standard_columns()[i])), # Use the standard name value for the input object name
label = paste0(standard_columns()[i]), # And for the UI label
choices = actual_columns(),
selected = quickstart_columns()[i],
multiple = FALSE) #Use choices from loaded input table
}
return(dropdowns)
})
}
# UI ----------------------------------------------------------------------
ui <- fluidPage(
input_ui("acct_info")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
acct_info_mod_results <- callModule(input_server,
"acct_info",
parent = session)
}
shinyApp(ui = ui, server = server)
And here's the same code with updateSelectInput turned on (so selected-elsewhere options drop from the choices), but where the pre-populated values don't show up.
# Load libraries and options ----------------------------------------------
library(shiny)
library(dplyr)
library(tidyr)
options(stringsAsFactors = FALSE)
# Modules -----------------------------------------------------------------
input_ui <- function(id, row_label, file_description) {
ns <- NS(id)
fluidRow(
uiOutput(ns("colmapping")) # References the dynamic dropdowns created by the server module.
)
}
# Creates dynamic dropdowns which ultimately will be used to rename columns from a number of different files.
input_server <- function(input, output, session, parent) {
# Create a fake file with misnamed columns that need remapped.
input_file <- reactive({
return(data.frame(Account.Number = 1:2,
Account.Name = c("Account 1", "Account 2"),
Quota.2018 = c(1000, 2000)))
})
# Get a list of what the columns SHOULD be named. These will also do double-duty as the labels for our dropdown inputs.
standard_columns <- reactive({
c("AccountId", "AccountName", "SalesGoal")
})
# Get the actual column names from the file with misnamed columns.
actual_columns <- reactive({
colnames(input_file())
})
# A separate input can be loaded that documents how the misnamed columns have been mapped to the correct names in the past.
# We want to pre-populate the dropdowns with these selections.
quickstart_columns <- reactive({
c("Account.Number", "Account.Name", "Quota")
})
# Create a drop-down selectInput for each of the "standard" column names, allowing the user to choose from the column names in their own misnamed file.
output$colmapping <- renderUI({
ns <- session$ns
dropdowns = tagList()
for (i in seq_len(length(standard_columns()))) { # For i in 1:number of standard names associated with this table
dropdowns[[i]] = selectInput(ns(paste0("input_", standard_columns()[i])), # Use the standard name value for the input object name
label = paste0(standard_columns()[i]), # And for the UI label
choices = actual_columns(),
selected = quickstart_columns()[i],
multiple = FALSE) #Use choices from loaded input table
}
return(dropdowns)
})
# This is the chunk of code giving me trouble!
# For some of these files, there's like 20-some columns that will need renamed. That's a lot of scanning through long dropdown lists.
# As the user starts to map some of the columns, I want their selections to disappear from the other drop downs.
# The good news is, this works!
# The bad news is, it also clears out the pre-populated inputs. How can I keep the pre-populated inputs from disappearing when I apply updateSelectInput?
observe({
ns <- session$ns
n <- isolate(length(standard_columns()))
for (i in seq_len(n)) {
already_selected <- unlist(lapply((1:n)[-i], function(i)
input[[ paste0("input_",standard_columns()[i]) ]]))
print(i)
selected_i <- input[[ paste0("input_", standard_columns()[i]) ]]
print(selected_i) # For debugging. These return empty values until selections are made, but I never had the problem with analogous code until I tried to put it in the module.
updateSelectInput(session = parent,
ns(paste0("input_",standard_columns()[i])),
choices = append(c("Empty"),setdiff(actual_columns(), already_selected)),
selected = input[[ paste0("input_", standard_columns()[i]) ]]
)
}
})
}
# UI ----------------------------------------------------------------------
ui <- fluidPage(
input_ui("acct_info")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
acct_info_mod_results <- callModule(input_server,
"acct_info",
parent = session)
}
shinyApp(ui = ui, server = server)
This is the first time I've gotten so totally stuck on a project!! I hugely appreciate any insight or suggestions!
EDIT: After much pain, I've figured out how to get a list of session inputs that I can loop through to create the updateSelectInput in the parent session. I've also figured out how to put it into a function in the main session. Here's a minimal example of the working fix, but I'm all ears if anyone has a smarter way to solve the problem!
# Load libraries and options ----------------------------------------------
library(shiny)
library(dplyr)
options(stringsAsFactors = FALSE)
updateDropDowns <- function(session, all_inputs) {
inputs <- setdiff(all_inputs$names, all_inputs$names %>% str_subset(pattern="selectize"))
selected <- unname(unlist(all_inputs %>% filter(names %in% inputs) %>% select(selected)))
values <- c("a", "b", "c", "d")
n <- length(inputs)
for (i in seq_len(n)) {
already_selected <- unlist(lapply((1:n)[-i], function(i)
selected[i]))
updateSelectInput(session,
inputs[i],
choices = setdiff(values, already_selected),
selected = selected[i])
}
}
# UI ----------------------------------------------------------------------
ui <- fluidPage(
uiOutput("colmapping")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
output$colmapping <- renderUI({
dropdowns = tagList()
for (i in 1:3) {
dropdowns[[i]] = selectInput(paste0("input_",i),
label = paste0("input_",i),
choices = c("a", "b", "c", "d"),
selected = NULL,
multiple = FALSE)
}
return(dropdowns)
})
all_inputs <- reactive({ # get a dataframe of input names and values, else return an empty df
x <- reactiveValuesToList(input)
y <- data.frame(
names = names(x),
selected = unlist(x, use.names = FALSE)
)
empty <- as.data.frame(setNames(rbind(data.frame(matrix(ncol = 2, nrow = 1)),
c(rep("999",2))),
c("names", "selected")))
if(nrow(y) == 0) {empty} else {y}
})
observe({
updateDropDowns(session, all_inputs())
})
}
shinyApp(ui = ui, server = server)
I have a Shiny app that allows users to view polygon (chloropleth) maps in in leaflet. I would like to enable users to also download a csv of the data that is used in the map for variables that they have selected.
I have been able to use downloadHandler to download either a single variable or all of the data. I have not been able to download multiple selected variables. At present, when I use selectInput(multiple=TRUE) I receive an error.
I have searched online, and found that many people were having issues with filter by values within a variable but I wasn't able to find something of filtering a dataframe by multiple variables.
Here's a mre for my work (I've stripped out all of the leaflet code as it isn't really relevant here as that aspect is working well).
global.R
library(dplyr)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
a <- c(1:10)
b <- c(21:30)
c <- runif(10)
data <- data.frame(a, b, c)
ui.R
ui = fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("download", "Download",
choices = c("A nice name for variable a",
"A nice name for variable b",
"A nice name for variable c"),
multiple = F),
downloadButton("downloadData", "Download selected variables")
),
mainPanel(
tableOutput("mytable")
)
)
)
server.R
server <- (function(input, output, session) {
decision <- reactive({
switch(input$download,
"A nice name for variable a"= data$a,
"A nice name for variable b" = data$b,
"A nice name for variable c" = data$c
)
})
#Create download function for selected data
output$downloadData <- downloadHandler(
filename = function() {paste("SelectedVariables", ".csv", sep = "")
},
content = function(file) {write.table(decision(), file, sep=",")
}
)
})
If I attempt to choose more than one variable I receive the following error:
Listening on http://127.0.0.1:7180
Warning: Error in switch: EXPR must be a length 1 vector
[No stack trace available]
I suspect it is the use of switch on the server side, but I wasn't sure what to use instead.
Any advice would be most welcome.
Instead of switch I would recommend you to use named choices in your selectInput. Then you could get it working as in the example below. Note that this might need some error handling (e.g. no columns selected). Hope this helps!
library(shiny)
library(dplyr)
a <- c(1:10)
b <- c(21:30)
c <- runif(10)
data <- data.frame(a, b, c)
ui <- sidebarLayout(
sidebarPanel(
selectInput("download", "Download",
choices = c("A nice name for variable a" = "a",
"A nice name for variable b" = "b",
"A nice name for variable c" = "c"),
multiple = T),
downloadButton("downloadData", "Download selected variables")
),
mainPanel(
tableOutput("mytable")
)
)
server <- (function(input, output, session) {
decision <- reactive({
data[,input$download,drop=FALSE]
})
#Create download function for selected data
output$downloadData <- downloadHandler(
filename = function() {paste("SelectedVariables", ".csv", sep = "")},
content = function(file) {write.table(decision(), file, sep=",")
}
)
})
shinyApp(ui,server)
I am trying to return a character vector created in a reactive expression in Shiny. However, when I run the app, I get the following:
Error: could not find function "check_case"
check_case is a reactive expression, not a function.
I can see a number of questions from people with similar issues, but the answers don't seem to fit this (for e.g., missing parentheses when calling reactive expression; calling something that hasn't been returned in the reactive expression).
I've tried immediately translating check_case() into a character vector in the output before using paste. I have also tried adding more arguments to paste so it includes sep = and collapse =, in case this is part of the issue, but this doesn't change the result I'm getting.
I currently have two theories:
There is an issue in the way I am using a reactive expression to return a character vector. Normally I use them to return dataframes so there might be something I'm missing here.
There is an issue in the way I am using paste to refer to a character vector.
Code:
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
selectInput(
"case_select", label = "Select case",
choices = c("Upper", "Lower")
)
)
body <- dashboardBody(
fluidRow(
htmlOutput("text"))
)
ui <- dashboardPage(dashboardHeader(title = "Example"),
sidebar,
body
)
server <- function(input, output) {
output$check_case <- reactive({
if (input$case_select == "Upper") {
case_list <- c("A", "B", "C")
} else {
case_list <- c("a", "b", "c")
}
return(case_list)
})
output$text <- renderUI({
check_case <- check_case()
HTML(paste(check_case, sep = "", collapse = ""))
})
}
The issue is regarding the fact you are trying to output a reactive variable while also creating it. It is also important to note that you need to output to an existing UI element when rendering.
This can simply be solved by creating the reactive varaible, and then subsequently rendering it with renderUI as you are doing with ouput$text
server <- function(input, output) {
check_case <- reactive({
if (input$case_select == "Upper") {
case_list <- c("A", "B", "C")
} else {
case_list <- c("a", "b", "c")
}
return(case_list)
})
output$text <- renderUI({
check_case <- check_case()
HTML(paste(check_case, sep = "", collapse = ""))
})
}
Just a simple error
I am trying to figure out how to write a .csv based on selections made by the end user. The selections made will subset the "geodata.csv" and write a separate "solution.csv" file in the application folder.
N.B. - I have created a github repo to make solving the question easier. It contains the geodata.csv, ui.R & server.R but no solution.csv yet!
geodata.csv
Postcode,HC,BSL,Position Location
10,1,A,C
10,1,A,D
10,1,A,D
11,1,B,C
11,1,B,C
ui.R
shinyUI(
pageWithSidebar(
headerPanel('Min. working example - write a csv based on user input'),
sidebarPanel(
selectInput("filter1", "First selection:"
, choices = c(Choose='', "A", "B")
#, multiple=T
),
selectInput("filter2", "Second selection:",
choices = c(Choose='', "C", "D")
),
br(),
p("Include actionButton to prevent write occuring before user finalises selection"),
actionButton("generateButton","Write Data")
),
mainPanel()
)
)
server.R
# Load data
setwd("/Users/lukesingham/SOtestApp")
geodata <- read.csv("geodata.csv", na.string = "#N/A", row.names=NULL)
# Reactivity to subset data ####
shinyServer(function(input, output) {
geodatasetInput <- reactive({
# BSL switch
selection <-switch(input$BSL
, A = "A"
, B = "B"
)
# Location switch
selection2 <-switch(input$Location
, C = "C"
, D = "D"
)
# subset based on selection
Subgeodata <- subset(geodata, BSL == selection & Position.Location == selection2)
# Execute selections on data upon button-press
input$generateButton
# aggregate by postcode
Subgeodata <- Subgeodata[1:2] #no longer need other columns
AggSubGdata <- aggregate(. ~ Postcode, data=Subgeodata, FUN=sum)
isolate(write.csv(AggSubGdata
, file = "/Users/lukesingham/SOtestApp/solution.csv"
, row.names=F
))
})
})
solution.csv
For example, based on user selections of A and D the solution file should look like this:
Postcode,HC
10,2
Here is the working example:
# Load data
setwd("/Users/lukesingham/SOtestApp")
geodata <- read.csv("geodata.csv", na.string = "#N/A", row.names=NULL)
# Reactivity to subset data ####
shinyServer(function(input, output) {
geodatasetInput <- observe({
# Execute selections on data upon button-press
if(input$generateButton == 0) return()
inp.BSL <- isolate(input$filter1)
inp.loc <- isolate(input$filter2)
if (inp.BSL=='' | inp.loc=='') return()
# BSL switch
selection <-switch(inp.BSL
, A = "A"
, B = "B"
)
# Location switch
selection2 <-switch(inp.loc
, C = "C"
, D = "D"
)
# subset based on selection
Subgeodata <- subset(geodata, BSL == selection & Position.Location == selection2)
# browser()
# aggregate by postcode
Subgeodata <- Subgeodata[1:2] #no longer need other columns
AggSubGdata <- aggregate(. ~ Postcode, data=Subgeodata, FUN=sum)
write.csv(AggSubGdata
, file = "solution.csv"
, row.names=F
)
})
})
and a short analysis of your code:
The main reason geodatasetInput does not start at all is because it is a reactive() expression. reactive() is evaluated only when it is called by something else like renderTable() in the answer of #pops. If you want it to be executed by itself, it should be observe().
It might be a good idea to have input$generateButton in the beginning of your observe() expression.
In ui.R, you call a numeric input field filter1, but you try to obtain its value as input$BSL from server.R; the same is true for filter2.
As you want geodataSetInput to be triggered only on generateButton, all other input$ and reactive expressions withing geodataSetInput should be isolated with isolate(). On the other hand, there is no need to isolate write.csv because this particular function call does not involve any 'dynamic' parameters.
you would need to Render your the table you're subsetting, perhaps someone else can explain why you need this co-dependance. Below is the working example of the way I went to solve it. It will save the solution.csv in the working directory.
rm(list = ls())
library(shiny)
# You can change this directory
setwd("/Users/lukesingham/SOtestApp")
geodata <- read.csv("geodata.csv", header = TRUE, sep = ",",stringsAsFactors =FALSE)
ui = pageWithSidebar(
headerPanel('Min. working example - write a csv based on user input'),
sidebarPanel(
selectInput("filter1", "First selection:", choices = c("A", "B"),selected = "A"),
selectInput("filter2", "Second selection:", choices = c("C", "D"),selected = "C"),
br(),
p("Include actionButton to prevent write occuring before user finalises selection"),
actionButton("generateButton","Write Data")),mainPanel(tableOutput("test1"))
)
server = function(input, output) {
geodatasetInput <- reactive({
if(input$generateButton == 0){return()}
isolate({
input$generateButton
test_data <- geodata[geodata$BSL %in% as.character(input$filter1),]
test_data <- geodata[geodata$Position.Location %in% as.character(input$filter2),]
test_data <- test_data[,1:2]
test_data <- aggregate(. ~ Postcode, data=test_data, FUN=sum)
test_data
})
write.csv(test_data,"solution.csv",row.names=F)
})
output$test1 <- renderTable({geodatasetInput()})
}
runApp(list(ui = ui, server = server))