I am trying to get my head around RShiny by building what I thought would be a pretty simple but useful app. What I would like the app to do is allow the user to input some data made up of dates, numeric, and characters. Then when the user presses a save/submit button this data is appended onto a pre-existing data frame made up of previous recordings and over write the .csv of these recordings. I would also like this data to be presented to the users in the form of a table in the UI which is updated as soon as the user presses the save/submit button.
I have managed to get the majority of the UI features working, however, I am having real difficulty 1) saving the data in the correct format and 2) updating the table displayed on the UI. My current method of saving the data involves creating an isolated list of the input values and rbinding this to the original data frame. However, the formats of the input values appear to all revert to factors which is especially problematic with the date as the output is meaningless as far as I am aware. In terms of updating the UI I have attempted to create a reactive object out of the data frame and use this object as the data displayed in renderDataTable but this approach seems to have no affect.
I have created a dummy minimal example below.
Thank you for all your help in advance.
require(shiny)
require(tidyverse)
require(lubridate)
require(plotly)
#Would import the data in reality using read.csv() but to allow for an easily
#recreated example I made a dummy data frame
DateRecorded <- dmy(c("10/07/2018", "11/07/2018", "13/07/2018"))
Value <- c(1, 2, 3)
Person <- c("Bob", "Amy", "Charlotte")
df <- data.frame(DateRecorded, Value, Person)
ui <- fluidPage(
#UI Inputs
dateInput(inputId = "SessionDate", label = "Date Recorded", format = "dd-mm-yyyy"),
numericInput(inputId = "SessionValue", label = "Value Recorded", value = 0),
textInput(inputId = "SessionPerson", label = "Person Recording"),
actionButton(inputId = "Save", label = "Save"),
#UI Outputs
dataTableOutput("TheData"),
textOutput("TotRecorded")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#When "Save" is pressed should append data to df and export
observeEvent(input$Save, {
newLine <- isolate(c(input$SessionDate, input$SessionValue, input$SessionPerson))
isolate(df <- rbind(as.matrix(df), unlist(newLine)))
write.csv(df, "ExampleDataFrame.csv") #This export works but the date is saved incorrectly as "17729" not sure why
})
#Create a reactive dataset to allow for easy updating
ReactiveDf <- reactive({
df
})
#Create the table of all the data
output$TheData <- renderDataTable({
ReactiveDf()
})
#Create the totals print outs
output$TotRecorded <- renderPrint({
data <- ReactiveDf()
cat(nrow(data))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I made some small tweaks.
You do not need isolate in the body of the observeEvent; it does not take a reactive dependency to values in its body.
I made ReactiveDf a reactiveVal instead of a reactive. This allows you to write its value from inside an observeEvent.
Instead of rowbinding a matrix and unlisting a list - the issue is that all the new values are parsed to the same class, while they are obviously not - it might be easier to rbind two data.frames, so create the newLine with newLine <- data.frame(DateRecorded = input$SessionDate, Value = input$SessionValue, Person = input$SessionPerson)
So a working example would be as shown below. Hope this helps!
require(shiny)
require(tidyverse)
require(lubridate)
require(plotly)
#Would import the data in reality using read.csv() but to allow for an easily
#recreated example I made a dummy data frame
DateRecorded <- dmy(c("10/07/2018", "11/07/2018", "13/07/2018"))
Value <- c(1, 2, 3)
Person <- c("Bob", "Amy", "Charlotte")
df <- data.frame(DateRecorded, Value, Person)
ui <- fluidPage(
#UI Inputs
dateInput(inputId = "SessionDate", label = "Date Recorded", format = "dd-mm-yyyy"),
numericInput(inputId = "SessionValue", label = "Value Recorded", value = 0),
textInput(inputId = "SessionPerson", label = "Person Recording"),
actionButton(inputId = "Save", label = "Save"),
#UI Outputs
dataTableOutput("TheData"),
textOutput("TotRecorded")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#When "Save" is pressed should append data to df and export
observeEvent(input$Save, {
newLine <- data.frame(DateRecorded = input$SessionDate, Value = input$SessionValue, Person = input$SessionPerson)
df <- rbind(df, newLine)
ReactiveDf(df) # set reactiveVal's value.
write.csv(df, "ExampleDataFrame.csv") #This export works but the date is saved incorrectly as "17729" not sure why
})
#Create a reactive dataset to allow for easy updating
ReactiveDf <- reactiveVal(df)
#Create the table of all the data
output$TheData <- renderDataTable({
ReactiveDf()
})
#Create the totals print outs
output$TotRecorded <- renderPrint({
data <- ReactiveDf()
cat(nrow(data))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I have a tab of my app where I display a bunch of text inputs based on a three-column data frame that contains: variable_name, text_prompt, and example_data. The code below seems to work fine since it displays how I want it to. Eventually, I will be feeding it different data frames, depending on the circumstances, so I need to be able to do everything programmatically.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
#THIS IS THE PART I DON'T KNOW HOW TO DO
#input.data <- ???
#I'll add dummy data so that the program loads
input.data <- tibble(var.names,
temp = 1:length(var.names))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
But what I want - and really have no idea how to do - is to get it back into a data frame after the user hits "submit" (I only need two columns in the subsequent data frame; I don't need the text_prompt data again.)
I know that the user input creates a list of read-only ReactiveValues called "input". But I can't figure out how to do anything with this list besides access using known names (i.e. I know that there is a variable named "project_id" which I can access using input$project_id). But what I want is not to have to write them all out, so that I can change the data used to create the input fields. So I need a way to collect them in a data frame without knowing all the individual names of the variables or even how many there are.
I figured this out on my own. You can't index reactive values with []. However, for some reason you can using [[]].
I would love to know why this is, if anyone has an answer that can help me understand why it works this way.
Here's the key bit of code that I was missing before:
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
The full code that works as I want it is pasted below. I'd still appreciate any feedback or recommendations for improvement.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
Currently creating a sales report generating site in R using Shiny. I have been struggling to pull the data from a CSV file the user imports into the dashboard itself. I need to use the data from my fileInput to run a calculation and then actively display these results in my shiny window. Ideally this would be initiated by the action of selecting the CSV file for the fileInput by the user and the calculations would occur.
Let's say this is the CSV that the user inputs
ID
DATE
GROSS
000001
5/22/22
75000
000002
5/25/22
100000
Here is an abridged version of the related code
# Load packages
library(shiny)
library(bslib)
library(shinyWidgets)
library(dplyr)
# Define static variables
mayquota <- 135000
# UI
ui <- navbarPage(title = "Example",
tabPanel(title = "Page 1",
fluidPage(inputPanel(textInput("key", "KEY")),
fixedRow(column(12, fileInput("salesdata", "SALES DATA",
width = 100%, buttonLabel = "SELECT"))),
inputPanel(currencyInput("profits", "PROFITS", format = "dollar",
value = 0, align = "right"),
currencyInput("quota", "QUOTA", format = "dollar",
value = 0, align = "right"),
currencyInput("difference", "DIFFERENCE",
format = "dollar", value = 0,
align = "right")))))
# Server
server <- function(input, output, session) {
prof <- reactive({read_csv(input$profits)})
toListen <- reactive({input$key})
observeEvent(toListen(),
{if(input$key == "test123")
{updateCurrencyInput(session, "quota", value = mayquota)
updateCurrencyInput(session, "difference", value = profits() - mayquota}})
}
# Run application
shinyApp(ui = ui, server = server)
I need to pull the sum of the GROSS column in the CSV and use it to updateCurrencyInput in the form of:
updateCurrencyInput(session, "profits", value = profits())
I was hoping that something like this would work:
toListenFile() <- reactive({input$salesdata})
observeEvent(toListenFile(), {profits <- reactive({prof() %>% summarize(sum(`GROSS`))})})
But I was given the error that summarize from dplyr could not be used on reactive data. So that is where I stand. Any help would be appreciated to achieve a similar function to dplyr in a reactive environment where the CSV data is inputted by the user.
It appears as though I have a solution to my issue, just wanted to share since I already opened the question.
server <- function(input, output, session) {
abcInput <- reactive({
req(input$salesdata)
tibble(read_csv(input$salesdata$datapath))
})
sumprof <- reactive({sum(abcInput()$`GROSS`)})
observeEvent(input$rdata, {updateCurrencyInput(session, "profits", value = sumprof())
})
There might be a more elegant way to achieve this, but this appears to work thus far.
I've written a script to calculate glicko ratings and produce odds and historic plots for sport teams. A separate script is responsible for querying the SQL server that holds historic data and extracting the relevant info to make a local tsv file of the info I need for the rating calculation. To make it more user-friendly, I've put the functions into a simple shiny app.
My problem is that I would like to put in a button that automatically executes the code of the second script that adds recent matches to the data file, so the ratings can be updated.
I've proved a simplified example of my code, showing that I'm handling the bulk of the data wrangling and preparation of the ratings object, from where I can get probabilities, before defining the UI. I tried a simple example of modifying the teams_list with my action button, but this did not recalculate the list of teams available to enter in selectInput(); because of how observeEvent() handles the code with isolate() to avoid recalculations, I'm guessing. So simply duplicating all the code that loads data and prepares the ratings object will not do unless it makes all the rest of the code re-evaluate its input.
I considered moving all of that into the action button and deleting it from the start of the script, but that would mean that there is no data at all until the action button would be pressed and that is not desirable either. I don't want to query the database more often than is necessary, so it is a must to be able to run the app from the existing data rather than querying it every time the app is launched.
Does anyone have a suggestion for how this could be accomplished?
### Toy example
## Prep: This input data normally exists before app is run.
library(tidyverse)
tibble(team1 = c("Name1", "Name2", "Name3", "Name2"),
team2 = c("Name2", "Name1", "Name1", "Name3"),
team1Won = c(T, T, F, T)) %>%
write_tsv("example_match_file.tsv")
## Here the app code starts.
# Loading data and calculating team ratings
match_df <- read_tsv("example_match_file.tsv")
rating_calculation <- function(match_data = match_df) {
match_data %>%
group_by(team1) %>%
summarize(matchesWon = sum(team1Won)) %>%
arrange(desc(matchesWon))
}
rating_df <- rating_calculation(match_df)
team_list <- rating_df$team1
odds_calculation <- function(team1, team2, ratingObject = rating_df) {
#Real calculation omitted for brevity
p <- runif(1)
}
## Define Shiny UI
library(shiny)
ui <- fluidPage(
titlePanel("Odds"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "team1",
label = "Team 1",
choices = team_list),
selectInput(inputId = "team2",
label = "Team 2",
choices = team_list),
#actionButton("update", "Update match data")
),
mainPanel(
tableOutput("odds")
)
)
)
## Define Shiny server logic
server <- function(input, output) {
#Generate Odds
output$odds <- renderTable({
p <- odds_calculation(rating_df, input$team1, input$team2)
tibble(Team = c(input$team1, input$team2), Win = c(p, 1-p)) %>%
mutate(Odds = (1/Win))
})
### Make Action Button update database, re-read example_match_file.tsv and rerun all calculations.
# datasetInput <- observeEvent(input$update, {
# ???
# })
}
# Run the application
shinyApp(ui = ui, server = server)
If I'm reading this right you'd like to spare your query limit by providing a local set of data to your shiny application. But if a user requests an update you'd like to trigger a query to be used in calculations.
I cannot recommend enough that you make full use of reactivity in Shiny. It is fairly rare to use an object from the global environment, especially when you intend for user inputs to manipulate those objects. You should have your base data ( in your case the tsv) load into the global environment, and then call that information into your application via a reactive dataframe. I built the below minimal example using mpg subset to the first 5 rows to simulate the .tsv on your local machine. mpg subset to 10 rows is to simulate the results of a query to a database. These two data sets get called via an if else statement dependent on an actionbutton.
library(tidyverse)
library(shiny)
# using partial mpg data to simulate un-updated data
mpg <- ggplot2::mpg[1:5,]
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("update", "Update Data"),
uiOutput('selectOpts')
),
mainPanel(
h2("This is our base data layer"),
verbatimTextOutput('print_interval1'),
h2("This is our output data"),
verbatimTextOutput('print_interval2')
)
)
)
server <- function(input, output) {
# The core of shiny is the reactivity. It's the workhorse of interactive apps.
# If possible, a data calculation should always happen in a reactive context.
working_data <- reactive({
# actionbuttons increment a value by 1, starting with 0. If input < 0 the
# user has not interacted yet. If incremented again, the reactive context
# will invalidate and re-calculate the working_data() object
if (input$update < 1) {
base_dat <-
mpg %>%
mutate(ratio = cty/hwy)
} else {
base_dat <-
ggplot2::mpg[1:10,] %>% # calling from namespace to simulate a query. Full data
mutate(ratio = cty/hwy)
}
# return our base data. Can be called with `working_data()`
data.frame(base_dat)
})
output$print_interval1 <- renderPrint({
working_data()
})
output$selectOpts <- renderUI({
# using the reactive data inside renderUI we can be flexible in our options
# this lets us adapt the UI to reactive data.
radioButtons('model',
"Select Model",
sort(unique(working_data()$model)))
})
# You can also chain reactive objects.
output_data <- reactive({
working_data() %>%
group_by(model) %>%
filter(model == input$model) %>%
summarise(m.ratio = mean(ratio))
})
output$print_interval2 <- renderPrint({
output_data() %>%
data.table()
})
}
shinyApp(ui = ui, server = server)
I also recommend looking into this post about database syncing for setting up triggers and using reactive objects as your applications get more complex. I hope that's enough to get you on the right track for both your initial question about updating data, and your comments about having your inputs react to updated data.
I currently have the following shiny app and the intention is to add the text input as a new row into the dataset. Currently, the new text input is overriding the old input instead of appending to the end. I understand that's happening because I'm referring to df in the eventReactive, which is the originally seeded empty data frame, but my various attempts around that have led to errors.
Does somebody know of a way to fix that? Bonus if there is a way to clear the text input box after hitting the submit button.
library(shiny)
colClasses = c("factor", "numeric")
col.names = c("Player", "1")
df <- read.table(text = "",
colClasses = colClasses,
col.names = col.names)
ui <- fluidPage(
# Application title
titlePanel("Random Draft Order"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("AddPlayer",
"Add Player",
""),
actionButton("submit", ("Submit"))
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("racingbars")
)
)
)
server <- function(input, output) {
actionButton("submit", ("Submit"))
FinalData = eventReactive(input$submit,{
df = rbind(df, data.frame("Player" = input$AddPlayer, "X1" = ""))
})
output$racingbars <- renderTable({
FinalData()
})
}
# Run the application
shinyApp(ui = ui, server = server)
You could try this creating a reactiveVal that will store the data.
First, you can initialize your data.frame df as a reactiveVal:
df <- reactiveVal(data.frame(Player = character(),
X1 = character()))
To update the reactiveVal you can use:
df(new_dat)
And to reference the data later on, use:
df()
In your example, an observeEvent can be triggered by your submit button. When that happens, you can add your row of data to the reactiveVal data.frame similar to what you have done. The output can then point to the reactiveVal data.frame to display the data.
I also added updateTextInput to the observeEvent to clear the text input after the submit button is pressed. Note this requires session in the server function declaration.
server <- function(input, output, session) {
df <- reactiveVal(data.frame(Player = character(),
X1 = character()))
observeEvent(input$submit, {
new_dat <- rbind(df(), data.frame(Player = input$AddPlayer, X1 = ""))
df(new_dat)
updateTextInput(session, "AddPlayer", value = "")
})
output$racingbars <- renderTable({
df()
})
}
i'm new in shiny, but i try to write a simple app. It will connect to DB, download DF and print it on site. And i got this. Now I want to pick range to save as csv a part of that DF.
So I have to input labels: Start and Stop, and Action Button.
I tried to find information how to implement that functionality, and i didn't. I found some info about observe function, but it's totaly not working in my example. When I do it as in official doc, after button click noting is happend.
My code:
ui <- fluidPage(
titlePanel("Skrypt"),
DT::dataTableOutput("table"),
numericInput("Start", "Start", 0),
verbatimTextOutput("v1"),
numericInput("Stop", "Stop", length(a)),
verbatimTextOutput("v"),
actionButton("button", "Generate For Range")
)
server <- function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
data <- myDat}))
}
shinyApp(ui, server)
And only what I tried to do is save Start and Stop as a variables after click button to use it in function to generate_csv(df, start_v, stop_v) as args.
Can someone explain me how to do that in simple way?
One solution uses eventReactive. It creates a calculated value that only updates in response to an event. In this case, the click on your button. That provides a data frame you can use in renderDataTable. Any code to filter data frame moves to the eventReactive named df.
myDat <- data.frame(A = 1:3, B = LETTERS[1:3]) # dummy data for testing
ui <- fluidPage(
titlePanel("Skrypt"),
DT::dataTableOutput("table"),
numericInput("Start", "Start", 1),
verbatimTextOutput("v1"),
numericInput("Stop", "Stop", 2),
verbatimTextOutput("v"),
actionButton("button", "Generate For Range")
)
server <- function(input, output) {
df <- eventReactive(input$button, {
# Test if filter is valid
if (input$Start >= input$Stop) stop("Start cannot be larger or equal than stop")
if (input$Start < min(myDat$A)) stop("Start cannot be less than smallest value")
if (input$Stop > max(myDat$A)) stop("Stop cannot be larger than largest value")
myDat[input$Start:input$Stop,] # use any filter you deem necessary
})
# Filter data based on selections
output$table <- DT::renderDataTable({
d <- DT::datatable(
data <- df()
)
})
}
shinyApp(ui, server)