## ----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) # }