Linking Multiple Components

library(linkeR)
library(shiny)
library(leaflet)
library(DT)
library(plotly)

Linking Multiple Components

linkeR can link any number of interactive components together. This vignette shows how to create complex dashboards with maps, tables, charts, and other elements all responding to the same selections.

Three-Component Example

Here’s a dashboard with a map, table, and plotly chart all linked together:

ui <- fluidPage(
  titlePanel("Multi-Component Dashboard"),
  
  fluidRow(
    column(4,
      h4("Geographic View"),
      leafletOutput("map")
    ),
    column(4,
      h4("Data Table"),
      DTOutput("table")
    ),
    column(4,
      h4("Performance Chart"),
      plotlyOutput("chart")
    )
  ),
  
  fluidRow(
    column(12,
      h4("Selection Details"),
      verbatimTextOutput("selection_info")
    )
  )
)

server <- function(input, output, session) {
  
  # Sample business data
  business_data <- reactive({
    data.frame(
      business_id = paste0("BIZ_", 1:20),
      name = paste("Business", 1:20),
      latitude = runif(20, 40.7, 40.8),
      longitude = runif(20, -111.95, -111.85),
      revenue = runif(20, 100000, 1000000),
      employees = sample(10:100, 20, replace = TRUE),
      category = sample(c("Tech", "Retail", "Food"), 20, replace = TRUE)
    )
  })
  
  # Render map
  output$map <- renderLeaflet({
    leaflet(business_data()) %>%
      addTiles() %>%
      addCircleMarkers(
        lng = ~longitude,
        lat = ~latitude,
        layerId = ~business_id,
        radius = 5,
        popup = ~paste("Business:", name)
      )
  })
  
  # Render table
  output$table <- renderDT({
    data <- business_data()
    display_data <- data[, c("name", "category", "revenue", "employees")]
    
    datatable(
      display_data,
      selection = "single",
      rownames = FALSE
    ) %>%
      formatCurrency("revenue", currency = "$", digits = 0)
  })
  
  # Render chart
  output$chart <- renderPlotly({
    plot_ly(
      data = business_data(),
      x = ~employees,
      y = ~revenue,
      key = ~business_id,  # Critical: this enables plotly linking
      text = ~name,
      type = "scatter",
      mode = "markers",
      source = "business_chart"  # Source ID for plotly events
    ) %>%
      layout(
        title = "Revenue vs Employees",
        xaxis = list(title = "Employees"),
        yaxis = list(title = "Revenue")
      )
  })
  
  # Link the map and table (plotly requires special handling)
  registry <- link_plots(
    session,
    map = business_data,
    table = business_data,
    shared_id_column = "business_id"
  )
  
  # Handle plotly clicks separately
  observeEvent(event_data("plotly_click", source = "business_chart"), {
    clicked_data <- event_data("plotly_click", source = "business_chart")
    if (!is.null(clicked_data) && !is.null(clicked_data$key)) {
      # Update the registry selection
      registry$set_selection(clicked_data$key, "chart")
    }
  })
  
  # Display selection info
  output$selection_info <- renderText({
    selection <- registry$get_selection()
    if (!is.null(selection$selected_id)) {
      data <- business_data()
      selected <- data[data$business_id == selection$selected_id, ]
      if (nrow(selected) > 0) {
        paste0(
          "Selected: ", selected$name, "\n",
          "Source: ", selection$source, "\n",
          "Revenue: $", format(selected$revenue, big.mark = ","), "\n",
          "Employees: ", selected$employees
        )
      }
    } else {
      "No selection"
    }
  })
}

Adding More Component Types

Summary Tables

You can link summary tables that show aggregated information:

# In your server function
output$category_summary <- renderDT({
  data <- business_data()
  
  summary_data <- data %>%
    group_by(category) %>%
    summarise(
      count = n(),
      avg_revenue = mean(revenue),
      total_employees = sum(employees),
      .groups = "drop"
    )
  
  datatable(
    summary_data,
    selection = "single",
    rownames = FALSE,
    options = list(pageLength = 5, searching = FALSE)
  ) %>%
    formatCurrency("avg_revenue", currency = "$", digits = 0)
})

# Link it by adding to your link_plots call
link_plots(
  session,
  map = business_data,
  table = business_data,
  summary = business_data,  # Same data, different view
  shared_id_column = "business_id"
)

Time Series Charts

For dynamic charts that update based on selection:

# Reactive chart that updates with selection
output$monthly_trend <- renderPlotly({
  registry <- get_registry()  # However you store your registry
  selection <- registry$get_selection()
  
  if (!is.null(selection$selected_id)) {
    # Get monthly data for selected business
    selected_business <- business_data()[
      business_data()$business_id == selection$selected_id, 
    ]
    
    # Generate monthly data (example)
    monthly_data <- data.frame(
      month = 1:12,
      revenue = selected_business$revenue / 12 * runif(12, 0.8, 1.2)
    )
    
    plot_ly(
      data = monthly_data,
      x = ~month,
      y = ~revenue,
      type = "scatter",
      mode = "lines+markers"
    ) %>%
      layout(
        title = paste("Monthly Trend:", selected_business$name),
        xaxis = list(title = "Month"),
        yaxis = list(title = "Revenue")
      )
  } else {
    # Empty chart with instructions
    plot_ly() %>%
      add_annotations(
        text = "Select a business to view trends",
        x = 0.5, y = 0.5,
        xref = "paper", yref = "paper",
        showarrow = FALSE
      )
  }
})

Managing Complex State

For complex dashboards, you might want centralized state management:

server <- function(input, output, session) {
  
  # Centralized selection state
  current_selection <- reactiveVal(NULL)
  
  # Business data
  business_data <- reactive({ /* your data */ })
  
  # Set up linking with global callback
  registry <- link_plots(
    session,
    map = business_data,
    table = business_data,
    shared_id_column = "business_id",
    
    # Update centralized state
    on_selection_change = function(selected_id, selected_data, source_id, session) {
      current_selection(selected_data)
      
      # Log for debugging
      cat("Selection changed:", selected_id, "from", source_id, "\n")
    }
  )
  
  # All outputs can react to current_selection()
  output$detail_panel <- renderUI({
    selected <- current_selection()
    if (!is.null(selected)) {
      # Rich detail panel
      fluidRow(
        column(6, 
          h4("Business Details"),
          p("Name:", selected$name),
          p("Category:", selected$category)
        ),
        column(6,
          h4("Performance"),
          p("Revenue:", scales::dollar(selected$revenue)),
          p("Employees:", selected$employees)
        )
      )
    } else {
      div("Select a business to view details")
    }
  })
  
  output$related_businesses <- renderDT({
    selected <- current_selection()
    if (!is.null(selected)) {
      # Show businesses in same category
      related <- business_data()[
        business_data()$category == selected$category & 
        business_data()$business_id != selected$business_id,
      ]
      
      datatable(
        related[, c("name", "revenue", "employees")],
        caption = paste("Other", selected$category, "businesses"),
        options = list(pageLength = 5)
      )
    }
  })
}

Performance Tips

1. Limit Updates: Use req() to avoid unnecessary updates
2. Debounce Fast Clicks: Use debounce() for rapid selection changes
3. Lazy Loading: Only render expensive components when selected
4. Efficient Data: Keep linked datasets reasonably sized

Troubleshooting Multiple Components

• IDs must match: Ensure all components use the same shared ID values
• Reactive context: All data must be in reactive() expressions
• Observer conflicts: Be careful with multiple observeEvent() on the same inputs
• plotly requires special handling: Use the registry’s set_selection() method for plotly clicks

With these patterns, you can create rich, interconnected dashboards where every component enhances the user’s understanding of the data.