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"))
|