I'm building a Shiny app with a plot_ly scatter plot. I'm using a SharedData object (from the crosstalk package) to share information between the plot and a datatable (from DT).
The problem is when you click a point in the plot it dims the color of all of the other points and adds an entry to the legend for the selected point, and once this happens there doesn't seem to be a way to undo it. I would like to disable these visual changes but still be able to detect plot clicks.
This issue does not occur if I just use a reactive data.frame instead of a SharedData object in the data parameter of the plot_ly call, but then the event_data from the plot doesn't have enough information to select a row in the datatable. (The x and y point coordinates are floating point numeric, so matching by coordinates against the data can have unexpected results.)
Here's a demo using mtcars:
library(shiny)
library(DT)
library(plotly)
library(data.table)
library(crosstalk)
### UI function ---------
ui <- fluidPage(
fluidRow(
plotlyOutput('my_graph', height = '400px')
),
fluidRow(
dataTableOutput('my_table')
)
)
### Server function -------
server <- function(input, output, session) {
### SharedData object ----
filtered_data <- reactive({
data.table(mtcars, keep.rownames = TRUE)
})
shared_data <- reactive({
req(filtered_data())
SharedData$new(filtered_data(), ~rn)
})
### my_graph ----
output$my_graph <- renderPlotly({
p <- plot_ly(shared_data(),
x = ~disp,
y = ~mpg,
color = ~factor(carb),
source = 'm')
p
})
### my_table ---------
output$my_table <- renderDataTable({
datatable(shared_data()$data(),
selection = 'single')
})
observe({
click_detect = plotly::event_data('plotly_hover', source = 'm')
str(click_detect)
dataTableProxy('my_table') %>%
selectRows(match(click_detect$key, shared_data()$data()$rn))
})
}
shinyApp(ui, server)
Why that happens beats me but I can see two possible workarounds.
Force Plotly to set the opacity of all markers to 1.
if (click_detect$curveNumber != 0) {
output$my_graph <- renderPlotly({
p <- plot_ly(shared_data(),
x = ~disp,
y = ~mpg,
color = ~factor(carb),
source = 'm',
marker = list(opacity = 1))
p
})
}
Drawback: The graph flickers.
Change your filterRows statement. I don't know your data but for mtcars you can filter by carb (via curveNumber) and then via pointNumber.
dataTableProxy('my_table') %>% selectRows(
which(mtcars$carb == sort(unique(mtcars$carb))[[click_detect$curveNumber + 1]])[[click_detect$pointNumber + 1]])
I came across the same issue and found an approach using the highlight function. https://www.rdocumentation.org/packages/plotly/versions/4.8.0/topics/highlight
The default setting for non-selected points is opacity=0.2 . This is why the other points dim. So all you need to do is add a pipe %>% highlight(opacityDim = 1)
Use any number between 0 and 1 to reduce the opacity of non-selected traces. If you want to disable it completely, then do 1. Otherwise you can try 0.5 and it worked for me.
In your case, you may try
output$my_graph <- renderPlotly({
p <- plot_ly(shared_data(),
x = ~disp,
y = ~mpg,
color = ~factor(carb),
source = 'm')
p <- highlight(p, opacityDim = 1)
p
})
Hopefully, it helps for whoever need it later.
Related
I want to do table-plot interaction using R-Shiny and Plotly.
After click any point in plot: I want to increase the size of point in graph, color it red also in the table bring corresponding row at top of the table and highlight the row.
Similarly, after clicking (single) row in the table, corresponding point in the plot should be highlighted in red and bigger in size.
As my data is big I need to do this on serve side.
I was able to create the plot and table below is my code.
ui.R file:
ui <- fluidPage(
fluidPage(column(width = 6, plotlyOutput("volcanoplot", height = 350))),
fluidPage(DT::dataTableOutput("de_table"))
)
And server.R file:
library("DT")
library(plotly)
library(shiny)
m <- mtcars[, c("mpg", "wt", "disp")] %>%
tibble::rownames_to_column()
function(input, output, session) {
shared_data <- SharedData$new(m, ~rowname)
output$volcanoplot <- renderPlotly({
pp <- shared_data %>% plot_ly(source = 'volcanoplot') %>%
add_trace(x = ~mpg, y = ~wt, type = 'scatter', mode = "markers")
})
# highlight selected rows in the table
output$de_table <- DT::renderDataTable({
dt <- DT::datatable(shared_data$data() , selection = 'single', rownames= FALSE)})
}
I was able to understand the click and table select variables as,
click_detect = plotly::event_data('plotly_click', source = 'volcanoplot')
s <- input$de_table_rows_selected
Thanks for the help.
In ShinyApp, I want to plot a graph whose name has an interactive input value. So in the ui.R side, the user chooses an input value from 0, 1 or 2. And in the server.R side, I want the App to plot a graph whose name is either pl0, pl1 or pl2. That is to say, if the user chooses 0 as an input value, the App plots a graph pl0, so does the same for pl1 for input 1, and for pl2 and input 2. I am using plotly library for plotting graphs.
I have tried print(), plot(), return(), but neither of them worked.
Any solution or advice would be appreciated. Thank you very much!
Here is my ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Star Cluster Simulations"),
# Sidebar with a slider input for time
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "time",
label = "Select time to display a snapshot",
min = 0,
max = 2,
value = 0)
),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("distPlot")
)
)
))
And here is my server.R
library(shiny)
library(plotly)
# load data
for(i in 0:2) {
infile <- paste0("Data/c_0", i, "00.csv")
a <- read.csv(infile)
b <- assign(paste0("c_0", i, "00"), a)
names(a) <- paste0("c_0", i, "00")
pl <- plot_ly(b, x = ~x, y = ~y, z = ~z, color = ~id) %>%
add_markers() %>%
layout(scene = list(xaxis = list(title = 'x'),
yaxis = list(title = 'y'),
zaxis = list(title = 'z')))
assign(paste0("pl", i), pl)
}
# shinyServer
shinyServer(function(input, output) {
output$distPlot <- renderPlotly({
# this doesn't work
print(paste0("pl", input$time))
})
})
I can't test this since your question isn't reproducible (i.e. doesn't include data), but one way to switch between text values (i.e. the values returned from Shiny inputs) and R objects is by making a reactive expression that uses the switch function. You can call the reactive expression (in the case below, plot.data()) inside renderPlotly (or any other render function) to switch between datasets.
shinyServer(function(input, output) {
plot.data <- reactive({
switch(paste0("pl", input$time),
"pl0" = pl0,
"pl1" = pl1,
"pl2" = pl2)
})
output$distPlot <- renderPlotly({
plot.data()
})
})
I am trying to use Shiny to select variables I want to plot in a multi-line chart rendered using Plotly. I have many variables so I want to select using Shiny instead of using Plotly's interactive legend "click" selection mechanism.
Example Data:
library(plotly)
# Example dataframe
foo <-data.frame( mon = c("Jan", "Feb", "Mar"),
var_1 = c(100, 200, 300),
var_b = c(80, 250, 280),
var_three = c(150, 120,201)
)
When using Plotly directly I can manually add traces using code like this:
p <- plot_ly(x = foo$mon, y = foo$var_1, line = list(shape="linear"))
p <- add_trace(p, x = foo$mon, y = foo$var_b)
p <- add_trace(p, x = foo$mon, y = foo$var_three)
print(p)
Now I want to use a Shiny checkbox to select the variables I wish to see on the plot. The selection is captured in input$show_vars , but how do I loop through and plot this changing list of variables? Here is my app.R code that manually plots one of the variables. Suggestions appreciated!
#------------------------------------------------------------------------------
# UI
#------------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput('show_vars', 'Columns in the dataset', names(foo),
selected = c('mon', 'var_1')),
helpText('Select the variables to show in the graph.')
),
mainPanel(
plotlyOutput("myPlot")
)
)
)
#------------------------------------------------------------------------------
# SERVER
# Need to loop through input$show_vars to show a trace for each one?
#------------------------------------------------------------------------------
server <- function(input, output) {
# a large table, reative to input$show_vars
output$uteTable = renderDataTable({
library(ggplot2)
ute[, input$show_vars, drop = FALSE]
})
output$myPlot = renderPlotly({
plot_ly(x=foo$mon, y=foo$var_1, line = list(shape="linear"))
## How to add the other traces selected in input$show_vars??
})
}
shinyApp(ui = ui, server = server)
UPDATE: I realize now that I need the script to avoid hard-coding the first plot to use foo$var_1. The plot should use any one of the possible selections in the checkboxes (minus $mon, which I have removed from the select list). When I try to make the first plot statement conditional I get the message "Error: The last plot does not exist." ie, this does not work:
output$myPlot = renderPlotly({
# p <- plot_ly(x=foo$mon, y=foo$var_1, line = list(shape="linear"))
for (item in input$show_vars) {
if (item == 1){
p <- plot_ly(x=foo$mon, y=foo[[item]], line = list(shape="linear"))
}
if(item > 1){
p <- add_trace(p, x = foo$mon, y = foo[[item]], evaluate = TRUE)
}
}
print(p)
See if this is what you want. Also you probably want to remove the first two items in the checkboxGroup so that they are not removable (depending on what you want).
output$myPlot = renderPlotly({
p <- plot_ly(x=foo$mon, y=foo$var_1, line = list(shape="linear"))
## How to add the other traces selected in input$show_vars??
for (item in input$show_vars) {
p <- add_trace(p, x = foo$mon, y = foo[[item]], evaluate = TRUE)
}
print(p)
})
I am trying to create Shiny App which is able to display interactive plot title (dependent on the choosen value for x axis)
Very simple example:
library(shiny)
library(DT)
library(ggplot2)
x <- as.numeric(1:1000000)
y <- as.numeric(1:1000000)
z <- as.numeric(1:1000000)
data <- data.frame(x,y, z)
shinyApp(
ui = fluidPage(selectInput(inputId = "yaxis",
label = "Y-axis",
choices = list("x","y","z"),
selected = c("x")),
dataTableOutput('tableId'),
plotOutput('plot1')),
server = function(input, output) {
output$tableId = renderDataTable({
datatable(data, options = list(pageLength = 10, lengthMenu=c(10,20,30)))
})
output$plot1 = renderPlot({
filtered_data <- data[input$tableId_rows_all, ]
ggplot(data=filtered_data, aes_string(x="x",y=input$yaxis)) + geom_line()
})
}
)
I have tried this code:
ggtitle("Line plot of x vs",input$yaxis)
It was not working, plot has not been displayed, giving me an Error:
Warning: Error in ggtitle: unused argument (input$yaxis)
[IMPORTANT]
using ggtitle(input$yaxis) gives me an interactive title, however i need to build up a sentence (like: Line plot of x vs input$yaxis), in which the reactive argument (input$yaxis) is a part of it!
Thanks for any help!
Cheers
Change:
ggtitle("Line plot of x vs",input$yaxis)
To
ggtitle(paste("Line plot of x vs",input$yaxis))
As the error suggests, you have too many arguments passed to the ggtitle function, paste will create a single character out of your two inputs, with a space in between. You can vary the separation between the two with sep =.
I'm developing an R Shiny dashboard using the Iris data in the ggplot2 dataset.
It has three main components, a sidebar panel to select the variables to display in the plot, a ggplot with brushed points and a datatable below which shows the data of the brushed points.
Everything works perfectly except the datatable does not seem to select the data points on the table. From what I can tell it has something to do with the line output$plot_brushed_points in the server.
Any help would be greatly appreciated!
library(shiny)
library(ggplot2)
useri <- shinyUI(pageWithSidebar(
headerPanel("Reactive Plot"),
sidebarPanel(
selectInput('x','X-Axis',names(iris)),
selectInput('y','Y-Axis',names(iris)),
selectInput('color','Color',c('None',names(iris[5])))),
mainPanel(uiOutput("plotui"),dataTableOutput("plot_brushed_points"))))
serveri <- shinyServer(function(input,output) {
output$plot <- renderPlot({
p <- ggplot(iris,aes_string(x=input$x, y=input$y))+geom_point()+theme_bw()
if(input$color != 'None')
p <- p + aes_string(color=input$color)
print(p)
})
output$plotui <- renderUI(plotOutput("plot",brush = brushOpts("plot_brush")))
output$plot_brushed_points <- renderDataTable(brushedPoints(iris,input$plot_brush,input$x,input$y), options=list(searching=FALSE, paging = FALSE))
})
shinyApp(useri, serveri)
I should note that the data table displays and you can see it refresh, it just doesn't fill with any data.
EDIT
The script above has a feature where it displays all the values in the data table if and only if you select the whole area of the plot.
I was having the exact same issue, except I couldn't get the output to render even when all points were selected:
output$dt <- renderDT(
expr = brushedPoints(acled_selected(), input$mapbrush),
options = list(lengthChange = FALSE, rownames=FALSE)
)
I found a solution here:
R Shiny does not display the output data table
This seems to work for me:
brushd <- reactive({
user_brush <- input$mapbrush
brushedPoints(acled_selected(), user_brush, xvar = "LONGITUDE", yvar =
"LATITUDE")
})
output$dt<-DT::renderDataTable({DT::datatable(brushd())})
I had a similar problem. I fixed it eventually (after reading this post: https://github.com/rstudio/shiny/issues/998) by NOT calling print on the plot, just returning it. So:
output$plot <- renderPlot({
p <- ggplot(iris,aes_string(x=input$x, y=input$y))+geom_point()+theme_bw()
if(input$color != 'None')
p <- p + aes_string(color=input$color)
#print (p)
p
})