8. Linked plots with detourr

# 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.