RStudio and Shiny: define a reactiveValues with a Reactive - r

I am having a dataframe that is build depending on user input, choosing different filters. I then want to create a bar plot from this custom dataframe where the user can click on to exclude bars from the plot. I basically followed this example:
https://gallery.shinyapps.io/106-plot-interaction-exclude/
However, when I try to define my reactiveValues value with my reactive, I can not define it and get an error. I am suspecting I can not define a reactiveValues with a reactive, is this right? How should I handle this then? Should I use reactives instead of reactiveValues?
Example code:
Server
server <- function(input, output) {
df <- reactive({
input$input1
})
vals2 <- reactive({
(df())
})
output$Id1 <- renderText({
vals2()
})
vals <- reactiveValues()
vals$bla <- df()
}
UI
library(shiny)
ui <- fluidPage(
fluidRow(
column(width= 4,
textInput(inputId = "input1", label = "Select number of rows", value = "10")
),
column(width = 12,
verbatimTextOutput(outputId = "Id1"),
verbatimTextOutput(outputId = "Id2")
)
)
)

Create your reactiveValues towards the beginning of your function and initialise is with a NULL
vals <- reactiveValues(bla = NULL)
You can then write to vals$bla from inside observeEvent, for instance when a button is pressed.
You can read from the reactiveValue, for instance to draw a plot in the form:
output$myPlot <- renderPlot( some function of values$bla )
EDIT updating to add my comment, create an observeEvent which watches your input1, when this changes it will execture the code within {} which will write to your reactiveValue.
observeEvent(input$input1, {
vals$bla <- input$input1
})

Related

RShiny: Refer to data from UI in server

Example Case: I have a function in my global.R called get_data which returns a list of many items. The reason I don't just put the data in global is so the data can automatically refresh after a certain amount of time
ui.R
my_data <- uiOutput("data") # Doesn't work
### Some more generic manipulation before final use
# The output of my_data will look like the following below.
my_data <- list()
my_data$first_entry <- c("a", "b", "d")
my_data$second_entry <- c("x", "y", "z") # and so on
shinyUI(navbarPage(theme=shinytheme("flatly"),
'App Name',
tabPanel('Title',
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
width=3,
# new box
checkboxGroupButtons(
'name',
'label:',
choices = sort(my_data$first_value),
status = 'primary',
selected = sort(my_data$first_value)[1],
size = 'xs'
# inline = TRUE
))
server.R
shinyServer(function(input, output, session) {
data <- reactive({
invalidateLater(100000,session)
get_data()
})
output$data <- renderUI({
data()
})
})
Two questions:
Is there any way of referencing my_data correctly?
If my function get_data is simply reading a (large) csv which is updated systematically. Is there a better way of doing it than I am currently doing it?
I think you're wondering how to define possible choices= for something within the UI element, when the data is both (1) undefined at the start, and (2) changing periodically. The answer to that is to define it "empty" and update it as the new data is found.
library(shiny)
library(shinyWidgets)
get_data <- function() as.list(mtcars[sample(nrow(mtcars), size=3), sample(ncol(mtcars), size=3)])
logg <- function(...) message(paste0("[", format(Sys.time()), "] ", ...))
shinyApp(
ui = fluidPage(
title = "Hello",
checkboxGroupButtons(inputId = "cb", label = "label:", choices = c("unk"), selected = NULL,
status = "primary", size = "xs"),
br(),
textOutput("txt"),
br(),
textAreaInput("txtarea", NULL, rows = 4)
),
server = function(input, output, session) {
data <- reactive({
logg("in 'data'")
invalidateLater(3000, session)
get_data()
})
observe({
logg("in 'observe'")
req(length(data()) > 0)
updateCheckboxGroupButtons(session = session, inputId = "cb", choices = names(data()))
updateTextAreaInput(session, "txtarea", value = paste(capture.output(str(data())), collapse = "\n"))
})
output$txt <- renderPrint({
logg("in 'txt'")
req(length(data()) > 0)
str(data())
})
}
)
Notice that the definition of checkboxGroupButtons starts with no real choices. I'd prefer to start it empty, but unlike selectInput and similar functions, it does not like starting with an empty vector. It is quickly (nearly-immediately) changed, so I do not see "unk" in the interface.
I demoed two options for "displaying" the data in its raw form: as an output "txt", and as an updatable input "txtarea". I like the latter because it deals well with fixed-width, but it requires an update* function (which is really not a big deal).

How to Set Values in selectInput R Shiny for a long set of options

I am creating an R Shiny app where I have an extremely long list of options for selectInput. Depending on the option you select, the value is going to change. I know that for a small list of options you can set the values yourself in the server function like so:
server <- function(input, output) {
output$graph <- renderPlot({
player <- switch(input$var,
"LeBron James" = 23,
"Kobe Bryant" = 24,
"DeMar DeRozan" = 10,
"Kyle Lowry" = 7)
plotGraph(player)
})
}
But my list has at least 100 options and it's certainly not clean nor efficient to set the values like this for all 100 options. Is there a way to set the values depending on the option selected without having to do it manually?
Below is my code in my ui function
ui <- fluidPage(
titlePanel(h1("Fantasy Dashboard")),
sidebarLayout(
sidebarPanel(h2("Player Name Goes Here"),
selectInput("playername",
label = "Choose a player",
choices = player_choices,
selected = NULL),
),
mainPanel(plotOutput("graph"))
)
)
The choices will be stored in player_choices. These choices are read from a txt file. And depending on the option selected, the variable player should be set to the corresponding value. Thanks in advance!
Try:
library(shiny)
playernames <- list("Smith","Johnston","Andrew")
shinyApp(
ui = fluidPage(
uiOutput("selectname"),
textOutput("result")
),
server = function(input, output) {
output$selectname <- renderUI( {
selectInput("playername", "Choose player",playernames)})
output$result <- renderText({
paste("You chose", input$playername)
})
}
)
The playernames list can also be reactive and be modified by other inputs.

Multiple reactiveValues In a Shiny App

I use reactiveValues in Shiny a lot as they are more flexible than just the input and output objects. Nested reactiveValues are tricky since any changes in any of the children also triggers the reactivity linked to the parents. To get around this, I tried to make two different reactiveValues objects ( not two objects in the same list, but two different lists altogether ) and it seems to be working. I'm not able to find any example of this and want to find out if it's suppose to work this way. Are there any issues that might arise because of this?
In this app, there are two reactive values objects - reac1 and reac2. Each of them are linked to a drop down, column1 and column2 respectively. Changing column1 or column2 updates the reactive values with the latest time, updates the plot, and prints the latest values in reac1 and reac2.
ui = fluidPage(
titlePanel("Multiple reactive values"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "column1", "Reac1", letters, selected = "a"),
selectInput(inputId = "column2", "Reac2", letters, selected = "a")
),
mainPanel(
plotOutput("plot1")
)
)
)
server = function(input, output, session) {
reac1 <- reactiveValues(asdasd = 0)
reac2 <- reactiveValues(qweqwe = 0)
# If any inputs are changed, set the redraw parameter to FALSE
observe({
input$column2
reac2$qweqwe = Sys.time()
})
observe({
input$column1
reac1$asdasd = Sys.time()
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$plot1 <- renderPlot({
print(paste(reac1$asdasd, 'reac1'))
print(paste(reac2$qweqwe, 'reac2'))
hist(runif(1000))
})
}
shinyApp(ui, server)
ReactiveValues are like a read/write version of input$, and you can have several 'independent' variables inside one reactiveValue list. So, you do not need two reactive values in your example. See code below.
ui = fluidPage(
titlePanel("Multiple reactive values"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "column1", "Reac1", letters, selected = "a"),
selectInput(inputId = "column2", "Reac2", letters, selected = "a")
),
mainPanel(
verbatimTextOutput("txt1"),
verbatimTextOutput("txt2")
)
)
)
server = function(input, output, session) {
reac <- reactiveValues()
#reac2 <- reactiveValues(qweqwe = 0)
# If any inputs are changed, set the redraw parameter to FALSE
observe({
reac$asdasd = input$column1
})
observe({
reac$qweqwe = input$column2
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$txt1 <- renderPrint({
print('output 1')
print(paste(reac$asdasd, 'reac1'))
})
output$txt2 <- renderPrint({
print('output2')
print(paste(reac$qweqwe, 'reac2'))
})
}
shinyApp(ui, server)

Using length of checkboxGroupInput as an input for a loop to create multiple elements

I'm creating Shiny app and I want to use checkboxGroupInput in order to print out multiple plots. However, I want to print out plots only for the elements of checkboxGroupInput that were checked. There is a similar example in Shiny gallery to create UI elements in a loop that uses lapply. Here is a simplified version of that example to show what I want to do:
#server.R
library(shiny)
library(ggplot2)
shinyServer(function(input, output, session) {
numberInput <- reactive({
input$checkbox
})
lapply(1:10, function(i) {
output[[paste0('b', i)]] <- renderPlot({
qplot(x = rnorm(100, mean = as.numeric(numberInput()[i]))) +
ggtitle(paste("This plot was plotted with", numberInput()[i], "option"))
})
})
})
#ui.R
library(shiny)
shinyUI(fluidPage(
title = 'lapply example',
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Checkbox",
choices = sample(1:10, 5))
),
mainPanel(
lapply(1:10, function(i) {
plotOutput(paste0('b', i))
})
)
)
))
This works, but obviously when Shiny tries to extract numberInput()[i] where i is bigger than number of currently checked elements, there is nothing to extract and instead of a plot there is an error. Therefore I need to somehow tell lapply to iterate only n number of times where n is length(input$checkbox).
I tried to use length(input$checkbox) directly, tried putting that element in the numberInput() reactive statement and returning it as the list, I tried to use reactiveValues() in a following way:
v <- reactiveValues(n = length(input$checkbox))
lapply(1:isolate(v$n), function(i) {
However, in all of those instances Shiny complains about lack of active reactive context.
So, what am I missing? How can I use length of input in lapply outside of reactive context?
I've generally had more luck using this approach (only because it's easier for me to wrap my head around it), but the idea is to render your plots into a UI on the server and then render the UI in ui.R
#server.R
library(shiny)
library(ggplot2)
server <- shinyServer(function(input, output, session) {
output$checks <- renderText(input$checkbox)
output$plots <- renderUI({
plot_output_list <-
lapply(input$checkbox,
function(i){
plotOutput(paste0("plot", i))
})
do.call(tagList, plot_output_list)
})
observe({
for (i in input$checkbox) {
local({
local_i <- i
output[[paste0("plot", local_i)]] <-
renderPlot({
qplot(x = rnorm(100, mean = as.numeric(local_i))) +
ggtitle(paste("This plot was plotted with", local_i, "option"))
})
})
}
})
})
#ui.R
library(shiny)
ui <- shinyUI(fluidPage(
title = 'lapply example',
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Checkbox",
choices = sample(1:10, 5))
),
mainPanel(
verbatimTextOutput("checks"),
uiOutput('plots')
)
)
))
shinyApp(ui = ui, server = server)

Interactive plotting in shiny using mouse clicks

I am doing a project where I use the shiny server and connect R to mongodb to fetch results from database and display it dynamically.
However, I face the following problem in it. I initially get the results from db and make a plot. After this plot is done, I want the user to make make two mouse clicks on the plot based on which it should take the two values as xlim and plot a zoomed version of the previous plot. However, I am not able to do it successfully.
Here is the code that I have written.
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("LOAD AND PERFORMANCE DASHBOARD"),
sidebarLayout(
sidebarPanel(
fluidRow(
selectInput("select", label = h3("Select type of testing"),
choices = list("Performance Testing"=1, "Capacity Testing"=2)),
radioButtons("radio", label = h3("Select parameter to plot"),
choices = list("Disk" = 1, "Flit" = 2,"CPU" = 3,"Egress" =4,
"Memory" = 5))
)),
mainPanel(
plotOutput("plot",clickId="plot_click"),
textOutput("text1"),
plotOutput("plot2")
)
)
))
server.R
library(shiny)
library(rmongodb)
cursor <- vector()
shinyServer(function(input, output) {
initialize <- reactive({
mongo = mongo.create(host = "localhost")
})
calculate <- reactive({
if(input$radio==1)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "disk")
else if(input$radio==2)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "flit")
else if(input$radio==3)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "cpu")
else if(input$radio==4)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "egress")
else if(input$radio==5)
xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "memory")
})
output$plot <- renderPlot({
initialize()
value <- calculate()
plot(value,xlab="Time",ylab="% Consumed")
lines(value)
cursor <- value
})
output$text1 <- renderText({
paste("You have selected",input$plot_click$x)
})
output$plot2 <- renderPlot({
plot(cursor[cursor<input$plot_click$x && cursor>first_click ],xlab="Time",ylab="% Consumed") lines(cursor)
first_click <- input$plot_click$x
})
})
Thanks in advance for the help :)
Here's a simple example that demonstrates the behavior you want, just run this code (or save as a file and source it). This code uses the new observeEvent function that debuted in Shiny 0.11, which just hit CRAN over the weekend.
The basic idea is that we track two reactive values, click1 and range. click1 represents the first mouse click, if any exists; and range represents the x-values of both mouse clicks. Clicking on the plot simply manipulates these two reactive values, and the plotting operation reads them.
library(shiny)
ui <- fluidPage(
h1("Plot click demo"),
plotOutput("plot", clickId = "plot_click"),
actionButton("reset", "Reset zoom")
)
server <- function(input, output, session) {
v <- reactiveValues(
click1 = NULL, # Represents the first mouse click, if any
range = NULL # After two clicks, this stores the range of x
)
# Handle clicks on the plot
observeEvent(input$plot_click, {
if (is.null(v$click1)) {
# We don't have a first click, so this is the first click
v$click1 <- input$plot_click
} else {
# We already had a first click, so this is the second click.
# Make a range from the previous click and this one.
v$range <- range(v$click1$x, input$plot_click$x)
# And clear the first click so the next click starts a new
# range.
v$click1 <- NULL
}
})
observeEvent(input$reset, {
# Reset both the range and the first click, if any.
v$range <- NULL
v$click1 <- NULL
})
output$plot <- renderPlot({
plot(cars, xlim = v$range)
if (!is.null(v$click1$x))
abline(v = v$click1$x)
})
}
shinyApp(ui, server)

Resources