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.
Related
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'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 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)
DT package provides the ability to save the state of a table with filters, searching and everything. I can see the content of that state(input$TableId_state) on text output. But I can't use it in any proper way. I want to do two things:
Saving a state of DT at any time, and apply it to same DT with an action button. (I want to have full data but with filters and text in search box) .
Extracting data from output table into another data table inside server function (not as output table)
I can do 2. bullet by using input$tableId_rows_all . But I need to be able to do that with the state.
In my opinion, if any of these are not possible than state function is useless and just to show off.
Here is my trial to do 2. bullet:
library(shiny)
library(DT)
data <- iris
ui <- fluidPage(
actionButton(inputId = "action", label = "Apply",icon=
icon("refresh",lib="font-awesome"),style="background-
color:#FBAF16",width =validateCssUnit(385)),
fluidRow(DT::dataTableOutput(outputId =
"Table")),hr(),fluidRow(DT::dataTableOutput(outputId = "FilteredTable"))
)
server <- function(input,output,session){
output$Table<-DT::renderDataTable(expr = {
DT::datatable(data,option = list(stateSave =
TRUE),filter=list(position="top",clear=TRUE))
})
filtereddata <- eventReactive(input$action,{
return(DT::datatable(data
,options = list(state=input$Table_state)
))
})
output$FilteredTable<- DT::renderDataTable(expr = {
return(filtereddata())
})
}
runApp(list(ui = ui, server = server),host="127.0.0.2",port=5013, launch.browser = TRUE)
I'm stuck trying to get dates to show up in a Shiny table. I have done some research and see that in the past xtable does not work nicely with Shiny. There are a couple of questions on SO that dealt with this issue. The one routinely reference can be found here R: xtable and dates.
My problem is that 1)I'm extremely new at programming in Shiny and using xtable. 2) I am unfamiliar with using POSIXct. 3) I don't understand the solution provided in the link above.
Please provide a helping hand for the basic code below. The idea is that somebody would use this app to enter data daily. These data would be stored on a .csv. When stored on the .csv only the numeric value of the R date is stored. This is what shows up on the Shiny table as well. Please teach me how to format correctly in both the table and the .csv file.
Before examining the code below, know that there would be a .csv file stored that would have the Headers Date, A, B. Let's call this file "log" and it would be stored locally. Here is the code:
library(shiny)
log <- read.table("V:\\My\\Path\\log.csv",sep=",",header=T)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=2,
#Enter Date
dateInput("date","Date",min="2016-07-04", max = "2017-07-04"),
#Enter Combo
selectInput(inputId = "a", "A", c("Choose one" = "","A1", "A2", "A3"), multiple = FALSE, selectize = TRUE, width = NULL, size = NULL),
#Enter Number
numericInput(inputId = "b", "Favorite Number", NULL, min = 0, max = NA),
#Enter Submit to write info to file
actionButton(inputId = "submit", "Submit", icon = NULL, width = NULL)
),
mainPanel(
# Application title
titlePanel("Read Date"),
tableOutput("summary"))
)
)
server <- function(input, output) {
#Create vector of current trial results
data <- eventReactive(input$submit, {
cbind(input$date,input$a, input$b)
})
#Append current trial results to master list
observeEvent(input$submit, {
write.table(data(), file="V:\\My\\Path\\log.csv", sep=",", col.names= FALSE, row.names=F, append = T)
})
#Create datatable variable reading in latest log
datatable <- eventReactive(c(input$agent,input$submit), { #Putting both reactive variables allow to see dataset without running and see updated dataset after running.
data.frame(read.table("V:\\My\\Path\\log.csv",sep=",",header=T))
})
#Create Table
output$summary <- renderTable({
datatable() }, digits=2,align = "cccc" )
}
shinyApp(ui = ui, server = server)
It seems the answer is to write as character to the log file and read it back in as a character. I can't figure out to do this. Am I on the right track? Because I'm learning I'll take any other suggestions on how to improve my code.
I finally figured out the simple solution.
I just changed the code when I build the dataframe from
data <- eventReactive(input$submit, {
cbind(input$date,input$a, input$b)
to
data <- eventReactive(input$submit, {
cbind(as.character(input$date),input$a, input$b))
Adding the as.character() seems to have done the trick. I don't know if this will have consequences later, but the displayed table now looks nice.