I have a plotly plot in R Shiny. I want to be able to click many points and have them displayed in a table. The plot is working great and I can get 1 plotly_click (via event_data()) to show in a table. How can a grow a vector of many event_data points. Here is some sample code. I was trying to save the event in d_save. Thanks.
library(shiny)
library(plotly)
data1 <- data.frame(cbind(seq(1,1000,1),seq(1,1000,1)*5))
colnames(data1) <- c('index','data')
data_points <- data.frame(cbind(seq(1,1000,5),seq(1,1000,5)*5))
colnames(data_points) <- c('index','data')
ui <- fluidPage(
plotlyOutput("plot1"),
tableOutput("dataTable")
)
d_save <- vector()
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
p <- plot_ly(data1, x = data1$index, y = data1$data,mode = "lines")
add_trace(p, x = data_points$index, y = data_points$data, mode = "markers")
})
# show table of stances
output$dataTable <- renderTable({
d <- event_data("plotly_click")
d_save <- c(d_save,d$pointNumber[2]+1)
data.frame(d_save)
})
}
shinyApp(ui, server)
There is nothing seriously wrong with this and it was weird that it never got answered. It is not a bad example of pure plotly (without using ggplot).
I fixed it by:
changing the d_save <- c(...) assignment to a d_save <<- c(...) (using a reactiveValues here would be cleaner).
changing the plotly call to be a pipe, which seemingly allows some settings to carry over (like the type=scatter default) - eliminating the warning:
No trace type specified: Based on info supplied, a 'scatter' trace
seems appropriate.
fixed an "off-by-one" indexing error in the d_save assignment.
added a layout(...) to give it a title (this is useful for a lot of things).
The resulting code:
library(shiny)
library(plotly)
data1 <- data.frame(cbind(seq(1,1000,1),seq(1,1000,1)*5))
colnames(data1) <- c('index','data')
data_points <- data.frame(cbind(seq(1,1000,5),seq(1,1000,5)*5))
colnames(data_points) <- c('index','data')
ui <- fluidPage(
plotlyOutput("plot1"),
tableOutput("dataTable")
)
d_save <- vector()
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
plot_ly(data1, x=data1$index, y=data1$data,mode = "lines") %>%
add_trace(x = data_points$index, y=data_points$data, mode = "markers") %>%
layout(title="Plotly_click Test")
})
# show table of point markers clicked on by number
output$dataTable <- renderTable({
d <- event_data("plotly_click")
d_save <<- c(d_save,d$pointNumber[1]+1)
data.frame(d_save)
})
}
shinyApp(ui, server)
The image:
Related
I am creating a POC, where real time update will reflect on my shiny application. The idea is to plot the frequency distribution of the data that is being generated from a server. Since I do not have access to the server yet, I have simulated a data creation which I am feeding to my plot. I can see the data properly on my console, but nothing is being displayed on my application. I am sure that there is something I am missing out. I think the reason I am unable to view the plot is because the data is getting updated faster than the rendering speed. Is there any way to modify that.
library(shiny)
library(magrittr)
library(plotly)
ui <- shinyServer(fluidPage(
plotOutput("plot")
))
alarms = c("NodeDown","GrowthRate","DecayRate","DiskFull","ServiceDown","Planned_shutdown","etc.....etc","ServerOutage",
"No Casue")
server <- shinyServer(function(input, output, session){
# Function to get new observations
get_new_data <- function(){
new = sample(alarms,1)
# data <- new %>% rbind %>% data.frame
return(new)
}
# Initialize my_data
my_data <<- get_new_data()
# Function to update my_data
update_data <- function(){
my_data <<- c(get_new_data(), my_data)
}
output$plot <- renderPlotly({
invalidateLater(1000, session)
update_data()
# print(my_data)
dd = update_data()
dd = as.data.frame(table(dd))
print(dd)
plot_ly(dd, x = ~dd, y = ~Freq)
})
# Plot the 30 most recent values
# output$first_column <- renderPlot({
# print("Render")
# invalidateLater(1000, session)
# update_data()
# print(my_data)
# plot(X1 ~ 1, data=my_data[1:30,], ylim=c(-3, 3), las=1, type="l")
# })
})
shinyApp(ui=ui,server=server)
You should use reactiveValues to append your vector, and use reactiveTimer with observeEvent to trigger it every second
Also, if you want to use renderPlotly in server, you should use plotlyOutput rather than plotOutput in ui
Try this:
library(shiny)
library(magrittr)
library(plotly)
ui <- shinyServer(fluidPage(
plotlyOutput("plot")
))
alarms = c("NodeDown","GrowthRate","DecayRate","DiskFull","ServiceDown","Planned_shutdown","etc.....etc","ServerOutage",
"No Casue")
server <- shinyServer(function(input, output, session){
get_new_data <- function(){
new = sample(alarms,1)
return(new)
}
my_data <-reactiveValues(data=get_new_data())
observeEvent(reactiveTimer(2000)(),{ # Trigger every 2 seconds
my_data$data<-c(get_new_data(),my_data$data)
print(my_data$data)
})
output$plot <- renderPlotly({
dd=as.data.frame(table(my_data$data))
print(dd)
plot_ly(dd, x = ~Var1, y = ~Freq)
})
})
shinyApp(ui=ui,server=server)
I'm using R shiny would like to put several ggplotly plots side by side with the help of gridExtra.
One plot (without gridExtra) works just fine:
library(shiny)
library(plotly)
u <- fluidPage(plotlyOutput(outputId = "myplots"))
s <- function(input, output) {
pt1 <- reactive({
ggplotly(qplot(42))
})
output$myplots <- renderPlotly({
pt1()
})
}
shinyApp(u, s)
Now when I try to add one more plot via gridExtra, it refused to work:
library(shiny)
library(plotly)
library(gridExtra)
u <- fluidPage(plotlyOutput(
outputId = "myplots"
))
s <- function(input, output){
pt1 <- reactive({
ggplotly(qplot(42))
})
pt2 <- reactive({
ggplotly(qplot(57))
})
output$myplots <- renderPlotly({
grid.arrange(pt1(), pt2(),
widths = c(1, 1),
ncol = 2)
})
}
shinyApp(u, s)
giving me
Error in gList: only 'grobs' allowed in "gList"
Rather than using grid.arrange to pass many plots to a single plotlyOutput, it would be better to set up your ui to accept several plots and then pass them individually. For example, your ui and server could look like this
Note that defining columns like this uses Bootstrap theming, which means the widths need to add to 12. Thats why I've defined each column to have a width of 6 - each will naturally fill half the page
library(shiny)
library(plotly)
library(gridExtra)
u <- fluidPage(
fluidRow(
column(6,
plotlyOutput("pt1")),
column(6,
plotlyOutput("pt2"))
)
)
s <- function(input, output){
output$pt1 <- renderPlotly({
ggplotly(qplot(42))
})
output$pt2 <- renderPlotly({
ggplotly(qplot(57))
})
}
shinyApp(u, s)
I would like to fetch nearPoints using the data from a click event.
I have found the below snippet from the Shiny webpage and it works fine as expected.
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), input$plot_click, "speed", "dist")
if (nrow(res) == 0)
return()
res
})
I tried to mimic the above the approach to identify the nearPoints in the Plotly plots using the click event data. However, it did not work.
output$plot <- renderPlotly({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), event_data("plotly_click"), "speed", "dist")
if (nrow(res) == 0)
return()
res
})
Any idea on how to pass the coordinate information to the plotly plot?
I am not sure on how to do this with the nearPoints function, but is using that function really necessary? You could find the points that are within a threshold of the clicked point as well with the following code:
library(shiny)
library(plotly)
library(DT)
threshold_mpg = 3
threshold_cyl = 1
shinyApp(
ui <- shinyUI(
fluidPage(
plotlyOutput("plot"),
DT::dataTableOutput("table")
)
),
function(input,output){
data <- reactive({
mtcars
})
output$plot <- renderPlotly({
d <- data()
plot_ly(d, x= ~mpg, y=~cyl, mode = "markers", type = "scatter", source="mysource")
})
output$table<- DT::renderDataTable({
event.data <- event_data("plotly_click", source = "mysource")
print(event.data)
if(is.null(event.data)) { return(NULL)}
# A simple alternative for the nearPoints function
result <- data()[abs(data()$mpg-event.data$x)<=threshold_mpg & abs(data()$cyl-event.data$y)<=threshold_cyl, ]
DT::datatable(result)
})
}
)
Hope this helps.
The "plotly_selected" plotly.js event returns more information than event_data("plotly_selected") actually gives you, including coordinate information (this was arguably a design mistake made by event_data() that's too late to change). Fortunately, if you know a bit of JavaScript, know how to listen to plotly select events, and how to send data from client to a shiny server, you can do something like this to access that info:
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- fluidPage(
plotlyOutput("p"),
verbatimTextOutput("info")
)
server <- function(input, output, session, ...) {
output$p <- renderPlotly({
plot_ly(x = 1:10, y = 1:10) %>%
layout(dragmode = "select") %>%
onRender(
"function(el, x) {
var gd = document.getElementById(el.id);
gd.on('plotly_selected', function(d) {
// beware, sometimes this event fires objects that can't be seralized
console.log(d);
Shiny.onInputChange('my-select-event', d.range)
})
}")
})
output$info <- renderPrint({
print(session$rootScope()$input[["my-select-event"]])
})
}
shinyApp(ui, server)
Using the coordinate information you could write a function that works in a similar way to nearPoints().
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 am trying to create an app using Shiny, where I want the user to be able to select the color of each line in a plot. The general idea is to import the data in the app and then plot each variable in the data. I tried to use the colorpicker 'jscolorInput' from the shinysky package, which works fine when placed in the ui.r file, but since I want my app to be dynamic for each dataset uploaded, I need to put the colorpicker in the server.R, using a reactive function.
When placed in the server, the 'jscolorInput' does not work.
What I want to do is:
Reproduce the colorpicker as many times as the number of
variables in the data
Take the input from the color and pass it
as color argument in the plot
I am very new in both shiny development and stackoverflow, so please excuse my mistakes.
Here is a reproducible example that does not work.
require(shinysky)
require(shiny)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(list(
ui = bootstrapPage(
# The reactive colorpicker
uiOutput('myPanel'),
# The plot
plotOutput('plot')
),
server = function(input, output) {
# Print as many colorpickers as the columns in the dataset
cols <- reactive({
n <- ncol(dat)
for(i in 1:n){
print(jscolorInput(paste("col", i, sep="_")))
}
})
output$myPanel <- renderPrint({cols()})
# Put all the input in a vector
colors <- reactive({
n <- ncol(dat)
lapply(1:n, function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
cols <- ifelse(is.null(input$col_1), rep("000000 ", n), colors())
plot(dat[,1], col= paste0("#", cols[1], ""))
for(i in 2:ncol(dat))lines(dat[,i], col=cols[i])
})
}
))
Here is a working version of what you are trying to do. Look at the differences between our code, there were a few problems with your code. Also, note that I'm not using shinysky because it doesn't have the colourpicker anymore (it's moved to a different package that's inactive), so instead I'm using the inputColour from shinyjs.
library(shiny)
library(shinyjs)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(shinyApp(
ui = fluidPage(
uiOutput('myPanel'),
plotOutput("plot")
),
server = function(input, output, session) {
cols <- reactive({
lapply(seq_along(dat), function(i) {
colourInput(paste("col", i, sep="_"), "Choose colour:", "black")
})
})
output$myPanel <- renderUI({cols()})
# Put all the input in a vector
colors <- reactive({
lapply(seq_along(dat), function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
if (is.null(input$col_1)) {
cols <- rep("#000000", ncol(dat))
} else {
cols <- unlist(colors())
}
plot(dat[,1], col = cols[1])
for(i in 2:ncol(dat)) lines(dat[,i], col = cols[i])
})
}
))
Disclaimer: I'm the author of shinyjs