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.
Related
I'm extremely new to Shiny Apps. So far, what I've aimed to do is have a drag-down menu for the user where they can choose to subset the data frame by the year column (I wish I could have added a no subset option). This was working fine, however, it did not look pretty (it showed all rows, didn't format in a way where it would only show the head and then have multiple pages to the data frame). Then, I tried to get the number of columns and rows to print, and I have been struggling with this. After fixing this, my hope is to get the subsetted data frame to be downloadable by the user. Any advice?
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("World Happiness Report Data"),
tags$h3("DS 3002, Project One"),
tags$h4("By Jasmine Dogu (ejd5mm)"),
sidebarLayout(
sidebarPanel(
selectInput('year',"Choose a Year",
choices = sort(data$year, decreasing = TRUE),
tableOutput("table1")
),
mainPanel(
DT::dataTableOutput('contents'),
verbatimTextOutput('summary'),
plotOutput('plot')
)
)
)
)
# Define server logic required to subset data
server <- function(input, output) {
data <- read.csv("world-happiness-report.csv")
category <- data$year
df_subset <- reactive({
a <- subset(data, category==input$year)
return(a)
})
output$table1 <- renderTable(df_subset()) #Note df_subset() was used and not df_subset
output$contents <- DT::renderDataTable({
DT::datatable(df_subset())
})
output$summary <- renderPrint({
summary(df_subset())
})
}
# Run the application
shinyApp(ui = ui, server = server)
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)
I am working on a shiny app where users can upload their own data and get some plots and statistics back. However, I also want to include an example dataset that gets used instead if the user presses a specific button. Importantly, the plots should be reactive so that users get updated plots whenever they click on the "use example data instead" button or upload a new file. I tried to recreate my current approach of overwriting the data object as best as I could here, but simply defining the data object twice doesn't overwrite the data in the way I hoped it would. Any suggestions are appreciated.
library(shiny)
# UI
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("Upload", "Upload your own Data"),
actionButton("Example", "Use Example Data instead")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("hist")
)
)
)
# Server Logic
server <- function(input, output) {
data <- eventReactive(input$Upload,{input$Upload})
data <- eventReactive(input$Example, {faithful$eruptions})
output$hist <- renderPlot({hist(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use a reactiveVal like this:
server <- function(input, output) {
my_data <- reactiveVal()
observeEvent(input$Upload, {
tmp <- read.csv(input$Upload$datapath)
## do whatever is needed to parse the data
my_data(tmp)
})
observeEvent(input$Example, {
my_data(faithful)
})
output$hist <- renderPlot({
dat <- as.data.frame(req(my_data()))
dat <- dat[, sapply(dat, is.numeric), drop = FALSE]
validate(need(NCOL(dat) > 1, "No numeric columns found in provided data"))
hist(dat[,1])
})
}
Depending on upload or button click, you store your data in my_data which is a reactive value. Whenever this value changes, the renderPlot function fires and uses the correct data.
You can use a reactive value to access whether the user has chosen to use an example dataset or use their own dataset. The user can choose to switch between the active dataset using an input from your UI.
Here's the official explanation on reactive values from RStudio: link
This would go in your ui.R:
radioButtons("sample_or_real",
label = h4("User data or sample data?"),
choices = list(
"Sample Data" = "sample",
"Upload from user data" = "user",
),
selected = "user"
)
This would go in your server.R:
data_active <- reactive({
# if user switches to internal data, switch in-app data
observeEvent(input$sample_or_real_button, {
if(input$sample_or_real == "sample"){
data_internal <- sample_data_object
} else {
data_internal <- uploaded_data_object
}
})
Note, that when using a reactive value in your server.R file, it must have parentheses () at the end of the object name. So, you call the data_internal object as data_internal().
I would like to design a Shiny app with two buttons. Users can click the "Add UI" button as many times as they want, which will return text boxes. Users can then type numbers to the input boxes, click the "Sum" button, and calculate the total.
Below is my current code, modified from the sample code from ?insertUI. My question is I am not sure how to refer to the input id from the updated UI (in this case, the new text boxes). My current attempt cannot calculate the sum. The end result is always 0.
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("sum", "Sum"),
# Report the output
h4("The total from input"),
textOutput("text")
)
# Server logic
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(paste0("txt", input$add),
"Insert some text")
)
})
# Calculate the total from the text inputs
output$text <- eventReactive(input$sum, {
as.character(sum(as.numeric(unlist(mget(ls(pattern = "^txt"))))))
})
}
# Complete app with UI and server components
shinyApp(ui, server)
You can use the special Shiny variable input to check and access the current inputs (and values) in your app. Thus you can get at newly inserted UI elements (assuming they all follow a pattern) and compute against them.
output$text <- eventReactive(input$sum, {
txt_inpt_names <- names(input)[grepl("^txt", names(input))]
sum(sapply(txt_inpt_names, function(x) as.numeric(input[[x]])), na.rm = T)
})
Worth noting that Shiny requires single (one-at-a-time) access to input values so thats why sapply() is required and not just input[[txt_inpt_names]].
So I have what in my head is a simple problem.
I have a selectInput. Let's call it report_select with the options "Report 1" and "Report 2" to choose from.
In addition, I have a textInput (which is used to specify an employee ID)
I have two reactives (lets call them r_one and r_two). These result in separate data based on the employee.
I have an output$table1
The goal: I want the dropdown to control WHICH of the two reactive reports to display in table1.
Note 1: The tables individually work fine. I can display one after the other without issue.
Note 2: I am using SHINY as well as tabsetpanel and tabpanel for organization
Any methodology to help with this?
METHOD 1: (Error is "Reading Objects from shionyoutput object not allowed)
library(shiny)
library(readxl)
library(dplyr)
library(tidyr)
# Globally Pull In Files
new_compdump_data <- read_xlsx("C:/temp/FILE.xlsx")
#Format Imported Data
clean_new <- subset(new_compdump_data,is.na(new_compdump_data$Term_Date))
clean_new$AIN <- as.numeric(clean_new$AIN)
clean_new$`MIP value` <- clean_new$`MIP%`*clean_new$Salary
# Begin UI
ui <- fluidPage(
titlePanel("Data Tool"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "report_select",
label = "Select a Report",
choices = c("Base Info","Stock Info")),
textInput("stock_ain","AIN")
), #End SideBarPanel
mainPanel(
tabsetPanel(
tabPanel(title="Base Info",tableOutput("table1")
)))
))
#======= SHINY - Server Section
server <- function(input, output) {
report1 <- reactive({
subset(clean_new[c(5,1,2,3)],clean_new$AIN==input$AIN)
})
report2 <- reactive({
subset(clean_new[c(5,6,7,8)],clean_new$AIN==input$AIN)
})
report_choose <- reactive({
ifelse(input$report_select=="Base Info",report1(),
ifelse(input$report_select=="Stock Info",report2()))
})
output$table1({
report_choose()
})
} #End server info
# Run the App
shinyApp(ui = ui, server = server)
METHOD 2: Error: Same as Above
Same as above but reactive for report_choose is:
report_choose <- reactive{(
switch(input$report_select,
"Base Info"=report1(),
"Stock Info"=report2())
)}
METHOD 3: (Error is "Reading Objects from shionyoutput object not allowed)
Same (section) as above but
report_choose <- reactive({
if(input$report_select=="Base Info") {
report1()
} else {
report2()
}
})
Still no dice. Any ideas or methodology?