ShinyModules/ModularPlotlyHeatmapScatter.R at master · kdgosik/ShinyModules · GitHub

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
library(ggplot2)
library(plotly)

# MODULE UI
PlotlyHeatmapScatterUI <- function(id) {
  ns <- NS(id)

  fillCol(
    div(
      plotlyOutput(ns("heat")),
      verbatimTextOutput(ns("selection")),
      plotlyOutput(ns("scatterplot"))
      )
  )
}


# MODULE Server
PlotlyHeatmapScatterServer <- function(input, output, session, data) {

  resultdata <- reactive({

    correlation <- round(cor(data()), 3)
    # cor_order <- hclust(dist(data(), method = "binary"))$order
    # correlation <- correlation[cor_order, cor_order]
    nms <- names(data())

    list(names = nms,
         data = correlation)

  })


  output$heat <- renderPlotly({

    plot_ly(x = resultdata()[["names"]],
            y = resultdata()[["names"]],
            z = resultdata()[["data"]],
            key = resultdata()[["data"]], type = "heatmap") %>%
      layout(xaxis = list(title = ""),
             yaxis = list(title = ""))

  })

  output$selection <- renderPrint({

    s <- event_data("plotly_click")
    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({

    s <- event_data("plotly_click")
    if (length(s)) {
      vars <- c(s[["x"]], s[["y"]])
      d <- setNames(mtcars[vars], c("x", "y"))
      yhat <- fitted(lm(y ~ x, data = d))
      plot_ly(d, x = ~x) %>%
        add_markers(y = ~y) %>%
        add_lines(y = ~yhat) %>%
        layout(xaxis = list(title = s[["x"]]),
               yaxis = list(title = s[["y"]]),
               showlegend = FALSE)
    } else {
      plotly_empty()
    }

  })

}