I am trying to write a simple app in Shiny R.
I would like to have two inputs (x and y) and plot the relative scatter plot. The code is the following
library(shiny)
ui<-fluidPage(
headerPanel('Plot'),
sidebarPanel(
sliderInput(inputId = 'x',label='X', value = 1,min=1,max=3),
sliderInput(inputId = 'y',label='Y', value = 1,min=1,max=3)
),
mainPanel(
plotOutput('plot')
)
)
server<-function(input,output) {
x <- reactive({input$x})
y <- reactive({input$y})
output$plot <- renderPlot({plot(x,y)})
}
shinyApp(ui=ui, server=server)
The code produce an error,
cannot coerce type 'closure' to vector of type 'double'
How can I correct this?
Thank you very much
X and Y are functions so add () to them
output$plot <- renderPlot({plot(x(),y())})
You could use this server argument instead:
server <- function(input,output) {
output$plot <- renderPlot(plot(input$x,input$y))
}
input values are already reactive so there's no need to wrap them in reactive() function. Here's your shiny in a neater, working way:
library(shiny) {
ui<-fluidPage(
headerPanel('Plot'),
sidebarPanel(
sliderInput(inputId = 'x', label= 'X', value = 1, min= 1, max= 3),
sliderInput(inputId = 'y', label= 'Y', value = 1, min= 1, max= 3)
),
mainPanel(plotOutput('plot'))
server<-function(input, output) {
output$plot<- renderPlot({
plot(input$x, input$y)
})
}
shinyApp(ui= ui, server= server)
Related
I would like to preserve the output from one input and then add more outputs.
Code:
if (interactive()) {
ui <- fluidPage(
sidebarPanel(
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
)
),
mainPanel(
plotOutput("plot")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output$plot <- renderPlot({
if (input$plotType == "scatter") {
plot(x, y)
} else {
breaks <- input$breaks
if (breaks == "custom") {
breaks <- input$breakCount
}
hist(x, breaks = breaks)
}
})
}
shinyApp(ui, server)
}
Right now the output from "Scatter" disappears if for instance I select "Histogram". I would like to keep the scatter plot and add the histogram below it, and I would like to do this indefinitely.
I tried to do a few things but I didn't know what I needed to look for or learn.
Perhaps, I can add a button called Insert new plot which resets the inputs and saves the recently made plot, and then I can choose new inputs and generate a plot, and so on.
I merged two screenshots to create a picture of what I would like to achieve
Here is a solution that only shows the histogram when the plottype was selected, but keeps the scatter plot and also the histogram once it was selected. For this I use a second plot output and req with a flag if the histogram was already selected.
if (interactive()) {
ui <- fluidPage(
sidebarPanel(
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
)
),
mainPanel(
plotOutput("plot"),
plotOutput("plot_2")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
hist_flag <- FALSE
output$plot <- renderPlot({
plot(x, y)
})
output$plot_2 <- renderPlot({
req(input$plotType == "hist" || hist_flag)
breaks <- input$breaks
if (breaks == "custom") {
breaks <- input$breakCount
}
hist_flag <<- TRUE
hist(x, breaks = breaks)
})
}
shinyApp(ui, server)
}
Edit
The scenario you describe is a good use-case for modules. I've created a module that contains all the logic and ui to output one plot, and then add another module every time one clicks the button:
library(shiny)
one_plotUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
one_plot <- function(id, x, y, type, breaks, break_counts) {
moduleServer(
id,
function(input, output, session) {
output$plot <- renderPlot({
if (type == "scatter") {
plot(x, y)
} else {
if (breaks == "custom") {
breaks <- break_counts
}
hist(x, breaks = breaks)
}
})
}
)
}
ui <- fluidPage(
sidebarPanel(
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
),
actionButton("make_plot", "Insert new plot")
),
mainPanel(
div(id = "add_here")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
counter_plots <- 1
observeEvent(input$make_plot, {
current_id <- paste0("plot_", counter_plots)
# call the logic for one plot
one_plot(id = current_id,
x = x,
y = y,
type = input$plotType,
breaks = input$breaks,
break_counts = input$breakCount)
# show the plot
insertUI(selector = "#add_here",
ui = one_plotUI(current_id))
# update the counter
counter_plots <<- counter_plots + 1
})
}
shinyApp(ui, server)
Here is a way to create an arbitrary number of plots.
library(tidyverse)
library(shiny)
library(glue)
ui <- fluidPage(actionButton("add_sepal_length", "Add Sepal.Length Histogram"),
actionButton("add_sepal_width", "Add Sepal.Width Histogram"),
uiOutput("plot_ui"))
server <- function(input, output, session){
number_of_plots <- reactiveVal(0L)
output$plot_ui <- renderUI({
req(number_of_plots()>0)
seq(number_of_plots(),1) %>% map(~plotOutput(glue("plot_{.}")))
})
observeEvent(input$add_sepal_length,{
output[[glue("plot_{number_of_plots() +1}")]] <- renderPlot(hist(iris$Sepal.Length))
number_of_plots(number_of_plots() + 1L)
})
observeEvent(input$add_sepal_width,{
output[[glue("plot_{number_of_plots() +1}")]] <- renderPlot(hist(iris$Sepal.Width))
number_of_plots(number_of_plots() + 1L)
})
}
shinyApp(ui = ui, server = server)
The basic idea is that you can use renderPlot to add to ouput$ by string. The observeEvent creates the plot on demand. Put whatever plotting logic you want in here. This takes care of the server part. The UI is handled by a single renderUI which returns a list of plotOutputs.
My logic here is very simple. I use a map() function which only needs to know the id. You could do something fancy involving a whole lot of parameters. One time I did a project where I had arbitrarily many selectInputs. I stored the parameters in a tibble inside of a reactiveVal and used pmap() inside the renderUI.
I am getting an error with the plotting index using plotly in conjunction with reactive values in shiny. The sidebar panel loads with no issues but there is a problem displaying the chart that I cannot determine. Any help solving the index problem would be much appreciated. Thanks!
library(shiny)
library(plotly)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({economics[, c(input$xcol, input$ycol)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(x = input$x, y = input$y)) +
geom_line()
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
Warning: Error in : Unsupported index type: NULL
You have mistakenly used xcol and ycol not sure why. Without those names the code works fine.
library(shiny)
library(plotly)
library(tidyverse)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({
economics[, c(input$x, input$y)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(input$x, input$y)) +
geom_line()
ggplotly(p, height = input$plotHeight)
})
}
shinyApp(ui, server)
I am trying to create an easy application with R shiny. However I could not get the desired output I want. I am neither experienced in shiny nor an expert of R. Here is the code:
library(shiny)
ui <- fluidPage(
headerPanel("deneme"),
checkboxGroupInput("plots", "draw plots:",
choices=list("histogram", "qq","both"),
selected="histogram"),
sidebarPanel(
numericInput("mean", "rn mean", value=seq(0:5), min=0, max=5),
numericInput("sd","standart deviation",value=seq(0:5),min=0,max=5),
numericInput("n", " number of observations ", value=seq(30,50))
),
mainPanel(
textOutput("text1"),
fluidRow(splitLayout(cellWidths = c("60%", "40%"),
plotOutput("graph1"), plotOutput("graph2")))
)
)
server <- function(input, output) {
norm<-reactive({
set.seed(6)
rnorm(input$n,mean=input$mean,sd=input$sd)
})
output$text1<-renderText({
paste("A random normal distrubution of",
input$n, "observations is generated with parameters mean",
input$mean,"and standart deviation", input$sd)
})
output$graph1<-renderPlot({
if(identical(input$plots,"histogram")){
req(norm())
hist(norm())
}
})
output$graph2<- renderPlot({
if(identical(input$plots,"qq")) {
req(norm())
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
}
})
observe({
if(identical(input$plots,"both")) {
req(norm())
output$graph1<- renderPlot({
hist(norm())
})
output$graph2<- renderPlot({
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
})
}
})
}
shinyApp(ui = ui, server = server)
I want the plot layout change dynamically according to selection of checkboxGroupInput. When I click histogram or qq I want it to plot an unsplit frame, into only one plotting frame. Whereas when I click both I want the plots to be seen together in a split frame of two rows. When unclicked the layout must be reset to one frame again. I know I am not doing it right by splitting the layout in ui first. I saw something about renderUI function but could not understand how it works. Thanks in advance.
Also I got some error related to if statement:
Warning in if (!is.na(attribValue)) { :
the condition has length > 1 and only the first element will be used
Warning in charToRaw(enc2utf8(text)) :
argument should be a character vector of length 1
all but the first element will be ignored
Here is a start, you don't need the observer, you can just add an if statement to each renderPlot.
Update: The trick to getting the plots to update dynamically is to assign them into a list and then render the list of plots with renderUI, the only caveat to this is that I am unaware of a way to get these plots to render side-by-side at the moment, it probably has something to do with adding some div tags...
Update 2: To get the plots side by side we just need to wrap the plotOutput in column
library(shiny)
ui <- fluidPage(
headerPanel("deneme"),
checkboxGroupInput("plots", "draw plots:",
choices=list("histogram", "qq"),
selected="histogram"),
sidebarPanel(
numericInput("mean", "rn mean", value=1, min=0, max=5),
numericInput("sd","standart deviation",value=1,min=0,max=5),
numericInput("n", " number of observations ", value=30)
),
mainPanel(
textOutput("names"),
textOutput("text1"),
fluidRow(uiOutput("plot_list"))
)
)
server <- function(input, output) {
norm<-reactive({
set.seed(6)
rnorm(input$n,mean=input$mean,sd=input$sd)
})
output$text1<-renderText({
paste("A random normal distribution of",
input$n, "observations is generated with parameters mean",
input$mean,"and standart deviation", input$sd)
})
output$histogram <- renderPlot({
req(norm())
if("histogram" %in% input$plots){
hist(norm())
}
})
output$qq <- renderPlot({
req(norm())
if("qq" %in% input$plots){
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
}
})
output$plot_list <- renderUI({
plot_output_list <- lapply(input$plots,
function(plotname) {
column(width=5, plotOutput(plotname)) ##wrap the plotOutput in column to render side-by-side
})
# Convert the list to a tagList - this is necessary for the list of items
# to display properly.
do.call(tagList, plot_output_list)
})
}
shinyApp(ui = ui, server = server)
You can have a single plotOutput and use mfrow to split it into two panels, like this:
library(shiny)
ui <- fluidPage(
headerPanel("deneme"),
radioButtons("plots", "draw plots:",
choices=list("histogram", "qq","both"),
selected="histogram"),
sidebarPanel(
numericInput("mean", "rn mean", value=seq(0:5), min=0, max=5),
numericInput("sd","standart deviation",value=seq(0:5),min=0,max=5),
numericInput("n", " number of observations ", value=seq(30,50))
),
mainPanel(
textOutput("text1"),
plotOutput("graph")
)
)
server <- function(input, output) {
norm<-reactive({
set.seed(6)
rnorm(input$n,mean=input$mean,sd=input$sd)
})
output$text1<-renderText({
paste("A random normal distrubution of",
input$n, "observations is generated with parameters mean",
input$mean,"and standart deviation", input$sd)
})
output$graph = renderPlot({
if(input$plots == "both") {
par(mfrow = c(1, 2))
}
if(is.element(input$plots, c("histogram", "both"))) {
req(norm())
hist(norm())
}
if(is.element(input$plots, c("qq", "both"))) {
req(norm())
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
}
})
}
shinyApp(ui = ui, server = server)
If you want two rows instead of two columns, just change par(mfrow = c(1, 2)) to par(mfrow = c(2, 1)).
(I'm still getting the error on if too, but it doesn't seem to affect the functioning of the app, at least as far as the graphs are concerned. I'm not sure where it's coming from.)
I was wondering if I can get rows data using nearPoints() from an interactive graph with slider input. My app.R file looks like:
library('shiny')
library('ggplot2')
dt <-read.csv('file.csv')
ui <- fluidPage(
plotOutput("plot1", height = 550, click = "plot1_click"),
fluidRow(
column(3,
sliderInput("Obs", "Number of Books", min = 1, max = nrow(up), value = 50)
),
column(3, offset = 3,
h4("Legends"),
verbatimTextOutput("selected")
)
)
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$plot1 <- renderPlot({
test <- mydata()
ggplot(data = test, aes(x = test[,2], y = test[,1])) + geom_point()
})
output$selected <- renderPrint({
file <- mydata()
nearPoints(file, input$plot1_click, threshold = 10, maxpoints = 1,
addDist = FALSE)
})
}
shinyApp(ui = ui, server = server)
Shiny nearPoints() is working perfectly without this slider input. When I used slider input, I can't get the row data until max. Is there any approach to work with the slider input? Any help is appreciated.
The following code works for me. It seems nearPoints is not able to tell which columns of your dataset are displayed because of the aes(x = test[,2], y = test[,1]) statement. Another possible fix sould be to set the parameters xvar and yvar in nearPoints.
library('shiny')
library('ggplot2')
dt <-mtcars
ui <- fluidPage(
plotOutput("plot1", height = 550, click = "plot1_click"),
fluidRow(
column(3,
sliderInput("Obs", "Number of Cars", min = 1, max = nrow(dt), value = 50)
),
column(3, offset = 3,
h4("Legends"),
verbatimTextOutput("selected")
)
)
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$plot1 <- renderPlot({
test <- mydata()
ggplot(data = test, aes(mpg, wt)) + geom_point()
})
output$selected <- renderPrint({
file <- mydata()
nearPoints(file, input$plot1_click, threshold = 100, maxpoints = 1,
addDist = FALSE)
})
}
shinyApp(ui = ui, server = server)
Quick note: Please try to make the code in your question reproducible by using one of the default datasets in R. You can get a list of all available datasets by calling data().
sliderInput("myslider", "Slider:", min=1, max=100, value=6)
returns a slider with tickmark labels at 1, 11, 21, 31,...,91 and 100.
I would love the heuristic that is determining these tickmark labels to return more reasonable values of 1, 10, 20, 30,, ...90, 100.
I imagine this comes up a lot, as a slider from 1 to 100 is a very common one. (If you set min=0, it does show the desired tickmark labels, but in many apps, you don't want the input to be 0.
Currently, there is no way to supply user-defined tickmark labels to sliderInput. Is there a workaround just for the labels?
A similar question is posted here, but it talks about creating user-defined tick marks, not the labeling.
In https://groups.google.com/forum/#!topic/shiny-discuss/AeAzR4p2h1g is a solution of this problem:
ui <- pageWithSidebar(
headerPanel("Slider labels"),
sidebarPanel(
uiOutput("slider")
),
mainPanel()
)
server <- function(input, output) {
output$slider <- renderUI({
args <- list(inputId="foo", label="slider :", ticks=c(90,95,99,99.9), value=c(2,3))
args$min <- 1
args$max <- length(args$ticks)
if (sessionInfo()$otherPkgs$shiny$Version>="0.11") {
# this part works with shiny 1.5.0
ticks <- paste0(args$ticks, collapse=',')
args$ticks <- T
html <- do.call('sliderInput', args)
html$children[[2]]$attribs[['data-values']] <- ticks;
} else {
html <- do.call('sliderInput', args)
}
html
})
}
runApp(list(ui = ui, server = server))
By now this can be done using htmltools::tagQuery:
library(shiny)
library(htmltools)
ui <- basicPage(h1("Custom sliderInput ticks"),
{
customTicks <- seq_len(15)
customSlider <- sliderInput(
inputId = "sliderinput",
label = "sliderInput",
min = 1,
max = max(customTicks),
value = 7,
step = 1,
ticks = TRUE
)
tagQuery(customSlider)$find("input")$addAttrs("data-values" = paste0(customTicks, collapse = ", "))$allTags()
})
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)