I'm trying to use the value(s) of input$levels in the plot as the title but selectInput is only displaying the first value when multiple are selected. The plot itself changes in the correct way, which means shiny knows that multiple levels are selected.
library(tidyverse)
library(shiny)
test_data <- data.frame(x = seq(1, 100, 10),
y = seq(1, 100, 10),
level = rep(c(1, 2), 5))
ui <- fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("levels",
"Include level(s):",
selected=1,
choices=c(1, 2),
multiple=TRUE)
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
ggplot(test_data %>%
filter(level %in% input$levels), aes(x, y)) +
geom_point() +
ggtitle(paste("Including level(s):", input$levels))
})
}
shinyApp(ui, server)
How does one access all values of selectInput when multiple are selected?
input$levels contains a vector of your selected items. To make them appear in the title of your graph, you can do:
ggtitle(paste("Including level(s):", paste(input$levels,collapse=', ')))
Hope this helps!
Related
I went a totally different direction in this project -- the issue I have is down at the end I need to clear out the graph when a different variable is selected. The graph as it is stays the same. Thanks.
I am not even sure how this would be phrased in the documents -- rewriting graphs, dynamic plotting ??? I saw display.removePlot(display.activePlotIndex()) but am not sure about that -- what do I look up to figure this out?
library(shiny)
library(DT)
library(ggplot2)
oboler_data <- read_csv(file = "C:/Users/12083/Desktop/ref.csv")
rdate <- as.Date(oboler_data$DATE,"%m/%d/%y")
ui <- fluidPage(sidebarLayout(
sidebarPanel(
selectInput("dataset", "choose a dataset", c("oboler_data")),
selectInput("column", "Type of Transaction", "placeholder1"),
selectInput("level", "select level", "placeholder2")
),
mainPanel(tableOutput("table"), plotOutput("Histo"))
))
server <- function(input, output, session){
dataset <- reactive({
get(input$dataset)
})
observe({
updateSelectInput(session, "column", choices = names(dataset()))
})
observeEvent(input$column, {
column_levels <- as.character(sort(unique(
dataset()[[input$column]]
)))
updateSelectInput(session, "level", choices = column_levels)
})
output$table <- renderTable({
subset(dataset(), dataset()[[input$column]] == input$level)
})
DF <- data.frame(Name = LETTERS[1:10], Value = rnorm(20), Value2 = runif(20))
output$TableOut <- renderDataTable({
DF
})
output$Histo <- renderPlot({
ggplot(DF, aes(Value)) + geom_histogram(binwidth = 0.1,
fill = "blue", color = "white")
})
}
shinyApp(ui, server)
I think you should use req, as it precludes (and clears!) rendering of a plot if conditions are not met.
library(shiny)
shinyApp(
ui = fluidPage(
checkboxInput("cb", "Plot?"),
sliderInput("cyls", "Cylinders", min = 1, max = 8, value = 4, step = 1),
plotOutput("plt")
),
server = function(input, output, session) {
output$plt <- renderPlot({
req(input$cb, input$cyls)
ggplot(mtcars[mtcars$cyl >= input$cyls,,drop = FALSE],
aes(disp, mpg, color = factor(cyl))) +
geom_point()
})
}
)
The three screenshots above are in sequence: start with "Plot?" deselected, no plot shown; select it, plot appears; deselect it, existing plot disappears.
The way you adapt this to you is to replace the req(input$cb) with something that matches your condition of "clear the plot". (I also included input$cyls here just to prevent larger more-complex apps from reaching the plot block before all inputs have stabilized. Perhaps not required in most apps, but it's a defensive move that carries little consequence if it is overkill, but lots of benefit when it is needed.)
A slight modification on a theme, "telling the user why the plot disappeared". Replace the req with a validate and at least one need:
# req(input$cb, input$cyls)
validate(
need(input$cb, "You deselected \"Plot!\"")
)
I have created a shiny app should take input from three sliders and:
Plots a distribution in ggplot
Show a summary table of values underneath the plot in #1 above
If I just want to plot the histogram (and I comment out the table data), I can get the code to work correctly. However, when I add the table, the plot disappears even though the plot header is still there. I have tried moving the commas a braces around to see if it's a simple syntax error but haven't had any luck.
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Test Shiny Layout"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
h4("Input Data"),
sliderInput("bins", "Bin Width", min = 4,max = 12, value = 8),
),
# Show a plot of the generated distribution
mainPanel(
h4("Histogram"),
plotOutput("distPlot", width = "600", height = "600"),
h4("Table of Values"),
tableOutput("table")
)
)
))
Server
library(shiny)
library(ggplot2)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
bins <- input$bins
df1 <- (iris$Sepal.Length)
x <- mean(df1)
y <- sd(df1)
ggplot(data = iris) +
geom_histogram(mapping = aes(x = Sepal.Length), color = "blue", binwidth = "bins")
# Create an empty dataframe and then plug in the mean and standard deviation
results <- data.frame("0", "0")
results[1,1] = x
results[1,2] = y
colnames(results) <- c("Mean", "SD")
rownames(results) <- c("Sepal Length")
output$table <- renderTable(results)
})
})
Your renderTable() is inside your renderPlot() call. So renderPlot isn't returning anything.
You were right: it was a simple syntax error. But you also had several other issues in your code. At least a dozen. Three in binwidth = "bins" alone.
Here's a working version. I suspect you will still want to make tweaks, but at least you have both a histogram and a summary table that both look reasonably sensible.
library(shiny)
library(ggplot2)
data(iris)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
ggplot(data = iris) +
geom_histogram(aes(x = Sepal.Length), color = "blue", bins = input$bins)
})
output$table <- renderTable({
iris %>%
summarise(Mean=mean(Sepal.Length),
SD=sd(Sepal.Length))
})
}
ui <- fluidPage(
titlePanel("Test Shiny Layout"),
sidebarLayout(
sidebarPanel(
h4("Input Data"),
sliderInput("bins", "Bin Width", min = 4,max = 12, value = 8),
),
mainPanel(
h4("Histogram"),
plotOutput("distPlot", width = "600", height = "600"),
h4("Table of Values"),
tableOutput("table")
)
)
)
shinyApp(ui = ui, server = server)
I am working on a shiny app where I allow a user to select the plotting criteria and then also allow them to brush the plot and see their selection in a table below. I have some NA values in my data. I have noticed that these NAs end up in my brushed point table as full rows of NA. I can remove these manually with something like this. However, I was wondering if I perhaps was doing something wrong on my brush that was causing this.
Code with a working example is below. I have also included an image of a brush selection demonstrating what I mean.
library(shiny)
library(tidyverse)
# replace some random values in mtcars with NA
set.seed(1)
mtnew <-
as.data.frame(lapply(mtcars, function(m)
m[sample(
c(TRUE, NA),
prob = c(0.8, 0.2),
size = length(m),
replace = TRUE
)]))
# set up UI that allows user to pick x and y variables, see a plot,
# brush the plot, and see a table based on the brush
ui <- fluidPage(
titlePanel("Shiny Test"),
sidebarLayout(
sidebarPanel(
selectInput("xvar",
"pick x",
choices = names(mtnew)),
selectInput("yvar",
"pick y",
choices = names(mtnew))),
mainPanel(
plotOutput("myplot",
brush = brushOpts(id = "plot_brush")),
tableOutput("mytable")
)
)
)
server <- function(input, output) {
output$myplot <- renderPlot({
ggplot(data = mtnew) +
geom_point(aes(x = !!rlang::sym(input$xvar),
y = !!rlang::sym(input$yvar)))
})
output$mytable <- renderTable({
brush_out <- brushedPoints(mtnew, input$plot_brush)
})
}
# Complete app with UI and server components
shinyApp(ui, server)
I guess that you'll have to establish which data you want to represent.
You may want to have only defined record without NAs, in that case I would suggest to use the complete.cases function. Yet this solution will highly reduce your data set (below I've applied to your code).
Another option is to preserve all your records but without the NAs. In that case you should consider using imputation methods to set proper values in replacement. Take a look at this post which provides an example.
library(shiny)
library(tidyverse)
# replace some random values in mtcars with NA
set.seed(1)
mtnew <-
as.data.frame(lapply(mtcars, function(m)
m[sample(
c(TRUE, NA),
prob = c(0.8, 0.2),
size = length(m),
replace = TRUE
)]))
mtnew_complete <- mtnew[complete.cases(mtnew),]
# set up UI that allows user to pick x and y variables, see a plot,
# brush the plot, and see a table based on the brush
ui <- fluidPage(
titlePanel("Shiny Test"),
sidebarLayout(
sidebarPanel(
selectInput("xvar",
"pick x",
choices = names(mtnew)),
selectInput("yvar",
"pick y",
choices = names(mtnew))),
mainPanel(
plotOutput("myplot",
brush = brushOpts(id = "plot_brush")),
tableOutput("mytable")
)
)
)
server <- function(input, output) {
output$myplot <- renderPlot({
#ggplot(data = mtnew) +
ggplot(data = mtnew_complete) +
geom_point(aes(x = !!rlang::sym(input$xvar),
y = !!rlang::sym(input$yvar)))
})
output$mytable <- renderTable({
#brush_out <- brushedPoints(mtnew, input$plot_brush)
brush_out <- brushedPoints(mtnew_complete, input$plot_brush)
})
}
# Complete app with UI and server components
shinyApp(ui, server)
I am trying to run an interactive rshiny plot. I have this output:
I want to be able to subset and plot by country, by scenario, by variable, by year (4 selections). I also want to be able to add value points by year and not have the whole plot by year done immediately.
I am only able to subset by country. My scenario and variable dropdowns are not reactive. And it plots all variables with all scenarios although I want one variable plot by one scenario and one country
How can I make my graph interactive?
library(reshape2)
library(lattice)
library(plyr)
library(shiny)
library(dplyr)
library(abind)
library(ggplot2)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices=unique(dmiubf$country), selected = ""),
selectInput("Senario","Show senario:", choices = unique(dmiubf$scn)),
selectInput("var","Show senario:", choices = unique(dmiubf$var)),
selectInput("year","Show vertical line in year(s):", choices = unique(dmiubf$year),multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a = dmiubf[dmiubf$var==input$var, dmiubf$scn==input$senario]<-dmiubf[dmiubf[,"country"]=="Costa Rica",input$senario]<-"base"
dmiubf
})
output$chart <- renderPlot({
req(input$radio)
if (input$radio==c("Costa Rica")) {
plot0<-ggplot(data=cr()) + geom_point(aes(x=year,y=pcn, fill=scn),
size = 6)
print(plot0)
}
})
}
shinyApp(ui = ui, server = server)
I tried fixing your app, but without knowing how the input data looks like, its a bit hard. So i created a random dummy dataset. Therefore it is not always showing a plot, as no data is left after the filtering process.
But as a starting point I think this should help you:
library(shiny)
library(dplyr)
library(ggplot2)
dmiubf <- data.frame(
country=c(rep("Costa Rica",8), rep("England",8), rep("Austria",8), rep("Latvia",8)),
scn = rep(c("base","high","low","extra"),8),
year = sample(c(1998, 1999, 2000, 2001), 32, replace = T),
var = sample(c(1,2,3,4), 32, replace = T),
pcn = sample(c(10,20,30,40), 32, replace = T)
)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices= as.character(unique(dmiubf$country)), selected = ""),
selectInput("Senario","Show senario:", choices = as.character(unique(dmiubf$scn))),
selectInput("var","Show senario:", choices = sort(unique(dmiubf$var))),
selectInput("year","Show vertical line in year(s):", choices = sort(unique(dmiubf$year)), multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a <- dmiubf[as.character(dmiubf$country)==input$radio &
dmiubf$var %in% as.numeric(input$var) &
dmiubf$year %in% as.numeric(input$year) &
as.character(dmiubf$scn)==input$Senario
,]
a
})
output$chart <- renderPlot({
validate(
need(nrow(cr())!=0, "No Data to plot")
)
ggplot(data=cr()) + geom_point(aes(x=year, y=pcn, fill=scn), size = 6)
})
}
shinyApp(ui = ui, server = server)
I have a shiny application with the following ui:
library(rhandsontable)
library(shiny)
library(ggplot2)
ui = fluidPage(
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Summary", rHandsontableOutput('contents'),
actionButton("saveBtn", "Save changes")
),
tabPanel("Tab",
rHandsontableOutput('contentFinal')),
tabPanel("Dashboard",
plotOutput('dashboard1'))
)
)
)
)
And the following server
library(dplyr)
library(rhandsontable)
options(shiny.maxRequestSize = 9*1024^2)
server = function(input, output) {
values <- reactiveValues()
Post <- c("", "")
list2 <- c(12,13)
df <- data.frame(Post, list2)
output$contents <- renderRHandsontable({
rhandsontable(df, width = 550, height = 300) %>%
hot_col(col = "Post", type = "dropdown")
})
saveData <- eventReactive({input$saveBtn},{
finalDF <- hot_to_r(input$contents)
finalDF$Post <- ifelse(finalDF$Post =="",NA,finalDF$Post)
newDF <- finalDF[complete.cases(finalDF),]
return(newDF)
})
output$contentFinal <- renderRHandsontable(
rhandsontable(saveData())
)
output$dashboard1 <- renderPlot(
ggplot(input$contentFinal, aes(x = Post, y = list2 )) +
geom_bar(stat = "identity")
)
observeEvent(input$saveBtn, saveData())
}
shinyApp(ui = ui, server = server)
The flow is like this:
In the first tab, I bring up data with an empty post column
In this tab, I can add a name for the post and save it.
As soon as I save he rows with values for post become visible in the next tab.
Then the next thing I want to do is to have a visual in the dashboard tab that shows the data. Therefore I create:
output$dashboard1 <- renderPlot(
ggplot(input$contentFinal, aes(x = Post, y = List2 )) +
geom_bar(stat = "identity")
)
This however gives me the following ggplot2 errror:
ggplot2 doesn't know how to deal with data of class list
Any thoughts on what goes wrong here?
The problem is because input$contentFinal is handsontable data. We need to convert it to R object using hot_to_r function.
The ggplot should be plotted using the following:
ggplot(hot_to_r(input$contentFinal), aes(x = Post, y = list2 )) +
geom_bar(stat = "identity")
Hope it helps!