I want to take a reactive source through more than one reactive conductor before sending it to a reactive endpoint.
Generalized example:
x <- reactive({ function(input$var) })
y <-reactive({ function(x) })
output$display<-renderText({ y()$attr })
Below is a specific Example.
Thanks in advance
# Install packages if needed
packageNeeds <- c('shiny', 'httr', 'dataRetrieval')
packageNeeds <- packageNeeds[!packageNeeds %in% rownames(installed.packages())]
if(length(packageNeeds)>0){
install.packages(packageNeeds, repos='http://cran.cnr.Berkeley.edu')
}
library(shiny)
library(httr)
library(dataRetrieval)
shinyApp(
ui = fluidPage(
fluidRow(
wellPanel(
selectInput("site", label = p("Pick a site"), choices = list('01594440', 'sysys')),
selectInput("start", label = p("pick a date"), choices = list('1985-01-01', "xyz")))),
fluidRow(wellPanel(verbatimTextOutput("URL"))),
fluidRow(wellPanel(verbatimTextOutput("REC")))),
server = function(input, output, session){
url<-reactive({
# Here the user inputs are used to constuct a url -
# but really this could be any function that I'd like to take the output of
# and pass it on to other functions and/or subeset
# before sending to a reactive output
constructWQPURL(paste("USGS",input$site,sep="-"),
c('01075','00029','00453'),
input$start, endDate = "")
})
# This is the function I've passed the reactive value to
# it returns an object with a headers attributes that has the
# 'total-result-count' attribute I want
header_call = reactive({HEAD(url)})
output$URL<-renderText({
# The url displays fine
url()
})
output$REC<-renderText({
# The record count from the header pull does not display
# the value is the number of records stored as a string
header_call()$headers$'total-result-count'
})
}
)
One issue might be that you are missing parenthesis after url when you define header_call. url is a closure, url() returns the URL string.
Also renderText is reactive, so you can just call HEAD(url()) from there:
This works for me (I removed header_call = reactive({HEAD(url)})) :
output$REC<-renderText({
# The record count from the header pull does not display
# the value is the number of records stored as a string
#header_call()
HEAD(url())$headers$'total-result-count'
})
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)
I am creating a shiny app and realized I am repeating a particular UI element so I am wondering if there is a way to wrap this in a function and supply parameters to make it work in different cases. In my server file, I have
output$loss <- renderUI({
req(input$got)
if(input$got %in% Years) return(numericInput('got_snow', label = 'John Snow', value = NA))
if(!input$got %in% Years) return(fluidRow(column(3)))
})
and in the ui file, I have:
splitLayout(
cellWidths = c("30%","70%"),
selectInput('got', label = 'Select age', choices = c('',Years) , selected = NULL),
uiOutput("loss")
)
Since I find myself using these several times and only changing a few things in both the UI and server files, I wanted to wrap these in a function and use them as and when I please. I tried this for the server file
ui_renderer <- function(in_put, label, id){
renderUI({
req(input[[in_put]])
if(input[[in_put]] %in% Years) return(numericInput(id, label = label, value = NA))
if(!input[[in_put]] %in% Years) return(fluidRow(column(3)))
})
}
output$p_li <- ui_renderer(input='li', "Enter age", id="c_li")
and in my ui file, I put
uiOutput('c_li')
but it's not working. Any help is greatly appreciated.
I was unable to test your code since there was no minimal working example. I don't know if this is a typo in your example, but your are trying to render c_li, but your output is called p_li. Not sure how wrapping a render object in a standard function works, but I have done something similar using reactive values instead.
This is a minimal example using some of your terminology. It is not a working example, but an outline of the idea to my proposed solution.
# Set up the UI ----
ui <- fluidPage(
uiOutput("loss")
)
# Set up the server side ----
server <- function(input, output, session) {
# Let us define reactive values for the function inputs
func <- reactiveValues(
value <- "got",
label <- "select age",
id <- "xyz"
)
# Set up an observer for when any of the reactive values change
observeEvent({
func$value
func$label
func$id
}, {
# Render a new UI any time a reactive value changes
output[["loss"]] <- renderUI(
if (input[[func$value]] %in% years) {
numericInput(func$id, label = func$label, value = NA)
} else {
fluidRow(
column(3)
)
}
)
})
}
# Combine into an app ----
shinyApp(ui = ui, server = server)
The general idea is to define a set of reactive values and set up an observer that will render the UI every time one or more of the reactive values change. You can assign a new value to any of the reactive values using direct assignment, e.g. current$value <- "object_two". Making that change will update the UI using Shiny's reactive pattern, which means you only need to change one value to update the UI.
When using shiny modules and DT::datatable I would like to access the selected_rows server-side.
If my DT:datatable ID is my_DT_table then I would expect that the object input$my_DT_table_selected_rows contains the index of the selected row.
This works perfectly well in shiny applications without modules.
However, if I use modules then this approach no longer works and the input object input$my_DT_table_selected_rows no longer contains the index of the selected row.
When working with DT:datatable function we can use built-in functionality to learn about selected rows in the UI.
The object: input$my_DT_table_rows_selected contains the index of the selected row where my_DT_table is the ID of the DT::datatable.
However, when working with modules, the name of the table is now different. It has a prefix which is equal to the ID used to call the module's UI function.
So if that ID is my_ID then the table name will become: my_ID-table_name (note the hyphen after the ID).
This can be easily verified using the developer tools in your browser (e.g. inspector in FireFox).
And the associated input object name then becomes (and we need back ticks to prevent R from interpreting the hyphen as a minus sign):
input$`my_ID-table_name_rows_selected`
Here is a very basic example with some additional learning regarding how to pass a reactive object to a module. The reactive object contains the index of the selected line. I need to pass it without parenthesis. Inside of the module_server function I refer to the reactive object with parenthesis.
UI module in ui_module.R
module_ui <- function(id) {
ns <- NS(id) # create namespace
tagList(
fluidRow(column(6, DT::dataTableOutput(ns("dt_table")))),
fluidRow(column(4, verbatimTextOutput(ns("render_selected_line"))))
)
}
Server module in server_module.R
table_server <- function(input, output, session, data) {
output$dt_table <- DT::renderDataTable(
DT::datatable(
data = data,
selection = "single"
)
)
}
selected_line_server <- function(input, output, session, data) {
output$render_selected_line <- renderText({
paste0("My selection was: ", data()) # refer to the reactive object with parenthesis
})
}
Shiny application
library(shiny)
library(dplyr)
library(DT)
source("./modules/ui_module.R")
source("./modules/server_module.R")
ui <- fluidPage(
module_ui("my_ID")
)
server = function(input, output, session) {
data <- mtcars
callModule(table_server, id = "my_ID", data = data) # data is not reactive
callModule(selected_line_server, id = "my_ID", data = selectedLine) # refer to the reactive object selectedLine without parenthesis
selectedLine <- reactive({
req(input$`my_ID-dt_table_rows_selected`)
if (is.null(input$`my_ID-dt_table_rows_selected`)) {
return(NULL)
} else {
rows_selected <- as.numeric(input$`my_ID-dt_table_rows_selected`) # we need to prefix dt_table_rows_selected with the ID of the UI function "my_ID" and a hyphen
}
})
}
shinyApp(ui = ui, server = server)
I am working on building a shiny App. I have used some filters and rendered a data frame and the data frame changes dynamically as per the user input. But I cannot store a particular column value from a data frame into a vector. I need to store the reactive output every time into a vector so that I can use the values later again. Here the values are stored in text_vec and i need to pass that into the API but I cannot access the values from text_vec and i have to pass the updated values every time into the API
library(dplyr)
library(shiny)
shinyApp(ui = fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "cyl",
label = "Number cylinders:",
choices = c("all",sort(unique(mtcars$cyl))),
selected = "all"),
actionButton("capture",
"capture value")
), # closes sidebarPanel
mainPanel(
tableOutput("text"),
tableOutput("text2"),
tableOutput("text3"),
tableOutput("table")
) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
server = function(input, output) {
# some example reactive data
cars_react <- reactive({
mtcars %>%
filter(cyl == input$cyl | input$cyl == "all")
})
# simply global assignment of a reactive vector
observeEvent(cars_react(), {
# here is a globally assigned vector taken from the reactive data
# reused in a render statement it will not react to change, since it is not reactive
test_vec3 <<- unique(cars_react()$hp)
})
# here a file is written to the working directory of your shiny app
# everytime cars_react() changes write (and overwrite) vector to a file
observeEvent(cars_react(), {
test_vec = unique(cars_react()$hp)
saveRDS(test_vec, file = "test_vec.Rdata")
})
# same as above but the file is gradually growing and not overwritten
# everytime cars_react() changes add vector to a (over several sessions growing) list
observeEvent(cars_react(), {
test_vec2 = unique(cars_react()$hp)
if (file.exists("test_list.Rdata")) {
temp = readRDS("test_list.Rdata")
test_list = c(temp, list(test_vec2))
} else {
test_list = list(test_vec2)
}
saveRDS(test_list, file = "test_list.Rdata")
})
# here we access the reactive data with isolate and make it non-reactive, but can update the values through a button click
text_vec <<- eventReactive(input$capture, {
isolate(unique(cars_react()$hp))
})
# output of our reactive data as table
output$table <- renderTable({
cars_react()
})
# text output of globally assigned non-reactive vector test_vec3 (not changing!)
output$text <- renderText({
test_vec3
})
# you can capture values of reactives with isolate, but then, they don't change anymore
# text output of isolated formely reactive vector unique(cars_react()$hp (not changing!)
output$text2 <- renderText({
isolate(unique(cars_react()$hp))
})
# text output of new reactive vector (changes when input$capture button is clicked)
output$text3 <- renderText({
text_vec()
})
for (i in text_vec)
{
url = "https://oscar.com/prweb/PRRestService/"
parameters<-'{
{
"Reference":"Account"
,"ReferenceValue":""
}'
b<-fromJSON(parameters)
b["ReferenceValue"]=i
r <- POST(url, body = parameters,encode = "json")
r_c<-toJSON(content(r))
print(r_c)
}
}
)
A simple way to get a data frame to persist across all environments used within your Shiny app, is to use the '<<-' assignment instead of the '<-" assignment. This is not a great programming technique, but it may be what you're hoping to find.
# To get a data frame to persist, use
a <<- b
# instead of
a <- b
** Updated answer **
Based on your updated answer, I would wrap you API call into an observeEvent which gets triggered once the action button is pressed. Since you do not provide a working example with some real code, I am not sure whether the example below is of help. I further assume that your for loop is correct and working (on my end, I cannot know without a real API and some real values).
library(dplyr)
library(shiny)
library(httr)
library(jsonlite)
shinyApp(ui = fluidPage(
selectInput(inputId = "cyl",
label = "Number cylinders:",
choices = c("all",sort(unique(mtcars$cyl))),
selected = "all"),
actionButton("capture",
"capture value")
), # closes fluidPage
server = function(input, output) {
# some example reactive data
cars_react <- reactive({
mtcars %>%
filter(cyl == input$cyl | input$cyl == "all")
})
# here we access the reactive data with isolate and make it non-reactive, but can update the values through a button click
observeEvent(input$capture, {
for (i in unique(cars_react()$hp))
{
url = "https://oscar.com/prweb/PRRestService/"
parameters<-'{
"Reference":"Account"
,"ReferenceValue":""
}'
b<-fromJSON(parameters)
b["ReferenceValue"]=i
r <- POST(url, body = parameters,encode = "json")
r_c<-toJSON(content(r))
print(r_c)
}
})
}
)
Old answer
It is not clear from your question how, where and how often you want to use the vector of your reactive data frame. But it is an important question, since the concept of reactivity and how to access it is very hard to grasp when you come from a pure non reactive R environment.
Below is a simple example app which shows how to access vectors in reactive data frames, and how they could be used.
I hope it helps to get a better understanding of reactivity in shiny.
library(dplyr)
library(shiny)
shinyApp(ui = fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "cyl",
label = "Number cylinders:",
choices = c("all",sort(unique(mtcars$cyl))),
selected = "all"),
actionButton("capture",
"capture value")
), # closes sidebarPanel
mainPanel(
tableOutput("text"),
tableOutput("text2"),
tableOutput("text3"),
tableOutput("table")
) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
server = function(input, output) {
# some example reactive data
cars_react <- reactive({
mtcars %>%
filter(cyl == input$cyl | input$cyl == "all")
})
# simply global assignment of a reactive vector
observeEvent(cars_react(), {
# here is a globally assigned vector taken from the reactive data
# reused in a render statement it will not react to change, since it is not reactive
test_vec3 <<- unique(cars_react()$hp)
})
# here a file is written to the working directory of your shiny app
# everytime cars_react() changes write (and overwrite) vector to a file
observeEvent(cars_react(), {
test_vec = unique(cars_react()$hp)
saveRDS(test_vec, file = "test_vec.Rdata")
})
# same as above but the file is gradually growing and not overwritten
# everytime cars_react() changes add vector to a (over several sessions growing) list
observeEvent(cars_react(), {
test_vec2 = unique(cars_react()$hp)
if (file.exists("test_list.Rdata")) {
temp = readRDS("test_list.Rdata")
test_list = c(temp, list(test_vec2))
} else {
test_list = list(test_vec2)
}
saveRDS(test_list, file = "test_list.Rdata")
})
# here we access the reactive data with isolate and make it non-reactive, but can update the values through a button click
text_vec <- eventReactive(input$capture, {
isolate(unique(cars_react()$hp))
})
# output of our reactive data as table
output$table <- renderTable({
cars_react()
})
# text output of globally assigned non-reactive vector test_vec3 (not changing!)
output$text <- renderText({
test_vec3
})
# you can capture values of reactives with isolate, but then, they don't change anymore
# text output of isolated formely reactive vector unique(cars_react()$hp (not changing!)
output$text2 <- renderText({
isolate(unique(cars_react()$hp))
})
# text output of new reactive vector (changes when input$capture button is clicked)
output$text3 <- renderText({
text_vec()
})
}
)
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().