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
78
79
80
81
82
|
library(plotly)
library(shiny)
# user interface
ui <- fluidPage(
titlePanel("Linked highlighting with plotly and shiny"),
mainPanel(
htmltools::div(style = "display:inline-block", plotlyOutput("x", width = 400, height = 250)),
wellPanel(
style = "display:inline-block; vertical-align:top;",
sliderInput("xbins", "Number of x bins",
min = 1, max = 50, value = 20, width = 250),
sliderInput("ybins", "Number of y bins",
min = 1, max = 50, value = 20, width = 250)
),
br(),
htmltools::div(style = "display:inline-block", plotlyOutput("xy", width = 400, height = 400)),
htmltools::div(style = "display:inline-block", plotlyOutput("y", width = 250, height = 400))
)
)
# marker objects
m <- list(color = toRGB("black"))
m2 <- list(color = toRGB("black", 0.2))
server <- function(input, output, session) {
# convenience function for computing xbin/ybin object given a number of bins
compute_bins <- function(x, n) {
list(
start = min(x),
end = max(x),
size = (max(x) - min(x)) / n
)
}
# the 'x' histogram
output$x <- renderPlotly({
x <- cars$speed
xbins <- compute_bins(x, input$xbins)
p <- plot_ly(x = x, type = "histogram", autobinx = F,
xbins = xbins, marker = m2)
# obtain plotlyjs selection
s <- event_data("plotly_selected")
# if points are selected, subset the data, and highlight
if (length(s$x) > 0) {
p <- add_trace(p, x = s$x, type = "histogram", autobinx = F,
xbins = xbins, marker = m)
}
p %>%
config(displayModeBar = F, showLink = F) %>%
layout(showlegend = F, barmode = "overlay", yaxis = list(title = "count"),
xaxis = list(title = "", showticklabels = F))
})
# basically the same as 'x' histogram
output$y <- renderPlotly({
y <- cars$dist
ybins <- compute_bins(y, input$ybins)
p <- plot_ly(y = y, type = "histogram", autobiny = F,
ybins = ybins, marker = m2)
s <- event_data("plotly_selected")
if (length(s$y) > 0) {
p <- add_trace(p, y = s$y, type = "histogram", autobiny = F,
ybins = ybins, marker = m)
}
p %>%
config(displayModeBar = F, showLink = F) %>%
layout(showlegend = F, barmode = "overlay", xaxis = list(title = "count"),
yaxis = list(title = "", showticklabels = F))
})
output$xy <- renderPlotly({
cars %>%
plot_ly(x = ~speed, y = ~dist,
mode = "markers", marker = m) %>%
layout(dragmode = "select")
})
}
shinyApp(ui, server)
|
