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 (62 lines) | stat: -rw-r--r-- 1,527 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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
library(plotly)
library(shiny)

# cache computation of a correlation matrix
correlation <- round(cor(mtcars), 3)

ui <- fluidPage(
  mainPanel(
    plotlyOutput("heat"),
    plotlyOutput("scatterplot")
  ),
  verbatimTextOutput("selection")
)

server <- function(input, output, session) {
  
  output$heat <- renderPlotly({
    plot_ly(source = "heatmap") %>%
      add_heatmap(
        x = names(mtcars), 
        y = names(mtcars), 
        z = correlation
      ) %>%
      layout(
        xaxis = list(title = ""), 
        yaxis = list(title = "")
      )
  })
  
  output$selection <- renderPrint({
    s <- event_data("plotly_click", source = "heatmap")
    if (length(s) == 0) {
      "Click on a cell in the heatmap to display a scatterplot"
    } else {
      cat("You selected: \n\n")
      as.list(s)
    }
  })
  
  output$scatterplot <- renderPlotly({
    clickData <- event_data("plotly_click", source = "heatmap")
    if (is.null(clickData)) return(NULL)
    
    # get the clicked x/y variables and fit model to those 2 vars
    vars <- c(clickData[["x"]], clickData[["y"]])
    d <- setNames(mtcars[vars], c("x", "y"))
    yhat <- fitted(lm(y ~ x, data = d))
    
    # scatterplot with fitted line
    plot_ly(d, x = ~x) %>%
      add_markers(y = ~y) %>%
      add_lines(y = ~yhat) %>%
      layout(
        xaxis = list(title = clickData[["x"]]), 
        yaxis = list(title = clickData[["y"]]), 
        showlegend = FALSE
      )
  })
  
}

shinyApp(ui, server, options = list(display.mode = "showcase"))