I'm trying to create a plot with a bunch of boxes and then when a box gets clicked on it gets colored in up. I'm having two issues with this. 1. I can't figure out a way for the figure to update dynamically when I click. 2. I can't figure out how to store the values that come out of the click input variable so that I have stored all previous clicks and would be able to color in multiple boxes. You can see a few ways I've tried to solve and test either of the two issues and I'm not having any luck. Any help with either issue would be appreciated.
ui <- fluidPage(
# Application title
titlePanel("Boxes"),
sidebarLayout(
sidebarPanel(
textOutput("text")),
# Get it it's a pun
mainPanel(
plotOutput("boxPlot",click = "test")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
vals <- reactiveValues(x=NA,y=NA,test=NA)
observeEvent(input$click, {
vals$x <- c(vals$x,input$test$x)
vals$y <- c(vals$y,input$test$y)
vals$test <- input$test$x
})
output$boxPlot <- renderPlot({
par(mai=c(0,0,0,0))
plot(1,ylim=c(2,15),xlim=c(2,15),type='n',yaxs='i',xaxs='i',ylab='',xlab='',axes=F)
for (i in 2:15) {
abline(v=i)
abline(h=i)
}
observeEvent(input$click, { rect(floor(input$test$x),floor(input$test$y),ceiling(input$test$x),ceiling(input$test$y),col='blue')})
# if (length(vals$x) > 0) {
# rect(floor(vals$x[1]),floor(vals$y[1]),ceiling(vals$x[1]),ceiling(vals$y[1]),col='blue')
# }
})
# output$text <- renderText(vals$x[length(vals$x)])
output$text <- renderText(vals$test)
}
# Run the application
shinyApp(ui = ui, server = server)
This might be a simple solution.
You should only have one single observeEvent for your click event. In that observeEvent, store your x and y values as reactiveValues as you current are doing.
Then, your renderPlot should plot the grid lines and filled in rectangles based on your reactiveValues. By including input$boxPlot_click (as I called it) in renderPlot the plot will be redrawn each click.
library(shiny)
ui <- fluidPage(
titlePanel("Boxes"),
sidebarLayout(
sidebarPanel(
textOutput("text")),
mainPanel(
plotOutput("boxPlot", click = "boxPlot_click")
)
)
)
server <- function(input, output) {
vals <- reactiveValues(x=NA,y=NA)
observeEvent(input$boxPlot_click, {
vals$x <- c(vals$x,input$boxPlot_click$x)
vals$y <- c(vals$y,input$boxPlot_click$y)
})
output$boxPlot <- renderPlot({
input$boxPlot_click
par(mai=c(0,0,0,0))
plot(1,ylim=c(2,15),xlim=c(2,15),type='n',yaxs='i',xaxs='i',ylab='',xlab='',axes=F)
for (i in 2:15) {
abline(v=i)
abline(h=i)
}
for (i in seq_along(length(vals$x))) {
rect(floor(vals$x),floor(vals$y),ceiling(vals$x),ceiling(vals$y),col='blue')
}
})
output$text <- renderText(paste0(vals$x, ', ' , vals$y, '\n'))
}
shinyApp(ui = ui, server = server)
Related
The code at the bottom is taken from an example in https://shiny.rstudio.com/articles/modules.html though I de-modularized it so I can understand something more basic. With this code, each click of the action button renders a counter which counts the number of clicks. Fine.
Instead of counting the number of clicks in the same output of verbatimTextOutput() as the code currently works, I'd like each click to be represented as a new output of verbatimTextOutput(). See illustration below which shows what I'm trying to derive, assuming the user clicks the action button 3 times. I don't know how many times the user will click the action button so there's no way to pre-set or hard-code the number of outputs and assign output names such as output$out1, output$output2, etc. Is there a way to reactively generate the outputs names, as a I naively attempted in the below code with output$"paste(out,count())" and verbatimTextOutput("paste(out,count())") (without the quote marks, I only put them in so the example code would work)? If this is possible this could be a way to achieve the results I am seeking.
Illustration:
Code:
library(shiny)
newOutput <- function(x,y){verbatimTextOutput("paste(out,count())")}
ui <- fluidPage(uiOutput("uiButton"))
server <- function(input,output,session){
count <- reactiveVal(0)
observeEvent(input$button, {count(count() + 1)})
output$"paste(out,count())" <- renderText({count()})
count
output$uiButton <-
renderUI(
tagList(
actionButton("button", label = "Click me"),
newOutput()
)
)
}
shinyApp(ui, server)
This is an alternative approach using insertUI.
Compared to #stefan's renderUI based solution it has the advantage, that the UI elements are rendered only once. Using renderUI every element is re-rendered on button click, accordingly things will slow down depending on the number of elements.
library(shiny)
ui <- fluidPage(
actionButton("add", "Add UI")
)
server <- function(input, output, session) {
observeEvent(input$add, {
output_name <- paste0("out_", input$add)
output[[output_name]] <- renderText({
isolate(input$add)
})
insertUI(
selector = ifelse(input$add == 0L, "#add", paste0("#", "out_", input$add-1)),
where = "afterEnd",
ui = verbatimTextOutput(output_name)
)
}, ignoreNULL = FALSE)
}
shinyApp(ui, server)
Also check ?removeUI.
Adapting this example to dynamically create graphs to your example you could do:
library(shiny)
library(purrr)
newOutput <- function(x) {
verbatimTextOutput(x)
}
ui <- fluidPage(
actionButton("button", label = "Click me"),
uiOutput("uiText")
)
server <- function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
i <- count()
output_name <- paste("out", i)
output[[output_name]] <- renderText({
i
})
})
output$uiText <- renderUI({
out_list <- map(seq_len(count()), ~ {
tagList(
newOutput(paste("out", .x))
)
})
tagList(out_list)
})
}
shinyApp(ui, server)
I would like to use a Shiny app to load a file (tab-separated), dynamically create a checkboxGroupInput, after the loading of the file (using observeEvent) using the column headers, then subset the data frame that comes from the file based on the selected checkboxes. The data is then plotted using code I can't share right now.
All is working fine, apart from the last bit: subsetting the dataframe based on the selected checkboxes in checkboxGroupInput. The checkboxes all start selected, and the plot is created fine. If you un-select one of the checkboxes, the plot re-plots appropriately for a split second (so the subsetting is working fine) then the unselected checkbox re-selects itself and the plot goes back to the old plot.
This is the tiny problem I'm trying to solve, guessing it's one line of code. I'm assuming it's because of some reactivity that I don't understand and the checkbox constantly resetting itself.
Here is an example:
###
## Some functions I can't share
### Shiny app
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MagicPlotter"),
# Sidebar
sidebarLayout(
sidebarPanel(
fileInput(inputId = "myInputID",
label = "Your .csv file",
placeholder = "File not uploaded"),
uiOutput("mylist"),
uiOutput("submitbutton")
),
# Show a plot
mainPanel(
verticalLayout(
plotOutput("myPlot"))
)
)
)
# Define server
server <- function(input, output) {
output$myPlot <- renderPlot({
inputfile <- input$myInputID
if(is.null(inputfile))
{return()}
mydataframe <- read.table(file=inputfile$datapath, sep="\t", head=T, row.names = 1)
mydataframecolumnnames <- colnames(mydataframe[1:(length(mydataframe)-1)])
# the last column is dropped because it's not relevant as a column name
observeEvent(input$myInputID, {
output$mylist <- renderUI({
checkboxGroupInput(inputId="mylist",
label="List of things to select",
choices=mydataframecolumnnames,
selected=mydataframecolumnnames)
})
})
observeEvent(input$myInputID, {
output$submitbutton <- renderUI({
submitButton("Subset")
})
})
mysubset <- mydataframe[input$mylist]
myPlot(mysubset)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks all
I think there are a few things that might help...
One, you can move your observeEvent methods outside of your renderPlot.
Also, you can create a reactive function to read in the data table.
I hope this helps.
server <- function(input, output) {
myDataFrame <- reactive({
inputfile <- input$myInputID
if(is.null(inputfile))
{return()}
read.table(file=inputfile$datapath, sep="\t", head=T, row.names = 1)
})
output$myPlot <- renderPlot({
req(input$mylist)
mysubset <- myDataFrame()[input$mylist]
plot(mysubset)
})
observeEvent(input$myInputID, {
mydata <- myDataFrame()
mydataframecolumnnames <- colnames(mydata[1:(length(mydata)-1)])
output$mylist <- renderUI({
checkboxGroupInput(inputId="mylist",
label="List of things to select",
choices=mydataframecolumnnames,
selected=mydataframecolumnnames)
})
})
observeEvent(input$myInputID, {
output$submitbutton <- renderUI({
submitButton("Subset")
})
})
}
I have a script which I want to add to my Shiny app, and the original script can be simplified to the following:
plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed")
a <- menu(c(1:5), title="what would you like to change the first point to?")
plot(c(1:3),c(a,4,6), main ="This is second plot I want displayed")
b <- menu(c(1:5), title="what would you like to change the second point to?")
plot(c(1:3),c(a,b,6), main ="This is second plot I want displayed")
The above script plots the first plot, then waits for user input before plotting second, and waits again for user input before plotting third.
However, when I try to convert it to shiny app as seen below, it never updates the first or the second plot, and the things I've tried to make it stop for user input where shown have not worked.
I have tried using req() but it seems to stop the script entirely so the last things are not run at all, and you have to start the entire script over.
So, how can i make it display all plots in sequence, and how can I make the script stop and wait for input before continuing?
if(interactive()){
ui <- fluidPage(
actionButton("button","Click me"),
selectInput("input", "Input", c(1:10)),
textOutput("text"),
plotOutput("plot")
)
server <- function(input, output) {
a<-1
observeEvent(input$button, {
output$plot <- renderPlot(plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed"))
output$text <- renderText("Please select a number to multiply the first point with")
#This is where I want the script to wait for user input
output$plot <- renderPlot(plot(c((1),(2),(3)),c((input$input),(a),(3)), main="This is plot the second plot"))
a<-a+1
#Here I want the script to wait for user input again
output$plot <- renderPlot(plot(c((1),(2),(3)),c((input$input),(a),(3)), main="This is plot the third plot"))
})
}
shinyApp(ui=ui, server=server)
}
The goal is that it updates the plots when they are rendered in the code, and that it waits for user input until script continues, instead of just keeping going.
Perhaps this is what you want.
req is used to only display when a variable is available. You need to create the second renderUI in the server since you cannot use req in the ui part.
if(interactive()){
ui <- fluidPage(
plotOutput("plot1"),
numericInput ("num1", "Please select a number to multiply the first point with", NA, 1, 10),
plotOutput("plot2"),
uiOutput("num2"),
plotOutput("plot3")
)
server <- function(input, output) {
output$plot1 <- renderPlot(plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed"))
output$plot2 <- renderPlot({
req(input$num1)
plot(c(1:3),c(2*(input$num1),4,(6)),
main="This is plot the second plot"
)
}
)
output$plot3 <- renderPlot({
req(input$num1, input$num2)
plot(c(1:3),c(2*(input$num1)+(input$num2),4,(6)),
main="This is plot the third plot"
)
}
)
output$num2 <- renderUI({
req(input$num1)
numericInput ("num2", "Please select a number to add to first point", NA, 1, 10)
})
}
shinyApp(ui=ui, server=server)
}
To be honest, I´m not 100% sure if I know what you expect, even after reading your text 5 times. I have a guess ;-).
Your pause function, which cause plots to render one step after another can be done with invalidateLater. This has to "live" inside a reactiveValue. I don´t know exactly who is the creator of this function, I saved it in my snippets (all glory to the unknown person).
To render a plot or run a script based on the input of a user, try to catch it by using an if statement.
Hope this helps :-).
library(shiny)
if(interactive()){
ui <- fluidPage(
selectInput("input", "Input", c(1:10)),
actionButton("apply", "Apply"),
textOutput("text"),
plotOutput("plot")
)
server <- function(input, output, session) {
rv <- reactiveValues(i = 0)
maxIter <- 10
observeEvent(input$apply, {
rv$i <- 0
observe({
isolate({
rv$i <- rv$i + 1
})
if (isolate(rv$i) < maxIter){
invalidateLater(2000, session)
}
})
})
output$plot <- renderPlot( {
if(rv$i > 0) {
if(input$input <= 4) {
plot(c((rv$i*1),(rv$i*2),(rv$i*3)),c((1),(2),(3)), main = sprintf("Input <= 4; Round %i", rv$i), type = "l")
} else {
plot(c((rv$i*1),(rv$i*5),(rv$i*4)),c((1),(2),(3)), main = sprintf("Input > 4; Round %i", rv$i), type = "l")
}
} else {
plot(c(1:3),c(2,4,6), main ="This is first plot")
}
})
}
shinyApp(ui=ui, server=server)
}
I am quite new to R shiny and so have not been able to figure out the solution from similar questions posted on this site. I am trying to read and use the input that a user provides to R shiny to generate an output.
I am trying to create a simple GUI where a user selects the name of a person (from a drop-down menu) and then enters his/her weight. If the height is above a certain threshold the output recommendation is "Gain Weight", else it is "Loose Weight".
Everything seems to be working fine, except for the following error from the Server.R file:
Error in `$.shinyoutput`(output, value_weight) :
Reading objects from shinyoutput object not allowed
How can I read and use the variable 'value_weight' in an if-then-else condition?
Main.R
library(shiny)
runApp()
Server.R
function(input, output) {
# You can access the value of the widget with input$select, e.g.
output$value_name <- renderPrint({ input$select })
output$value_weight <- renderPrint({ input$num })
if(output$value_weight > 150)
{
output$value_recommendation <- "Loose Weight"
}
else{
output$value_recommendation <- "Gain Weight"
}
}
UI.R
names_list <- list("Adam", "Jenna","Peter")
fluidPage(
selectInput("select", label = h3("Select Name"), choices = names_list, selected = 1),
hr(),
fluidRow(column(3, verbatimTextOutput("value_name"))),
numericInput("num", label = h3("Enter Weight"), value = 0),
hr(),
fluidRow(column(3, verbatimTextOutput("value_weight"))),
hr(),
fluidRow(column(3, verbatimTextOutput("value_recommendation")))
)
The problem in your code is the line
if(output$value_weight > 150)
Generally speaking, outputs are write-only objects in the server, while inputs are readonly. If you replace output$value_weight with input$num, everything should work fine. You also need to use a render-function for outputs: in this case renderPrint or renderText (see the documentation for the difference between those two render functions).
## server.R
function(input, output) {
# You can access the value of the widget with input$select, e.g.
output$value_name <- renderPrint({ input$select })
output$value_weight <- renderPrint({ input$num })
output$value_recommendation <- renderPrint({
if(input$num > 150)
"Loose Weight"
else
"Gain weight"
})
}
Another way to do this is using a call to the function reactive
## server.R
function(input, output) {
# You can access the value of the widget with input$select, e.g.
output$value_name <- renderPrint({ input$select })
value_weight <- reactive({ input$num })
output$value_weight <- renderPrint({ value_weight() })
output$value_recommendation <- renderPrint({
if(value_weight() > 150)
"Loose Weight"
else
"Gain weight"
})
}
Using 'renderText' solved the issue!
Server.R
function(input, output)
{
output$value_market <- renderPrint({ input$select })
output$value_demand <- renderPrint({ input$num })
output$value_recommendation <- renderText({
if(input$num > 150)
{
print("Loose Weight")
}
else{
print("Gain Weight")
}
})
}
Quick question on conditionalPanel for shiny/R.
Using a slightly modified code example from RStudio, consider the following simple shiny app:
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "input.n > 20",
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
My objective is to hide the graph and move up the HTML text to avoid a gap. Now, you can see that if the entered value is below 20, the graph is hidden and the text "Bottom" is moved up accordingly. However, if the entered value is larger than 20, but smaller than 50, the chart function returns NULL, and while no chart is shown, the text "Bottom" is not moving up.
Question is: is there a way I can set a conditionalPanel such that it appears/is hidden based on whether or not a plot function returns NULL? The reason I'm asking is because the trigger a bit complex (among other things it depends on the selection of input files, and thus needs to change if a different file is loaded), and I'd like to avoid having to code it on the ui.R file.
Any suggestions welcome,
Philipp
Hi you can create a condition for conditionalPanel in the server like this :
n <- 200
library("shiny")
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "output.cond == true", # here use the condition defined in the server
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output, session) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
# create a condition you use in the ui
output$cond <- reactive({
input$n > 50
})
outputOptions(output, "cond", suspendWhenHidden = FALSE)
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
Don't forget to add the session in your server function and the outputOptions call somewhere in that function.