I have a scatterplot in a shiny dashbaord and would like to generate two different tables by selecting/highlighting different areas of the scatterplot. I am currently able to generate a single table by selecting/highlighting an area, however am not sure how to make this work for two tables/selections (or if that is even possible).
Any help or advice would be greatly appreciated. Thankyou
Sample code to generate a shiny dashboard with a scatterplot and highlight/generate a single table is provided below (and was taken from here)
Some more detail : Ideally this process would be achieved by manually selecting/dragging an area over some points, generating the first table and then manually selecting/dragging an area over a different subset of points and generating the second table. After this, if another area is selected, it resets the first selection and table and then the next selection would reset the second selection and table.
ui <- fluidPage(
plotOutput("plot", brush = "plot_brush"),
tableOutput("data")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
output$data <- renderTable({
brushedPoints(mtcars, input$plot_brush)
})
}
shinyApp(ui=ui, server=server)
Maybe this might be helpful. You can track which table (1 or 2) in reactiveValues as well as the data for each table. Let me know if this is what you had in mind. If you wanted to maintain the previous selection in the plot, I would think you may need to manually place a rectangle. A github issue allowing for multiple selections of brushed points is an open issue (enhancement). Alternatively, you could tag points for each table based on this approach.
library(shiny)
ui <- fluidPage(
plotOutput("plot", brush = "plot_brush"),
h2("Table 1"),
tableOutput("data1"),
h2("Table 2"),
tableOutput("data2")
)
server <- function(input, output, session) {
rv <- reactiveValues(table = 1,
data1 = NULL,
data2 = NULL)
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
my_data <- eventReactive(input$plot_brush, {
if (rv$table == 1) {
rv$table <- 2
rv$data1 <- input$plot_brush
} else {
rv$table <- 1
rv$data2 <- input$plot_brush
}
return(rv)
})
output$data1 <- renderTable({
brushedPoints(mtcars, my_data()$data1)
})
output$data2 <- renderTable({
brushedPoints(mtcars, my_data()$data2)
})
}
shinyApp(ui=ui, server=server)
Related
This is my first Shiny app, and I just got the basics working to where it allows the user to select from a dropdown menu of clients, then a dropdown menu of test codes to receive a plot of the results for the selected test.
I'd like the second dropdown menu to be updated with the available test codes for that client (all are not present for each client). Also, I would like to be able to hover over the point in the plot and receive more information from the row in the original dataframe.
I've looked into tooltips and the nearPoints() function, but I'm not sure if these can be used on this data since it is manipulated. I'm not sure if at this point it would be easier to import the data in a different way (it will ultimately need to accept either excel files or .csv). Thanks for any help that you would be able to provide, please let me know if there is any other supporting info I can give.
Here is my code:
library(shiny)
library(scales)
library(ggplot2)
labData <-
read.table("MockNLData.csv",
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"]
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"]
<- "0"
#convert results to scientific notation
SciNotResult <-
formatC(as.numeric(as.character(labData$ModResult)),
format="e", digits=2)
ui <- fluidPage(
headerPanel("Dilution History"),
sidebarLayout(
sidebarPanel(
selectInput(inputId="client", label="Select Client
Name", choices=levels(labData$Client.Name)
),
selectInput(inputId="test", label="Select Test Code",
choices=levels(labData$Analysis))
),
mainPanel(
plotOutput("line", hover="plot_hov"),
verbatimTextOutput("info"))
)
)
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
})
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
})
#points to be plotted
points <-
reactive({as.numeric(levels(subsetDF()$ModResult))
[subsetDF()$ModResult]
})
#plot
output$line <- renderPlot({
qplot(seq_along(points()), points(), xlab ="Index",
ylab ="Result")
})
#hover information
output$info <- renderText({
paste0("x=", input$plot_hov$x, "\ny=",
input$plot_hov$y)
})
}
shinyApp(ui = ui, server = server)
Here is what the data looks like:
MockNLData.csv
EDIT: I figured out updating the menu with updateSelectInput()
In the future, make sure you share a reproducible example :)
Since your code is not reproducible please find below something you can understand and adapt to your case.
On your first question, if I understand correctly, you want to programatically generate a dropdown (selectInput) which is perfectly do-able. *Inputs are, in essence, just HTML content which you can dynamically generate, just like your plots. You do so with uiOutput (in your ui) and renderUI in your server.
library(shiny)
ui <- fluidPage(
selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
uiOutput("column"), # dynamic column selector
verbatimTextOutput("selected_column")
)
server <- function(input, output, session){
data <- reactive({
if(input$dataset == "cars")
return(cars)
else
return(mtcars)
})
output$column <- renderUI({
# build your selectInput as you normally would
selectInput("column_selector", "Select a column", choices = colnames(data()))
})
output$selected_column <- renderPrint({
# use input$column_selector!
print(input$column_selector)
})
}
shinyApp(ui, server)
On your second question, what you want is an interactive plot. There are numerous packages that will let you do that in R and Shiny. Below are some examples, by no means a comprehensive list:
plotly which will also let you make your ggplot2 charts interactive
highcharter another great, well tested library
echarts4r ECharts for R.
billboarder billboard.js for R and Shiny
Below is an example using highcharter. They all follow the same principle within Shiny, an *Output function coupled with a render* function.
library(shiny)
library(highcharter)
ui <- fluidPage(
highchartOutput("chart")
)
server <- function(input, output, session){
output$chart <- renderHighchart({
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
})
}
shinyApp(ui, server)
EDIT
Following your question on the flashing error. You need to require (req) the required input. When launching the app below the error will flash, uncomment the req(input$y) line and it'll go away.
library(shiny)
ui <- fluidPage(
uiOutput("sel"),
plotOutput("plot")
)
server <- function(input, output){
output$sel <- renderUI({
numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
})
output$plot <- renderPlot({
# req(input$y)
hist(runif(input$y, 1, 10))
})
}
shinyApp(ui, server)
In essence, since your plot relies on a dynamically generating input for a fraction of second that input is not available as it is being rendered, using req prevents that.
What I understand from your problem above are:
You want to make next dropdown menu based on what the user have chosen from previous dropdown menu.
When the mouse over the point on the plot, it will show row value.
So, here i will give you reproducible example and i hope it is useful for you.
In this example I use Rabbit dataset from library MASS.
To filter data for next dropdown menu, I use filter from library
dplyr (See line 30).
I use reactive expression to manage next dropdown menu (See line
29).
I use nearPoints() to manage hover point (See line 55).
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Rabbit dataset from MASS library"),
fluidRow(
column(4, selectInput("var",
"Animal:",
unique(sort(Rabbit$Animal)))),
column(4, uiOutput("selected_var")),
column(4, uiOutput("selected_var1")),
column(12, plotOutput("selected_var2", hover = "plot_hover")),
column(12, verbatimTextOutput("info"))
)
)
server <- function(input, output) {
###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER
dataset3 <- reactive({
unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
})
output$selected_var <- renderUI({
selectInput("var1", "Treatment:", c(dataset3()))
})
dataset4 <- reactive({
Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
})
output$selected_var1 <- renderUI({
selectInput("var2", "Run:", c(dataset4()))
})
####
output$selected_var2 <- renderPlot({
ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
})
###HOVER POINT USING nearPoints()
output$info <- renderPrint({
nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
})
}
shinyApp(ui = ui, server = server)
I know renderPlot produces plot that can be shown on Shiny plotOutput function. I also know autoinvalidate() helps to calculate data reactively.
I am displaying a radar chart (in fact can be any chart) using the below codes:
output$plot2 <- renderPlot({
autoInvalidate()
p2<<-ggradar(mtcars_radar[i,])
})
What I dont know is how to change the value of i from 1 to 300 during every event of autoinvalidate().
Or is there anyway I can change the row of data in plot so that the plot is dynamically animating every sec with a new row of data.
Can anyone help me plz?
The full code is here:
library(shiny)
library(ggplot2)
mtcars %>%
rownames_to_column( var = "group" ) %>%
mutate_at(vars(-group),funs(rescale)) %>%
tail(4) %>% select(1:10) -> mtcars_radar
ui <- fluidPage(
sidebarPanel(
actionButton("button", "Go!")
),
# Show the plot
mainPanel(
plotOutput("plot2")
)
)
server <- function(input, output) {
library(ggplot2)
library(ggradar)
suppressPackageStartupMessages(library(dplyr))
library(scales)
autoInvalidate <- reactiveTimer(2000)
plot2 <- NULL
output$plot2 <- renderPlot({
ggradar(mtcars_radar[1,])
})
observeEvent(input$button,{
output$plot2 <- renderPlot({
autoInvalidate()
p2<<-ggradar(mtcars_radar[i,])
p2
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help please?
This is where you need a reactive value that stores the row index and changes every second. I do not have the library ggradar, so I will just print out the current row index value instead. I also used invalidateLater instead of reactiveTimer as suggested by Shiny documentation.
library(shiny)
ui <- fluidPage(
verbatimTextOutput("debug")
)
server <- function(input, output) {
row_idx_max <- 15
row_idx <- reactiveVal(0)
observe({
isolate(row_idx(row_idx() + 1))
cur_row_idx <- isolate(row_idx())
if (cur_row_idx < row_idx_max) {
invalidateLater(1000)
}
})
output$debug <- renderPrint({
row_idx()
})
}
shinyApp(ui, server)
I am using plot_click to interrogate a graph in Shiny and would like the conditional panel to show 2 bits of information. However at the moment, the conditional panel shows 'NA' until i perform the plot click, how do i make this disappear?
library(ggplot2)
library(shiny)
# make some data
df <- data.frame(ID=c(1,2),x=c(33,7),y=c(50,16),name=c("Tom","Bill"),link=c("https://mylink.com","https://anotherlink.com"), stringsAsFactors=FALSE)
# Shiny app
ui <- basicPage(
plotOutput("plot", click = "plot_click"),
verbatimTextOutput("selection"),
conditionalPanel("!is.na(output.nametext)",
h4(textOutput("nametext")),
h4(textOutput("urltext")))
)
server <- function(input, output,session) {
output$plot <- renderPlot({
ggplot(data=df,aes(x=x,y=y))+
geom_point()+
scale_x_continuous(limits = c(0, 68))+
scale_y_continuous(limits = c(0, 52.5))
})
output$selection <- renderPrint({
nearPoints(df, input$plot_click)
})
info <- reactive({
t <- as.data.frame(nearPoints(df, input$plot_click))
s <- t[1,4]
u <- t[1,5]
list(s=s,u=u)
})
output$nametext <- renderText({info()$s})
output$urltext <- renderText({info()$u})
}
runApp(shinyApp(ui, server), launch.browser = TRUE)
in the conditionalPanel in the UI, i've tried !is.na(output.nametext), output.nametext != null, output.nametext==true, plot_click==true, plot_click!=null and more. None of them remove the NA that exists before i perform the click.
One solution would be to simply use:
output$nametext <- renderText({
if(!is.na(info()$s)){
info()$s
}
})
You could also use the space to inform the user he should click a point to see information:
output$urltext <- renderText({
if(!is.na(info()$s)){
info()$u
}else{
print("Click on a point to get additional information")
}
})
I teach basic statistics at a local university and am trying to build an app where students can explore the relationship between scatterplots and the Pearson correlation coefficient. I can generate a blank plot and users can click inside the plot to generate points. As points are added a correlation coefficient is displayed. I can clear the map using a reset button; however, i cannot reset the previous points.
I tried assigning the list storing the points to NULL, but for the life I have no clue how to do it.
Any suggestion on clearing the graph so users can start over with a new scatterplot would be greatly appreciated.
A link to a 'working' app: https://uky994.shinyapps.io/ggplotcoords/
My code:
`ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
actionButton("reset", "Reset!")
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
observeEvent(input$reset, {
output$graph <- renderPlot({
plot(data$x, data$y, pch=data$values,col="white",xlim=c(0,100),
ylim=c(0,100),xlab="X",ylab="Y")
})
points$x<-NULL
points$y<-NULL
})
points <- list(x=vector("numeric", 0), y=vector("numeric", 0))
data <- data.frame(x=c(0,100,0,100), y=c(0,0,100,100),
values=c("A","B","C","D"), stringsAsFactors=FALSE)
# Visualization output:
observe({
output$graph <- renderPlot({
plot(data$x, data$y,
pch=data$values,col="white",xlim=c(0,100),
ylim=c(0,100),xlab="X",ylab="Y")
})
})
#v=input$plot_click$x
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
print(points)
points$x <<- c(points$x, isolate(input$plot_click$x))
points$y <<- c(points$y, isolate(input$plot_click$y))
output$graph <- renderPlot({
plot(points$x, points$y,pch=20,col="#7fcdbb",xlim=c(0,100),
ylim=c(0,100),xlab="X",ylab="Y")
})
output$click_info <- renderPrint({
cat("Correlation is:\n")
cor(points$x, points$y)
#length(points$x)
})
})
})
shinyApp(ui=ui,server=server)`
I'm trying to write a little app that will allow the user to make a scatterplot, select a subset of points on the plot, then output a table in .csv format with just those selected points. I figured out how to get the page up and running and how to select points using brushedPoints. The table with selected points appears but when I press the Download button, the error "Reading objects from shinyoutput object not allowed." appears. Am I unable to download the table that I can visually see on the screen as a .csv? If so, is there a workaround?
I've recreated the problem using the iris dataset below. Any help figuring out why I cannot download the table of displayed rows would be greatly appreciated.
data(iris)
ui <- basicPage(
plotOutput("plot1", brush = "plot_brush"),
verbatimTextOutput("info"),mainPanel(downloadButton('downloadData', 'Download'))
)
server <- function(input, output) {
output$plot1 <- renderPlot({
ggplot(iris,aes(x=Sepal.Width,y=Sepal.Length)) +
geom_point(aes(color=factor(Species))) +
theme_bw()
})
output$info <- renderPrint({
brushedPoints(iris, input$plot_brush, xvar = "Sepal.Width", yvar = "Sepal.Length")
})
output$downloadData <- downloadHandler(
filename = function() {
paste('SelectedRows', '.csv', sep='') },
content = function(file) {
write.csv(output$info, file)
}
)
}
shinyApp(ui, server)
The issue is that the output object is generating all of the web display stuff as well. Instead, you need to pull the data separately for the download. You could do it with a second call to brushedPoints in the download code. Better, however, is to use a reactive() function to do it just once, then call that everywhere that you need it. Here is how I would modify your code to make that work:
data(iris)
ui <- basicPage(
plotOutput("plot1", brush = "plot_brush"),
verbatimTextOutput("info"),mainPanel(downloadButton('downloadData', 'Download'))
)
server <- function(input, output) {
output$plot1 <- renderPlot({
ggplot(iris,aes(x=Sepal.Width,y=Sepal.Length)) + geom_point(aes(color=factor(Species))) + theme_bw()
})
selectedData <- reactive({
brushedPoints(iris, input$plot_brush)
})
output$info <- renderPrint({
selectedData()
})
output$downloadData <- downloadHandler(
filename = function() {
paste('SelectedRows', '.csv', sep='') },
content = function(file) {
write.csv(selectedData(), file)
}
)
}
shinyApp(ui, server)
(Note, with ggplot2, you do not need to explicitly set xvar and yvar in brushedPoints. So, I removed it here to increase the flexibility of the code.)
I am not aware of any "lasso" style free drawing ability in shiny (though, give it a week -- they are constantly adding fun tools). However, you can mimic the behavior by allowing user to select multiple regions and/or to click on individual points. The server logic gets a lot messier, as you need to store the results in a reactiveValues object to be able to use it repeatedly. I have done something similar to allow me to select points on one plot and highlight/remove them on other plots. That is more complicated than what you need here, but the below should work. You may want to add other buttons/logic (e.g., to "reset" the selections), but I believe that this should work. I did add a display of the selection to the plot to allow you to keep track of what has been selected.
data(iris)
ui <- basicPage(
plotOutput("plot1", brush = "plot_brush", click = "plot_click")
, actionButton("toggle", "Toggle Seletion")
, verbatimTextOutput("info")
, mainPanel(downloadButton('downloadData', 'Download'))
)
server <- function(input, output) {
output$plot1 <- renderPlot({
ggplot(withSelected()
, aes(x=Sepal.Width
, y=Sepal.Length
, color=factor(Species)
, shape = Selected)) +
geom_point() +
scale_shape_manual(
values = c("FALSE" = 19
, "TRUE" = 4)
, labels = c("No", "Yes")
, name = "Is Selected?"
) +
theme_bw()
})
# Make a reactive value -- you can set these within other functions
vals <- reactiveValues(
isClicked = rep(FALSE, nrow(iris))
)
# Add a column to the data to ease plotting
# This is really only necessary if you want to show the selected points on the plot
withSelected <- reactive({
data.frame(iris
, Selected = vals$isClicked)
})
# Watch for clicks
observeEvent(input$plot_click, {
res <- nearPoints(withSelected()
, input$plot_click
, allRows = TRUE)
vals$isClicked <-
xor(vals$isClicked
, res$selected_)
})
# Watch for toggle button clicks
observeEvent(input$toggle, {
res <- brushedPoints(withSelected()
, input$plot_brush
, allRows = TRUE)
vals$isClicked <-
xor(vals$isClicked
, res$selected_)
})
# pull the data selection here
selectedData <- reactive({
iris[vals$isClicked, ]
})
output$info <- renderPrint({
selectedData()
})
output$downloadData <- downloadHandler(
filename = function() {
paste('SelectedRows', '.csv', sep='') },
content = function(file) {
write.csv(selectedData(), file)
}
)
}
shinyApp(ui, server)