File: app.R

package info (click to toggle)
r-cran-plotly 4.10.4%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 30,636 kB
  • sloc: javascript: 195,272; sh: 24; makefile: 6
file content (47 lines) | stat: -rw-r--r-- 1,141 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
# see https://community.rstudio.com/t/sliding-a-point-on-a-plot-rather-than-sliderinput-to-update-plot-in-shiny/16405/7
library(shiny)
library(plotly)

ui <- fluidPage(
  plotlyOutput("p"),
  verbatimTextOutput("event")
)

x <- seq(-10, 10)
y <- rnorm(length(x))


server <- function(input, output, session) {
  
  output$p <- renderPlotly({
    
    d <- event_data("plotly_relayout", source = "trajectory")
    
    selected_point <- if (!is.null(d[["shapes[0].x0"]])) {
      xint <- d[["shapes[0].x0"]]
      xpt <- x[which.min(abs(x - xint))]
      list(x = xpt, y = y[which(x == xpt)])
    } else {
      list(x = 1, y = y[which(x == 1)])
    }
    
    plot_ly(color = I("red"), source = "trajectory") %>%
      add_lines(x = x, y = y) %>%
      add_markers(x = selected_point$x, y = selected_point$y) %>%
      layout(
        shapes = list(
          type = "line", 
          line = list(color = "gray", dash = "dot"),
          x0 = selected_point$x, 
          x1 = selected_point$x,
          y0 = 0,
          y1 = 1,
          yref = "paper"
        )
      ) %>%
      config(editable = TRUE)
  })
  
}

shinyApp(ui, server)