From b0411d86cde76618b97e30ff9dc84960337279a5 Mon Sep 17 00:00:00 2001 From: huizezhang-sherry Date: Tue, 4 Jun 2024 17:10:31 -0500 Subject: [PATCH] new function to plot projection --- NAMESPACE | 2 ++ R/plot-projection.R | 59 +++++++++++++++++++++++++++++++++++++++ _pkgdown.yml | 1 + docs/pkgdown.yml | 2 +- docs/reference/data.html | 4 +-- docs/reference/index.html | 10 +++++-- docs/sitemap.xml | 3 ++ man/projection.Rd | 27 ++++++++++++++++++ 8 files changed, 102 insertions(+), 6 deletions(-) create mode 100644 R/plot-projection.R create mode 100644 man/projection.Rd diff --git a/NAMESPACE b/NAMESPACE index c31f446..cf8bc9e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(calc_smoothness) export(calc_squintability) export(clean_method) export(compute_pca) +export(compute_projection) export(explore_space_end) export(explore_space_pca) export(explore_space_start) @@ -43,6 +44,7 @@ export(get_search_count) export(get_space_param) export(get_start) export(get_theo) +export(plot_projection) export(prep_space_tour) export(scale_color_continuous_botanical) export(scale_color_discrete_botanical) diff --git a/R/plot-projection.R b/R/plot-projection.R new file mode 100644 index 0000000..95a891b --- /dev/null +++ b/R/plot-projection.R @@ -0,0 +1,59 @@ +#' Plot the projection from the optimisation data collected from projection pursuit +#' @param dt a data object collected by the projection pursuit guided tour optimisation in \code{tourr} +#' @param data the original data +#' @param cols additional columns to include in the plot +#' @return a ggplot object +#' @examples +#' holes_1d_jellyfish |> get_best() |> plot_projection(data = boa5) +#' @rdname projection +#' @export +plot_projection <- function(dt, data, cols = NULL){ + + cols <- dplyr::syms(cols) + proj_df <- compute_projection(dt, data, cols = cols) + + d <- ncol(proj_df) - 1 - length(cols) + + if (d == 2){ + p <- proj_df |> + ggplot2::ggplot() + + ggplot2::geom_point(ggplot2::aes(x = V1, y = V2)) + } else if (d == 1) { + p <- proj_df |> + ggplot2::ggplot() + + ggplot2::geom_density(ggplot2::aes(x = V1)) + } + + p + ggplot2::facet_wrap(ggplot2::vars(.id)) + + ggplot2::theme_bw() + + ggplot2::theme(aspect.ratio = 1, + axis.ticks = ggplot2::element_blank(), + axis.text = ggplot2::element_blank(), + #axis.title = ggplot2::element_blank(), + panel.grid = ggplot2::element_blank()) +} + + +#' @rdname projection +#' @export +compute_projection <- function(dt, data, cols = NULL){ + + basis_d <- sapply(dt$basis, function(xx) dim(xx)[2], simplify = TRUE) |> unique() + + if (basis_d > 2) { + cli::cli_abort("The basis dimension should be less than 2") + } + + cols <- dplyr::syms(cols) + + suppressWarnings( + dt |> + dplyr::mutate(.id = dplyr::row_number()) |> + dplyr::rowwise() |> + dplyr::mutate(proj = list(tibble::as_tibble(as.matrix(data) %*% basis))) |> + dplyr::select(.id, proj, !!!cols) |> + tidyr::unnest(proj) |> + dplyr::ungroup() + ) +} +globalVariables(c("V1", "V2", ".id", "proj")) diff --git a/_pkgdown.yml b/_pkgdown.yml index 2ce5f18..c3396de 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -15,6 +15,7 @@ reference: - explore_trace_interp - explore_space_pca - explore_space_tour + - plot_projection - flip_sign - title: Get components desc: > diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 754b67f..e6e479f 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,7 +2,7 @@ pandoc: 3.1.1 pkgdown: 2.0.8 pkgdown_sha: ~ articles: {} -last_built: 2024-05-21T17:40Z +last_built: 2024-06-04T22:06Z urls: reference: https://huizezhang-sherry.github.io/ferrn/reference article: https://huizezhang-sherry.github.io/ferrn/articles diff --git a/docs/reference/data.html b/docs/reference/data.html index d60f0d1..3acbe3c 100644 --- a/docs/reference/data.html +++ b/docs/reference/data.html @@ -1,5 +1,5 @@ -Data object collected during the projection pursuit optimisation — holes_1d_geo • ferrnData objects collected during the projection pursuit optimisation — holes_1d_geo • ferrn