## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval = FALSE # Set to FALSE since these are Shiny examples
)
## ----setup--------------------------------------------------------------------
# library(linkeR)
# library(shiny)
# library(plotly)
# library(DT)
# library(leaflet)
## ----basic-plotly-------------------------------------------------------------
# library(shiny)
# library(plotly)
# library(linkeR)
#
# # Sample data
# sample_data <- data.frame(
# id = 1:20,
# name = paste("Item", 1:20),
# x_value = runif(20, 1, 10),
# y_value = runif(20, 1, 10),
# category = sample(c("A", "B", "C"), 20, replace = TRUE),
# value = runif(20, 100, 1000)
# )
#
# ui <- fluidPage(
# titlePanel("Basic Plotly Linking"),
#
# fluidRow(
# column(6,
# h4("Interactive Scatter Plot"),
# plotlyOutput("scatter_plot")
# ),
# column(6,
# h4("Data Table"),
# DTOutput("data_table")
# )
# ),
#
# verbatimTextOutput("selection_info")
# )
#
# server <- function(input, output, session) {
# # Create reactive data
# data_reactive <- reactive({ sample_data })
#
# # Simple one-line linking setup
# registry <- link_plots(
# session,
# scatter_plot = data_reactive,
# data_table = data_reactive,
# shared_id_column = "id"
# )
#
# # Create plotly chart with key parameter for reliable linking
# output$scatter_plot <- renderPlotly({
# plot_ly(
# data = sample_data,
# x = ~x_value,
# y = ~y_value,
# color = ~category,
# key = ~id, # Essential for reliable linking
# source = "scatter_plot",
# type = "scatter",
# mode = "markers"
# ) %>%
# layout(title = "Click any point to see linking")
# })
#
# # Create data table
# output$data_table <- renderDT({
# datatable(
# sample_data,
# selection = "single",
# options = list(pageLength = 5)
# )
# })
#
# # Show selection information
# output$selection_info <- renderText({
# selection <- registry$get_selection()
# if (!is.null(selection$selected_id)) {
# paste("Selected ID:", selection$selected_id,
# "| Source:", selection$source)
# } else {
# "No selection"
# }
# })
# }
#
# # Run the app
# if (interactive()) {
# shinyApp(ui = ui, server = server)
# }
## ----eval=FALSE---------------------------------------------------------------
# tags$script(HTML("
# Shiny.addCustomMessageHandler('eval', function(code) {
# try {
# eval(code);
# } catch(e) {
# console.error('JavaScript execution error:', e);
# }
# });
# "))
## ----key-parameter------------------------------------------------------------
# plot_ly(
# data = my_data,
# x = ~x_column,
# y = ~y_column,
# key = ~id_column, # This enables reliable point identification
# source = "my_plot"
# )
## ----source-parameter---------------------------------------------------------
# plot_ly(
# data = my_data,
# x = ~x_column,
# y = ~y_column,
# key = ~id_column,
# source = "unique_plot_name" # Must match your output ID
# )
## ----scatter-example----------------------------------------------------------
# output$scatter <- renderPlotly({
# plot_ly(
# data = data,
# x = ~x_value,
# y = ~y_value,
# key = ~id,
# source = "scatter",
# type = "scatter",
# mode = "markers"
# )
# })
## ----bar-example--------------------------------------------------------------
# output$bar_chart <- renderPlotly({
# plot_ly(
# data = aggregated_data,
# x = ~category,
# y = ~total_value,
# key = ~category_id, # Use appropriate ID for linking
# source = "bar_chart",
# type = "bar"
# )
# })
## ----line-example-------------------------------------------------------------
# output$line_chart <- renderPlotly({
# plot_ly(
# data = time_series_data,
# x = ~date,
# y = ~value,
# key = ~observation_id,
# source = "line_chart",
# type = "scatter",
# mode = "lines+markers"
# )
# })
## ----multi-trace--------------------------------------------------------------
# output$multi_trace <- renderPlotly({
# plot_ly(
# data = data,
# x = ~x_value,
# y = ~y_value,
# color = ~category, # Creates multiple traces
# key = ~id, # Still works perfectly
# source = "multi_trace",
# type = "scatter",
# mode = "markers"
# )
# })
## ----multiple-charts----------------------------------------------------------
# ui <- fluidPage(
# titlePanel("Multiple Linked Plotly Charts"),
#
# fluidRow(
# column(4,
# h4("Scatter Plot"),
# plotlyOutput("scatter", height = "300px")
# ),
# column(4,
# h4("Bar Chart"),
# plotlyOutput("bar", height = "300px")
# ),
# column(4,
# h4("Box Plot"),
# plotlyOutput("box", height = "300px")
# )
# ),
#
# verbatimTextOutput("multi_selection")
# )
#
# server <- function(input, output, session) {
# data_reactive <- reactive({ sample_data })
#
# # Link all three charts
# registry <- link_plots(
# session,
# scatter = data_reactive,
# bar = data_reactive,
# box = data_reactive,
# shared_id_column = "id"
# )
#
# # Scatter plot
# output$scatter <- renderPlotly({
# plot_ly(
# data = sample_data,
# x = ~x_value,
# y = ~y_value,
# key = ~id,
# source = "scatter"
# )
# })
#
# # Aggregated bar chart
# bar_data <- sample_data %>%
# group_by(category) %>%
# summarise(
# mean_value = mean(value),
# id = first(id), # Use first ID for linking
# .groups = 'drop'
# )
#
# output$bar <- renderPlotly({
# plot_ly(
# data = bar_data,
# x = ~category,
# y = ~mean_value,
# key = ~id,
# source = "bar",
# type = "bar"
# )
# })
#
# # Box plot
# output$box <- renderPlotly({
# plot_ly(
# data = sample_data,
# y = ~value,
# color = ~category,
# key = ~id,
# source = "box",
# type = "box"
# )
# })
#
# output$multi_selection <- renderText({
# selection <- registry$get_selection()
# paste("Selected:", selection$selected_id %||% "None")
# })
# }
## ----mixed-components---------------------------------------------------------
# ui <- fluidPage(
# titlePanel("Mixed Component Dashboard"),
#
# fluidRow(
# column(3,
# h4("Map View"),
# leafletOutput("map", height = "400px")
# ),
# column(4,
# h4("Performance Chart"),
# plotlyOutput("performance", height = "400px")
# ),
# column(5,
# h4("Data Details"),
# DTOutput("details")
# )
# )
# )
#
# server <- function(input, output, session) {
# business_data <- reactive({
# data.frame(
# business_id = 1:50,
# name = paste("Business", 1:50),
# latitude = runif(50, 40.7, 40.8),
# longitude = runif(50, -111.95, -111.85),
# revenue = runif(50, 100000, 1000000),
# employees = sample(10:500, 50),
# category = sample(c("Tech", "Retail", "Food"), 50, replace = TRUE)
# )
# })
#
# # Link map, chart, and table
# registry <- link_plots(
# session,
# map = business_data,
# performance = business_data,
# details = business_data,
# shared_id_column = "business_id"
# )
#
# # Map
# output$map <- renderLeaflet({
# data <- business_data()
# leaflet(data) %>%
# addTiles() %>%
# addMarkers(
# lng = ~longitude,
# lat = ~latitude,
# layerId = ~business_id,
# popup = ~name
# )
# })
#
# # Performance chart
# output$performance <- renderPlotly({
# data <- business_data()
# plot_ly(
# data = data,
# x = ~employees,
# y = ~revenue,
# color = ~category,
# key = ~business_id,
# source = "performance",
# text = ~paste("Name:", name),
# hovertemplate = "%{text}
Employees: %{x}
Revenue: $%{y:,.0f}"
# ) %>%
# layout(
# title = "Revenue vs Employees",
# xaxis = list(title = "Employees"),
# yaxis = list(title = "Revenue ($)")
# )
# })
#
# # Data table
# output$details <- renderDT({
# datatable(
# business_data(),
# selection = "single",
# options = list(pageLength = 8, scrollX = TRUE)
# ) %>%
# formatCurrency("revenue", currency = "$", digits = 0)
# })
# }
## ----custom-highlighting------------------------------------------------------
# plot_ly(
# data = data,
# x = ~x_value,
# y = ~y_value,
# key = ~id,
# source = "custom_plot"
# ) %>%
# layout(
# # Custom selection styling
# selectdirection = "diagonal",
# dragmode = "select"
# )
## ----complete-example---------------------------------------------------------
# library(shiny)
# library(plotly)
# library(linkeR)
# library(DT)
# library(dplyr)
#
# # Generate sample data
# set.seed(123)
# categories <- c("Electronics", "Clothing", "Books")
# n <- 30
# sample_data <- data.frame(
# business_id = paste0("PROD_", sprintf("%03d", 1:n)),
# name = paste("Product", LETTERS[1:n]),
# price = round(runif(n, 10, 100), 2),
# sales = round(runif(n, 100, 1000), 0),
# category = sample(categories, n, replace = TRUE),
# rating = round(runif(n, 1, 5), 1),
# stringsAsFactors = FALSE
# )
# # Defensive: Remove any rows with NA in key columns
# sample_data <- subset(sample_data, !is.na(business_id) & !is.na(name) & !is.na(category))
#
# ui <- fluidPage(
# titlePanel("Complete Plotly + linkeR Example"),
# tags$script(HTML("
# Shiny.addCustomMessageHandler('eval', function(code) {
# try {
# eval(code);
# } catch(e) {
# console.error('JavaScript execution error:', e);
# }
# });
# ")),
# fluidRow(
# column(7,
# h4("Scatter Plot"),
# plotlyOutput("scatter_plot", height = "400px"),
# br(),
# verbatimTextOutput("current_selection")
# ),
# column(5,
# h4("Data Table"),
# DTOutput("data_table")
# )
# )
# )
#
# server <- function(input, output, session) {
# data_reactive <- reactive({ sample_data })
# # Use a fresh registry name to avoid conflicts
# scatter_registry <- link_plots(
# session,
# scatter_plot = data_reactive,
# data_table = data_reactive,
# shared_id_column = "business_id"
# )
#
# # Scatter plot
# output$scatter_plot <- renderPlotly({
# plot_ly(
# data = sample_data,
# x = ~price,
# y = ~sales,
# color = ~category,
# key = ~business_id,
# source = "scatter_plot",
# text = ~paste("Product:", name, "
Category:", category, "
Rating:", rating),
# hovertemplate = "%{text}
Price: $%{x:.2f}
Sales: %{y:.0f}",
# type = "scatter",
# mode = "markers"
# ) %>%
# layout(
# title = "Price vs Sales by Category",
# xaxis = list(title = "Price ($)"),
# yaxis = list(title = "Sales")
# )
# })
#
# # Data table
# output$data_table <- renderDT({
# datatable(
# sample_data,
# selection = "single",
# rownames = FALSE,
# options = list(
# pageLength = 10,
# scrollX = TRUE,
# searchHighlight = TRUE
# )
# ) %>%
# formatCurrency("price", currency = "$") %>%
# formatRound(c("sales", "rating"), digits = c(0, 1))
# })
#
# # Show current selection
# output$current_selection <- renderText({
# selection <- scatter_registry$get_selection()
# if (!is.null(selection$selected_id)) {
# selected_item <- sample_data[sample_data$business_id == selection$selected_id, ]
# if (nrow(selected_item) > 0) {
# paste0(
# "Selected: ", selected_item$name, "\n",
# "Category: ", selected_item$category, "\n",
# "Price: $", selected_item$price, "\n",
# "Sales: ", selected_item$sales, "\n",
# "Rating: ", selected_item$rating, "\n",
# "Source: ", selection$source
# )
# } else {
# "No item selected"
# }
# } else {
# "No item selected"
# }
# })
# }
#
# # Run the application
# if (interactive()) {
# shinyApp(ui = ui, server = server)
# }