8. Linked plots with detourr

library(quollr)
library(plotly)
library(detourr)

While quollr integrates directly with langevitour for interactive exploration, an alternative workflow is to use the detourr package. This approach gives users more flexibility to manually construct linked, browser-based visualizations using crosstalk and htmltools. In this setup, multiple views—such as the \(2\text{-}D\) NLDR layout, model diagnostics, and a tour are displayed side by side and interactively linked through brushing and selection.

Fitting the Model

We begin by fitting a model using a high-dimensional dataset and its corresponding NLDR embedding.

model_obj <- fit_highd_model(
  highd_data = scurve, 
  nldr_data = scurve_umap, 
  b1 = 21, 
  q = 0.1, 
  hd_thresh = 0
)

From the fitted object, we extract the \(2\text{-}D\) model (df_bin_centroids), the lifted high-dimensional representation (df_bin), and the triangular mesh (trimesh) used to define neighborhood relationships.

df_bin_centroids <- model_obj$model_2d
df_bin <- model_obj$model_highd
trimesh <- model_obj$trimesh_data

model_error <- augment(
  x = model_obj,
  highd_data = scurve
)

To support linked interaction across views, the model and data are combined into a single data structure.

df_exe <- comb_all_data_model(
  highd_data = scurve, 
  nldr_data = scurve_umap, 
  model_highd = df_bin, 
  model_2d = df_bin_centroids
)

Two-Panel Linked View: NLDR Layout and Tour

A simple linked view pairs the \(2\text{-}D\) NLDR layout with a tour generated using detourr. Both panels are connected using crosstalk, allowing selections in one view to be reflected in the other.

The NLDR plot is constructed with plotly to enable interactive brushing:

point_colours <- c("#66B2CC", "#FF7755")
point_sizes <- c(0, 1)

shared_df <- crosstalk::SharedData$new(df_exe)

nldr_plt <- plot_ly(
    shared_df,
    x = ~emb1, y = ~emb2,
    type = "scatter",
    mode = "markers",
    marker = list( color = point_colours[1], size = 3, opacity = 0.5),
    hoverinfo = "none"
) |>
    layout(
        width = 300, height = 300,
        xaxis = list(title = "", showgrid = FALSE, zeroline = FALSE, 
                     showticklabels = FALSE, ticks = "", 
                     linecolor = "black", mirror = TRUE
        ),
        yaxis = list(
            title = "", showgrid = FALSE, zeroline = FALSE, 
            showticklabels = FALSE, ticks = "", linecolor = "black", mirror = TRUE
        ),
        margin = list(l = 20, r = 20, t = 20, b = 20),
        dragmode = "select"
    ) |> 
    style(selected = list(marker = list(opacity = 1)), 
          unselected=list(marker=list(opacity=1))) |>
    highlight(on="plotly_selected", off="plotly_deselect") |>
    config(displayModeBar = FALSE)

The corresponding tour view is created using detourr, with the triangular mesh overlaid to show neighborhood structure:

detourr_output <- detour(
  shared_df, tour_aes(projection = starts_with("x"), colour = type)
) |>
  tour_path(grand_tour(2), 
                    max_bases=50, fps = 60) |>
  show_scatter(axes = TRUE, size = 0.5, alpha = 0.8, 
               edges = as.matrix(trimesh[, c("from_reindexed", "to_reindexed")]),
               palette = c("#66B2CC", "#FF7755"),
              width = "300px", height = "300px")

These two views are arranged side by side using bscols():

lndet_link <- crosstalk::bscols(
  htmltools::div(
    style = "display: grid; grid-template-columns: 1fr 1fr;",
    nldr_plt,
    htmltools::div(style = "margin-top: 20px;", detourr_output)
  ),
  device = "xs"
)

class(lndet_link) <- c(class(lndet_link), "htmlwidget")
lndet_link

This two-panel display allows users to explore how selections in the \(2\text{-}D\) embedding correspond to structures observed in high-dimensional space.

Three-Panel Linked View: Adding Model Error

To support deeper diagnostic exploration, a third panel showing the error distribution can be added. This view highlights how well different regions of the \(2\text{-}D\) layout represent the original high-dimensional data.

First, we recombine the data to include per-point error information:

df_exe <- comb_all_data_model_error(
  highd_data = scurve, 
  nldr_data = scurve_umap, 
  model_highd = df_bin, 
  model_2d = df_bin_centroids, 
  error_data = model_error
)

shared_df <- crosstalk::SharedData$new(df_exe)

The NLDR and tour views are constructed as before, but using a different SharedData object.

nldr_plt_n <- plot_ly(
    shared_df,
    x = ~emb1, y = ~emb2,
    type = "scatter",
    mode = "markers",
    marker = list(color = point_colours[1], size = 3, opacity = 0.5),
    hoverinfo = "none"
) |>
    layout(
        width = 250, height = 250,
        xaxis = list(
            title = "", showgrid = FALSE, zeroline = FALSE, 
            showticklabels = FALSE, ticks = "", linecolor = "black", 
            mirror = TRUE
        ),
        yaxis = list(
            title = "", showgrid = FALSE, zeroline = FALSE, 
            showticklabels = FALSE, ticks = "", linecolor = "black",
            mirror = TRUE
        ),
        margin = list(l = 20, r = 20, t = 20, b = 20),
        dragmode = "select"
    ) |> 
    style(selected   = list(marker = list(opacity = 1)), 
          unselected=list(marker=list(opacity=1))) |>
    highlight(on="plotly_selected", off="plotly_deselect") |>
    config(displayModeBar = FALSE)

detourr_output_n <- detour(
  shared_df,
  tour_aes(projection = starts_with("x"), colour = type)
) |>
  tour_path(grand_tour(2), 
                    max_bases=50, fps = 60) |>
  show_scatter(axes = TRUE, size = 0.5, alpha = 0.8, 
               edges = as.matrix(trimesh[, c("from_reindexed", "to_reindexed")]),
               palette = c("#66B2CC", "#FF7755"),
                width = "250px", height = "250px")

The error distribution is visualized as an interactive scatter plot:

error_plt <- plot_ly(
    shared_df,
    x = ~sqrt_row_wise_total_error, y = ~density,
    type = "scatter",
    mode = "markers",
    marker = list(color = point_colours[1], size = 3, opacity = 0.5),
    hoverinfo = "none"
) |>
    layout(
        width = 250, height = 250,
        xaxis = list(
            title = "", showgrid = FALSE, zeroline = FALSE,
            showticklabels = FALSE, ticks = "", linecolor = "black",
            mirror = TRUE
        ),
        yaxis = list(
            title = "", showgrid = FALSE, zeroline = FALSE,
            showticklabels = FALSE, ticks = "", linecolor = "black",
            mirror = TRUE
        ),
        margin = list(l = 20, r = 20, t = 20, b = 20),
        dragmode = "select"
    ) |> 
    style(selected   = list(marker = list(opacity = 1)), 
          unselected=list(marker=list(opacity=1))) |>
    highlight(on="plotly_selected", off="plotly_deselect") |>
    config(displayModeBar = FALSE)

All three panels are arranged in a single linked display:

erlndet_link <- crosstalk::bscols(
  htmltools::div(
    style = "display: grid; grid-template-columns: 1fr 1fr 1fr;",
    error_plt, nldr_plt_n,
    htmltools::div(style = "margin-top: 20px;", detourr_output_n)
  ),
  device = "xs"
)

class(erlndet_link) <- c(class(erlndet_link), "htmlwidget")
erlndet_link

This three-panel view allows users to explore between embedding space, model error, and tour, making it easier to identify regions where the NLDR layout may distort distances or cluster relationships.