Shiny Reactivity - r

I've got an application with a large number of parameters. Each parameters has lots of granularity which make finding the desired one a pain. This causes the reactive portion to constantly calculate which slows things down. I added a submitButton which solved the above problem but then experience another problem in turn.
Below is a simple replication of the framework I build. The parameter input takes in a number from 1 to 1000, which indicates the sample to which I want. What I would like to do is be able to do above but also be able to resample with the same set of parameters. What is happening now after adding the submit button is that it renders the resample button inoperable unless I click resample first AND then update button.
Any ideas of making them both working separately?
shinyServer(function(input, output) {
getY<-reactive({
a<-input$goButton
x<-rnorm(input$num)
return(x)
})
output$temp <-renderPlot({
plot(getY())
}, height = 400, width = 400)
})
shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("num",
"Number of Samples",
min = 2,
max = 1000,
value = 100),
actionButton("goButton", "Resample"),
submitButton("Update View")
),
mainPanel(
tabsetPanel(
tabPanel("Heatmap",
plotOutput("temp")
),
tabPanel("About"),
id="tabs"
)#tabsetPanel
)#mainPane;
))
EDIT based on Joe's Answer:
shinyServer(function(input, output) {
getY<-reactive({
isolate({a<-input$goButton
x<-rnorm(input$num)
return(x)})
})
output$temp <-renderPlot({
b<-input$goButton1
plot(getY())
}, height = 400, width = 400)
})
shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("num",
"Number of Samples",
min = 2,
max = 1000,
value = 100),
actionButton("goButton", "Resample"),
actionButton("goButton1","Update View")
),
mainPanel(
tabsetPanel(
tabPanel("Heatmap",
plotOutput("temp")
),
tabPanel("About"),
id="tabs"
)#tabsetPanel
)#mainPane;
))

The answer was given by Joe Cheng in a comment above, but seeing that the OP had difficulty understanding it, I write it out explicitly below, for the record:
# ui.R
library("shiny")
shinyUI(
pageWithSidebar(
headerPanel("Example")
,
sidebarPanel(
sliderInput("N", "Number of Samples", min = 2, max = 1000, value = 100)
,
actionButton("action", "Resample")
)
,
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plotSample"))
,
id = "tabs1"
)
)
)
)
# server.R
library("shiny")
shinyServer(
function(input, output, session) {
Data <- reactive({
input$action
isolate({
return(rnorm(input$N))
return(x)
})
})
output$plotSample <-renderPlot({
plot(Data())
} , height = 400, width = 400
)
})
Note that having input$action inside reactive(), where "action" is the actionButton's inputID, is enough to trigger a new rendering of the plot. So you need only one actionButton.

change getY so that all but the first line is wrapped in isolate({ ... })
change submitButton to actionButton
add a line inside of renderPlot to read the new actionButton

Related

Storing entire code inside the action button

I want to put my whole code inside the action button. As i click the button my whole code dashboard should be visible in my screen(which i am getting right now in my code)
But firstly i must be able to see only that button.
Here is the sample dashboard which i am trying to put in my button.
I have not make the button in this code as this is quite straight forward.Can somebody help please?
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
You can use req in outputs, for e.g.:
output$plot1 <- renderPlot({
req(input$button)
data <- histdata[seq_len(input$slider)]
hist(data)
})
Then the output will only be shown if the input is being used.
You can also put things in conditionalPanel(). You can use that in the UI part of the script. For example:
fluidRow(conditionalPanel(condition = "input.button == true",
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
Note that the condition is in javascript.
I've given your button a name and made it TRUE/FALSE but you would need to adapt that depending on the input button.

Return a table from R shiny observe()

I want to create a vector by using observe() in R shiny. In the code blow, how can I create a vactor where all the input$n are concatenated. At the present time, I can only display a single value but could not concatenate and display all the inputs from the sliderInput.
ui.R
library(shiny)
fluidPage(
titlePanel("Observer demo"),
fluidRow(
column(4, wellPanel(
sliderInput("n", "N:",
min = 10, max = 1000, value = 200, step = 10)
)),
column(8,
tableOutput("text")
)
)
)
server.R
library(shiny)
function(input, output, session) {
observed=reactiveValues(
input=NULL
)
observe({
observed$input=input$n
# observed$input=c(observed$input,input$n) # tried this but not working
})
output$text <- renderTable({
observed$input
})
}
If you add print(observed$input) in your observer, you will see that when you use observed$input=c(observed$input,input$n) you run into an infinite loop as the observe is reactive to observe$input and will run again as soon as you modify it.
To prevent this, you can use isolate:
observed$input=c(isolate(observed$input),input$n)
As in #Pork Chop 's answer, you can also use observeEvent to only observe input$n.
Try this, you can use cbind or rbind depending on your needs
rm(list = ls())
library(shiny)
ui <- fluidPage(
titlePanel("Observer demo"),
fluidRow(
column(4, wellPanel(
sliderInput("n", "N:",
min = 10, max = 1000, value = 200, step = 10)
)),
column(8,
tableOutput("text")
)
)
)
server <- function(input, output, session) {
observed=reactiveValues(
input=NULL
)
observeEvent(input$n,{
observed$input <- cbind(observed$input,input$n)
})
output$text <- renderTable({
print(observed$input)
observed$input
})
}
shinyApp(ui <- ui, server <- server)

Shiny Application actionButton click on page load

I am building a Shiny application using the navbarPage() type. I have three tabs - the initial tab has a textInput() box that has default text defined. The mainPanel() of that page has a histogram and a table. On page load those update and reflect the proper information when the application is launched based on that default text.
The second tab is supposed to present a wordcloud based on that default text. When I switch over to that tab there is an error - if I go back to the first tab and enter new text and hit the actionButton - the wordcloud will update, but it won't do so until I perform that action.
Is there a way to have the actionButton() or some sort of submit happen when the page loads so the tab with the wordcloud can update? Or maybe I just need to make a variable global or something. I'm not sure. I've spent quite a bit of time on this and have hit a wall. Any help would be greatly appreciated.
Code for the UI:
tabPanel("Word Cloud Diagram",
fluidRow(
sidebarPanel(
width = 3,
h5("The sentence input:"),
wellPanel(span(h5(textOutput(
'sent'
)), style = "color:red")),
sliderInput(
"maxWC",
h5("Maximum Number of Words:"),
min = 10,
max = 100,
value = 50
),
br(),
#actionButton("update", "Update Word Cloud"),
hr(),
helpText(h5("Help Instruction:")),
helpText(
"Please have a try to make the prediction by using
the dashboard on right side. Specifically, you can:"
),
helpText("1. Type your sentence in the text field", style =
"color:#428ee8"),
helpText(
"2. The value will be passed to the model while you are typing.",
style = "color:#428ee8"
),
helpText("3. Obtain the instant predictions below.", style =
"color:#428ee8"),
hr(),
helpText(h5("Note:")),
helpText(
"The App will be initialized at the first load.
After",
code("100% loading"),
", you will see the prediction
for the default sentence example \"Nice to meet you\"
on the right side."
)
),
mainPanel(
h3("Word Cloud Diagram"),
hr(),
h5(
"A",
code("word cloud"),
"or data cloud is a data display which uses font size and/
or color to indicate numerical values like frequency of words. Please click",
code("Update Word Cloud"),
"button and",
code("Slide Input"),
"in the side bar to update the plot for relevant prediction."
),
plotOutput("wordCloud"),
# wordcloud
br()
)
)),
Code for the server:
wordcloud_rep <- repeatable(wordcloud)
output$wordCloud <- renderPlot({
v <- terms()
wordcloud_rep(
v[, 2],
v[, 1],
max.words = input$maxWC,
scale = c(5, 1.5),
colors = brewer.pal(4, "Dark2")
)
})
Also, I am using a single file application "app.R" - not sure if this is useful information or not. Again, on the first tab, default text is presented on the first page load, I just want this to extend to the wordcloud on page load so the plot is shown immediately without having to enter and submit new text. Thanks!
Here is an example that should be close to what you want. The trick is to use a submitButton. The wordcloud will have a default plot based on initial input, but will change when you change the text and press the submit button.
library(shiny)
library(wordcloud)
ui <- shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
textInput("text", "Input Text", "Random text random text random is no yes"),
submitButton("Submit")
),
mainPanel(
tabsetPanel(
tabPanel("Tab1",
plotOutput("hist"),
tableOutput("hist_table")),
tabPanel("Tab2",
plotOutput("wordcloud"))
)
)
)
))
server <- shinyServer(function(input, output) {
observe({
word_list = strsplit(input$text, " ")
word_table = as.data.frame(table(word_list))
output$hist = renderPlot({
barplot(table(word_list))
})
output$hist_table = renderTable({
word_table
})
output$wordcloud = renderPlot({
wordcloud(word_table[,1], word_table[,2])
})
})
})
shinyApp(ui = ui, server = server)
Since the use of submitButton() is generally discouraged in favour of the more versatile actionButton() (see here for function documentation), here is a version of the answer above that uses a combination of actionButton() and eventReactive() with ignoreNULL = FALSE so that the plots show up upon launching the app.
library(shiny)
library(wordcloud)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("text", "Input Text", "Random text random text random is no yes"),
actionButton("submit", "Submit")
),
mainPanel(
tabsetPanel(
tabPanel(
"Tab1",
plotOutput("hist"),
tableOutput("hist_table")
),
tabPanel(
"Tab2",
plotOutput("wordcloud")
)
)
)
)
)
server <- shinyServer(function(input, output) {
word_list <- eventReactive(input$submit,{
strsplit(input$text, " ")
},
ignoreNULL = FALSE
)
word_table <- reactive(
as.data.frame(table(word_list()))
)
output$hist <- renderPlot({
barplot(table(word_list()))
})
output$hist_table <- renderTable({
word_table()
})
output$wordcloud <- renderPlot({
wordcloud(word_table()[, 1], word_table()[, 2])
})
})
shinyApp(ui = ui, server = server)
The solution to making the action button run on the first load is a simple one. Just add an ifelse statement.
Original:
eventReactive(input$submit, ...
New:
eventReactive(ifelse(input$submit == 0, 1, input$submit), ...
Yes, it's just that easy!

Change size of image with a slider in Shiny

Goal: Make an image change size in response to moving a slider in Shiny (RStudio). Think zoom-in-zoom-out effect.
Problem: There's an error saying "Error in basename(imageinfo$src) : a character vector argument expected". I can't find anything that directly answers the question and I'm not sure what else to try. Is it just a problem with how sliderInput is used as input$slider in server.R?
My current progress: My rational was to set up the slider in the ui.R file and then have the width of the image be the input in the server.R file.
The ui.R part:
shinyUI(fluidPage(
titlePanel("Nancy's Brainstorming"),
sidebarLayout(
sidebarPanel(
h3(
strong("What is this?", style = "font-si24pt")),
p("This is a pilot project."),
sliderInput("slider",
label = "",
min = 100,
max = 300,
value = 200),
imageOutput("logo", width = 200)
)
)
))
The server.R part:
shinyServer(function(input, output) {
output$logo = renderImage({
img(src = "mylogo.png", width = input$slider)
})
})
Additional information: The image shows up just fine by itself when I use img(src = "mylogo.png", width = 200). Also, I'm doing this just to get a better feel for building Shiny apps.
img(src = "mylogo.png", width = input$slider) is just returning html. You can use renderUI instead of renderImage.
library(shiny)
runApp(
list(ui = fluidPage(
titlePanel("Nancy's Brainstorming"),
sidebarLayout(
sidebarPanel(
h3(
strong("What is this?", style = "font-si24pt")),
p("This is a pilot project."),
sliderInput("slider", label = "", min = 100, max = 300, value = 200),
uiOutput('logo')
),
mainPanel(
plotOutput("distPlot")
)
)
),
server = function(input, output, session) {
output$logo <- renderUI({
img(src = "http://i.stack.imgur.com/mTqXa.png", width = as.integer(input$slider))
})
}
)
)

Shiny reactiveUI hangs with multiple uiOutput calls on same condition variable

I am trying to make a reactive UI with sliders that drop in and out via a dropdown in shiny. I have a server with reactiveUI sliders (server.R):
library(shiny)
shinyServer(function(input, output) {
output$slider1 <- reactiveUI(function() {
sliderInput("s1", "slide 1", min = 1, max = 100, value = 1)
})
output$slider2 <- reactiveUI(function() {
sliderInput("s2", "slide 2", min = 1, max = 100, value = 1)
})
})
I can run the server fine with the following code (ui.R):
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
selectInput("dataset", "number of buckets:",
choices = c(1,2,3)),
conditionalPanel(
condition = "input.dataset==2",
uiOutput("slider1"),uiOutput("slider2")),
conditionalPanel(
condition = "input.dataset==1",
sliderInput("s1", "slide 1", min = 1, max = 100, value = 1)
)
),
mainPanel(
)
))
but if I try to make both conditionalPanels call uiOutput, the server freezes:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
selectInput("dataset", "number of buckets:",
choices = c(1,2,3)),
conditionalPanel(
condition = "input.dataset==2",
uiOutput("slider1"),uiOutput("slider2")),
conditionalPanel(
condition = "input.dataset==1",
uiOutput("slider1")
)
),
mainPanel(
)
))
I have played around with this, and found that it happens anytime that use the same condition variable and multiple uiOutput calls. Any suggestions? Thanks.
See the comment from #Joe for the answer.
Basically, outputIDs and inputIDs have to be unique; two UI elements with the same IDs on the same page emits and error. This is a limitation of the reactivity in shiny.
The work around from #Jim is to create multiple elements for each output or input used by the client, e.g.
output$slider2_1 <- ...
output$slider2_2 <- ...

Resources