I'm working on an R Shiny App that plots monthly percent changes in political party registrations. I'm still pretty new to interactive web apps (and Stack Overflow), and just haven't been able to find answers to these quesions -- thanks/sorry in advance.
In an older version of the app (here) I was able to let the user select the region, and I had manually put % monthly changes directly in the original dataframe.
What I'm trying to do now is enable the app to:
Allow the user to choose/input a specific political party, which are each stored as columns in my df
Then have the app itself calculate and add a new column with % monthly change for the selected party & region, so I don't have to do that manually for each party in the original df.
I can't figure out how to let the user select by party name / df column. I've tried:
selectizeInput(inputId = 'Party', label= 'Party',
choices = colnames(df_2016)
but that doesn't work.
I also have no clue how to do 2 lol.
Thanks in advance for any help you can provide; would realy appreciate if anyone could point me in the right direction or toward resources to learn how to do this. The relevant files are here if needed.
Here's the code for my UI and Server:
UI:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(ggthemes)
library(shinythemes)
library(lubridate)
df_2016 = read.csv('df_2016.csv')
df_2020 = read.csv('df_2020.csv')
# Define UI for application
fluidPage(theme = shinytheme('cerulean'),
# Application title
titlePanel("NJ Voter Registration"),
sidebarLayout(
# Drop-down menu with region options
mainPanel(
selectizeInput(inputId = 'County', label= 'Region',
choices = df_2016$County),
),
mainPanel(
tabsetPanel(
tabPanel('Home',
"Data is sourced from the NJ Division of Elections Voter Registration Statistics Archive, which can be accessed at https://www.state.nj.us/state/elections/election-information-svrs.shtml",
"Please use the drop-down menu above to select whether to view statewide statistics, or data for a specific county.",
),
tabPanel('2016 Data',
'The dataframe for your selection is provided here.',
tableOutput('tableonesix')
),
tabPanel('2020 Data',
'The dataframe for your selection is provided here.',
tableOutput('tabletwozero')
)
)
)
)
)
Server:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(ggthemes)
library(shinythemes)
library(lubridate)
df_2016 = read.csv('df_2016.csv')
df_2020 = read.csv('df_2020.csv')
function(input, output) {
output$tableonesix=renderTable(
df_2016 %>%
filter(County==input$County)
)
output$tabletwozero=renderTable(
df_2020 %>%
filter(County==input$County)
)
}
This sample app shows how it can be done.
Your idea using selecizeInput was correct. However, I would not recommend declaring the data frames as global variables. The usual approach would be to keep the data in the server and feed only the data we want to show to the client.
Use updateSelectizeInput to set the choices once the data frames have been loaded. The observerwill do that every time dfchanges.
Finally, renderTablefilters the relevant part of the data frame and sends it to the client.
library(shiny)
ui <- fluidPage(
titlePanel("Party Sample"),
sidebarLayout(
sidebarPanel(
selectizeInput("Party", "Party", choices = NULL),
selectizeInput("County", label= "Region", choices = NULL),
),
mainPanel(
tableOutput("tableonesix")
)
)
)
#
server <- function(input, output, session) {
# DUMMY DATA
df <- reactiveVal(data.frame(Democrats = 1:10, Republicans = 10:1,
Libertarians = 1:10, GreenParty = 10:1,
County = sample(c("A", "B", "C"), 10, TRUE)))
observe({
# select only the party columns 1-4; 5 is the county column
updateSelectizeInput(session, "Party", choices = colnames(df()[1:4]))
# Get counties without duplicates
updateSelectizeInput(session, "County", choices = unique(df()$County))
})
output$tableonesix <- renderTable({
# Do not run unless selects have a usable value
req(input$Party, input$County)
# Select: here in base R (not dplyr)
df()[df()$County == input$County, input$Party]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I currently have an application running where it portrays a table of NBA teams and their performance metrics. The 'nba' data contains 30 rows with each team in the league as well as 26 columns of different metrics and descriptions such as 'Team', 'Conference', 'REC', and 'PTS'. The user is able to pick these performance metrics through a checkboxGroupInput. I am trying to add a filter in for the Conference of the teams. This would be a selectInput function. If the user chooses Eastern, I would like the output to return a table with only teams from the Eastern conference. If the user chooses Western, I would like the output to return a table with only teams from the Western Conference. I am not sure how to do this. I have tried inputting 'input$conference' in place of 'nba' and other techniques, but nothing has worked. I hope someone can help. Here is my code:
library(shiny)
library(ggplot2)
library(jsonlite)
nba <- read.csv(file.choose())
head(nba)
Eastern = filter(nba,Conference=="Eastern")
Western = filter(nba,Conference=="Western")
ui <- fluidPage(
tags$img(height=150, width=830,src = "NBAlogo2.png"),
tabsetPanel(
# General
tabPanel(title = "General",
titlePanel("NBA Team Performance Metrics Analysis"),
sidebarLayout(
sidebarPanel(
p("This application allows you to compare and contrast several performance metrics amongst teams in the NBA."),
tags$img(height=100, width=100,src = "Eastern.png",align="center"),
tags$img(height=100, width=100,src = "Western.png"),
# Team Filter
selectInput("conference", label = h3("Select Conference"),
choices = list("Eastern", "Western")),
# Stat Filter
checkboxGroupInput("general", label = h3("General Metrics"),
choices = list("Winning Percentage" = "REC",
"Points" = "PTS")),
),
mainPanel(
# Metric Output
h3("General Metrics"),
tableOutput("data1"),
),
)
)
)
)
server <- function(input, output) {
# General
output$data1 <- renderTable({nba[,c("Team",input$general)]},
rownames = TRUE)
}
shinyApp(ui = ui, server = server)```
Do you mean like this?
library(shiny)
library(dplyr)
server <- function(input, output) {
# General
output$data1 <- renderTable({
nba %>%
filter(Conference == input$conference) %>%
select(Team, input$general)
})
}
I am attempting to make a leaderboard in R Shiny for my school where users could submit their name, teacher's name, and their score in textInputs by clicking an actionButton. I am having trouble with the following:
a) Making the textInputs submit on the push of the actionButton (I know I should use the isolate function, but have no idea where/when/how)
b) Storing the info the user inputs with the data frame so that when the app opens on a second device it still shows the info the first person uses
My code is below:
### Libraries
library('tidyverse')
library('readxl')
library('shiny')
library('DT')
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Scoreboard"),
# Sidebar
sidebarLayout(
sidebarPanel(
h5("Sidebar Text"),
),
# Main Panel
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Add Score",
textInput("name_input", "Insert Your Name Below"), textInput("teacher_input", "Insert Your Teacher's Last Name Below"),
textInput("score_input", "Insert Your Score Below"),
actionButton("sumbit_button", "Click Button to Submit!")
),
tabPanel("ScoreBoard", dataTableOutput("score_table"))
)
)
)
)
# Define server logic
server <- function(input, output) {
# Read In Sample Scores as a base dataframe to add user inputs to.
scores <- read_excel("Sample_Scores.xlsx")
scores <- scores[order(scores$Scores, decreasing = FALSE),]
names(scores) <- c("Score", "Name", "Teacher")
output$score_table <- renderDataTable({
new_score <- input$score_input
new_name <- input$name_input
new_teacher <- input$teacher_input
new_student <- c(new_score, new_name, new_teacher)
scores <- rbind(scores, new_student)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Figured it out. The best solution was to read in the df as a csv every time I open the app and then write the info back to a csv every time a score is added to the scoreboard.
I'm building my first Shiny app and I'm running into some trouble.
When I register a new user for the app, I need to add a row with some empty values to a dataframe, that will be used to generate recommendations.
user_features3 <- rbind(user_features3,c(612,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))
This works alright while the app isn't running, and the 612th row is added. But while it's running, this has no effect on user_features3. I think this may be because R is busy with the webapp.
If I make a reactive value, say values <- reactiveValues() and then
value$df <- user_features3, I can modify the values in this reactive one, but I am unable to access the non-reactive one in a similar manner while the app is running.
I need to update it in real-time so that I can use it to generate movie recommendations. Any suggestions?
This solves your asked question, but modifying non-reactive variables can cause problems as well. In general, thinking about modifying a non-reactive variable within a shiny environment indicates perhaps you aren't thinking about how to scale or store or properly maintain the app state. For instance, if you are expecting multiple users, then know that this data is not shared with the other users, it is the current-user only. There is no way around this using local variables. (If you need to "share" something between users, you really need a data backend such as some form of SQL, including SQLite. See: https://shiny.rstudio.com/articles/persistent-data-storage.html)
In addition to all of the other shiny tutorials, I suggest you read about variable scope in shiny, specifically statements such as
"A read-only data set that will load once, when Shiny starts, and will be available to each user session", talking about data stored outside of the server function definition;
"This local copy of [this variable] is not be visible in other sessions", talking about a variable stored within the server function; and
"Objects defined in global.R are similar to those defined in app.R outside of the server function definition".
Having said that, two offered solutions.
Reactive Frame (encouraged!)
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "sometext", label = "Some Text:",
placeholder = "(nothing meaningful)"),
actionButton(inputId = "addnow", label = "Add!")
),
mainPanel(
tableOutput("myframe")
)
)
)
server <- function(input, output, session) {
rxframe <- reactiveVal(
data.frame(txt = character(0), i = integer(0),
stringsAsFactors = FALSE)
)
observeEvent(input$addnow, {
newdat <- data.frame(txt = isolate(input$sometext),
i = nrow(rxframe()) + 1L,
stringsAsFactors = FALSE)
rxframe( rbind(rxframe(), newdat, stringsAsFactors = FALSE) )
})
output$myframe <- shiny::renderTable( rxframe() )
}
shinyApp(ui, server)
This example uses shiny::reactiveVal, though it would be just as easy to use shiny::reactiveValues (if multiple reactive variables are being used).
Non-Reactive Frame (discouraged)
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "sometext", label = "Some Text:",
placeholder = "(nothing meaningful)"),
actionButton(inputId = "addnow", label = "Add!")
),
mainPanel(
tableOutput("myframe")
)
)
)
server <- function(input, output, session) {
nonrxframe <- data.frame(txt = character(0), i = integer(0),
stringsAsFactors = FALSE)
output$myframe <- shiny::renderTable({
req(input$addnow)
nonrxframe <<- rbind(nonrxframe,
data.frame(txt = isolate(input$sometext),
i = nrow(nonrxframe) + 1L,
stringsAsFactors = FALSE),
stringsAsFactors = FALSE)
nonrxframe
})
}
shinyApp(ui, server)
Both allow sequencing as the screenshots below demonstrate. Many will argue that the first (reactive) example is cleaner and safer. (Just the use of <<- is deterrent enough for me!)
I'm trying to code an app for my data visualization project due in a week, but I can't seem to get my app to give the output I want. The app is supposed to take some inputs (a person's education [this has no effect on the output] and three skills they posses), and arrange the given data table so that the resulting arranged table has the best matched occupations listed at the top in descending order.
I have asked both my professor and TA for help, and my TA pointed me toward the arrange() function and desc(mydata[, input$first]), but that only calls the first value in the related column, and not the actual column with that column name.
Any help is appreciated. Thank you! My code is below.
mydata <- iris
skillz <- names(mydata)
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("Weighted App"),
# Sidebar with little paragraph with inputs from person
sidebarLayout(
sidebarPanel(
selectInput("nothing", "Hi, I am trying to get my app to work. Here are ome options" = c("GED", "Bachelor's Degree", "Master's Degree", "PhD", "Trade School Certification", "Other"), selectize = FALSE),
selectInput("first", "I want to look at these 3 traits of irises 1:", choices = skillz, multiple = FALSE),
selectInput("second", "2:", choices = skillz, multiple = FALSE),
selectInput("third", "3:", choices = skillz, multiple = FALSE)
),
# Show a table of the recommended occupations
mainPanel(
tableOutput("results")
#verbatimTextOutput('values')
#Professor:"Look at more examples on Shiny to see if you have an error. Think error in output here"
)
)
)
# Define server logic required to give weighted table
server <- function(input, output) {
output$results <- reactive({
# generate table based on inputs from the above 3 options
filtered <- arrange(mydata, desc(mydata[,input$first]), desc(mydata[,input$second]), desc(mydata[,input$third]))
filtered
#If data table fails, maybe just print?
# output$values <- reactivePrint(
# {
# list(x1 = input$first, x2 = input$second, x3 = input$third)
# }
#)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Again, I think my error is in my arrange() function, but I'm not sure how to get it to actually call the column with my input name.
Edit: I tried using deparse() but that also just returns that there is "no column 'input$first'"...
skill1 <- deparse(input$first)
skill2 <- deparse(input$second)
skill3 <- deparse(input$third)
filtered <- arrange(mydata, desc(mydata[,skill1]), desc(mydata[,skill2]), desc(mydata[,skill3]))
filtered
Edit 2: I have made the data more general. Thanks.
In general, arrange and other dplyr verbs use tidy evaluation semantics. This means that while using a variable which contains the name of the column, we need to convert the string to a symbol and then use !! while evaluating. A simple example below.
data(iris)
library(magrittr)
var1 <- "Species"
var2 <- "Sepal.Length"
var3 <- "Petal.Length"
iris %>% dplyr::arrange(dplyr::desc(!!rlang::sym(var1)),
dplyr::desc(!!rlang::sym(var2)),
dplyr::desc(!!rlang::sym(var3)))
EDIT 1: Added solution to the reproducible example:
library(shiny)
library(magrittr)
ui <- fluidPage(
titlePanel("Weighted App"),
# Sidebar with little paragraph with inputs from person
sidebarLayout(
sidebarPanel(
selectInput("education", , label = "education",
choices = c("GED", "Bachelor's Degree", "Master's Degree",
"PhD", "Trade School Certification", "Other"),
selectize = FALSE),
selectInput("first", "I want to look at these 3 traits of irises
1:", choices = skillz, multiple = FALSE),
selectInput("second", "2:", choices = skillz, multiple = FALSE),
selectInput("third", "3:", choices = skillz, multiple = FALSE)
),
# Show a table of the recommended occupations
mainPanel(
tableOutput("results")
)
)
)
#Define server logic required to give weighted table
server <- function(input, output) {
mydata <- iris
skillz <- names(mydata)
#Use renderTable instead of reactive
output$results <- renderTable({
# Arranging the rows according to the selected variables
filtered <- mydata %>%
dplyr::arrange(dplyr::desc(!!rlang::sym(input$first)),
dplyr::desc(!!rlang::sym(input$second)),
dplyr::desc(!!rlang::sym(input$third)))
unselectedCols <-setdiff(colnames(filtered),
unique(c(input$first,
input$second,
input$third)))
#Reordering columns according to the selections
filtered <- filtered %>%
dplyr::select(!!rlang::sym(input$first),
!!rlang::sym(input$second),
!!rlang::sym(input$third),
!!unselectedCols)
filtered
})
}
#Run the application
shinyApp(ui = ui, server = server)
Using sym and !! operator on the variable containing the column name to pass to the arrange function
I've added an extra couple of lines of code which will reorder the data frame using dplyr::select so that the columns show in the order of selection. Variables are passed similarly using !! and sym
You can use renderTable directly to show a reactive table in the output, instead of using reactive. renderTable has a reactive context.
Here is my dummy dataframe and variable social which hosts the unique texts to be populated in pickerInput in global.R
social_media <- c("Facebook","Instagram","YouTube","Snapchat","Twitter")
founder <- c("PersonA","PersonB","PersonC","personD","personE")
hits <- c(23,56,76,33,12)
DF <- data.frame(social_media, founder, hits)
social <- unique(DF$social_media)
in app.R, I have implemented pickerInput as follows:
library(shinyWidgets)
library(shiny)
ui <- fluidPage(
titlePanel("pickerInput"),
sidebarLayout(
sidebarPanel(
pickerInput("social","social media", choices = social, multiple = FALSE, options = list(deselectAllText = TRUE,actionsBox=TRUE))
)
,
mainPanel()
))
server <- function(input, output) {}
shinyApp(ui, server)
When I run the app, the list shows only values and not the texts. What could I be missing or not doing so as the choices appear?
Your variable social is of type factor. That´s why pickerInput() displays numerical output.
If you avoid creating factor:
DF <- data.frame(social_media, founder, hits, stringsAsFactors = FALSE)
it will display the choices as characters.