diff --git a/.Rbuildignore b/.Rbuildignore index cd6c63d..5c572bb 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -11,3 +11,4 @@ ^codemeta\.json$ ^cran-comments\.md$ ^CRAN-RELEASE$ +^data-raw$ diff --git a/NAMESPACE b/NAMESPACE index b030a08..ac57e12 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,7 @@ importFrom(cli,cli_abort) importFrom(ggplot2,"%+replace%") importFrom(magrittr,"%>%") importFrom(rlang,.data) +importFrom(rlang,`:=`) importFrom(tidyr,unnest) importFrom(tourr,basis_random) importFrom(tourr,interpolate) diff --git a/R/calc-smoothness.R b/R/calc-smoothness.R index 844f1b5..38d42eb 100644 --- a/R/calc-smoothness.R +++ b/R/calc-smoothness.R @@ -44,4 +44,4 @@ calc_smoothness <- function(idx, data = sine1000, n_basis = 300, n = 6, d = 2, } -globalVariables(c("basis")) +globalVariables(c("basis", "sine1000")) diff --git a/R/data-pipe-sine.R b/R/data-pipe-sine.R new file mode 100644 index 0000000..bbfbb3b --- /dev/null +++ b/R/data-pipe-sine.R @@ -0,0 +1,42 @@ +#' Simulated sine, pipe, and gaussian mixture +#' +#' Simulated sine and pipe data for calculating optimisation features. +#' Each dataset has 1000 observations and the last two columns contain the +#' intended structure with the rest being noise. +#' @rdname pipe-sine-boa +#' @examples +#' library(ggplot2) +#' library(tidyr) +#' library(dplyr) +#' boa %>% +#' pivot_longer(cols = x1:x10, names_to = "var", values_to = "value") %>% +#' mutate(var = forcats::fct_relevel(as.factor(var), paste0("x", 1:10))) %>% +#' ggplot(aes(x = value)) + +#' geom_density() + +#' facet_wrap(vars(var)) +#' +#' sine1000 |> ggplot(aes(x = V5, y = V6)) + geom_point() + theme(aspect.ratio = 1) +#' pipe1000_8d |> ggplot(aes(x = V5, y = V6)) + geom_point() + theme(aspect.ratio = 1) +#' pipe1000_8d |> ggplot(aes(x = V7, y = V8)) + geom_point() + theme(aspect.ratio = 1) +"sine1000" + +#' @rdname pipe-sine-boa +"pipe1000" + +#' @rdname pipe-sine-boa +"pipe1000_8d" + +#' @rdname pipe-sine-boa +"pipe1000_10d" + +#' @rdname pipe-sine-boa +"pipe1000_12d" + +#' @rdname pipe-sine-boa +"boa" + +#' @rdname pipe-sine-boa +"boa5" + +#' @rdname pipe-sine-boa +"boa6" diff --git a/R/data.R b/R/data.R index d0aedf8..5c2881f 100644 --- a/R/data.R +++ b/R/data.R @@ -1,104 +1,27 @@ -#' Simulated data +#' Data objects collected during the projection pursuit optimisation #' -#' The \code{boa} data is simulated using different Gaussian mixtures with varied centres and weights (see section format for the simulation code). -#' Theses data are simulated for demonstrating the usage of four diagnostic plots in the package, +#' Simulated data to demonstrate the usage of four diagnostic plots in the package, #' users can create their own guided tour data objects and diagnose with the visualisation designed in this package. #' -#' The prefix \code{holes_*} indicates the use of holes index in the guided tour. The suffix \code{*_better/geo} indicates the optimiser used: \code{search_better} and \code{search_geodesic}. -#' -#' The name \code{boa} comes from the fact that the density plot of each variable in the data looks like boa constrictors swallowing multiple French baguettes, rather than elephants, as in the novella the little prince. -#' -#' @format -#' The code for simulating each data object is as follows: -#' \preformatted{ -#' set.seed(123456); -#' holes_1d_geo <- -#' animate_dist(boa5, tour_path = guided_tour(holes(), d = 1, -#' search_f = search_geodesic), -#' rescale = FALSE) -#' -#' set.seed(123456) -#' holes_1d_better <- -#' animate_dist(boa5, tour_path = guided_tour(holes(), d = 1, -#' search_f = search_better), -#' rescale = FALSE) -#' -#'set.seed(123456); -#' holes_1d_jellyfish <- animate_dist( -#' boa5, tour_path = guided_tour( -#' holes(), d = 1, search_f = search_jellyfish, n_jellies = 100, -#' max.tries = 50), rescale = FALSE) -#' -#' set.seed(123456) -#' holes_2d_better <- -#' animate_xy(boa6, tour_path = guided_tour(holes(), d = 2, -#' search_f = search_better), -#' rescale = FALSE) -#' -#' set.seed(123456) -#' holes_2d_better_max_tries <- -#' animate_xy(boa6, tour_path = guided_tour(holes(), d = 2, -#' search_f = search_better, -#' max.tries = 500), -#' rescale = FALSE) -#' -#' library(tidyverse) -#' set.seed(1234) -#' x1 <- rnorm(1000, 0, 1) -#' x2 <- sample(c(rnorm(500, -3, 1), rnorm(500, 3, 1)), size = 1000) -#' x3 <- sample(c(rep(-1, 500), rep(1, 500)), size = 1000) -#' x4 <- sample(c(rnorm(250, -3, 1), rnorm(750, 3, 1)), size = 1000) -#' x5 <- sample(c(rnorm(330, -5, 1), rnorm(340, 0, 1), rnorm(330, 5, 1)), size = 1000) -#' x6 <- sample(c(rnorm(450, -5, 1), rnorm(100, 0, 1), rnorm(450, 5, 1)), size = 1000) -#' x7 <- sample(c(rnorm(500, -5, 1), rnorm(500, 5, 1)), size = 1000) -#' x8 <- rnorm(1000, 0, 1) -#' x9 <- rnorm(1000, 0, 1) -#' x10 <- rnorm(1000, 0, 1) -#' -#' boa <- tibble(x1 = x1, x2 = x2, x3 = x3, x4 = x4, x5 = x5, -#' x6 = x6, x7 = x7, x8 = x8, x9 = x9, x10 = x10) %>% -#' boa <- as_tibble(scale(boa)) -#' boa5 <- select(boa, x1, x2, x8: x10) -#' boa6 <- select(boa, x1, x2, x7: x10) -#' } +#' The prefix \code{holes_*} indicates the use of holes index in the guided tour. +#' The suffix \code{*_better/geo/jellyfish} indicates the optimiser used: +#' \code{search_better}, \code{search_geodesic}, \code{search_jellyfish}. #' #' @examples -#' library(ggplot2) -#' library(tidyr) -#' library(dplyr) -#' boa %>% -#' pivot_longer(cols = x1:x10, names_to = "var", values_to = "value") %>% -#' mutate(var = forcats::fct_relevel(as.factor(var), paste0("x", 1:10))) %>% -#' ggplot(aes(x = value)) + -#' geom_density() + -#' facet_wrap(vars(var)) +#'holes_1d_better %>% +#' explore_trace_interp(interp_size = 2) + +#' scale_color_continuous_botanical(palette = "fern") #' @rdname data "holes_1d_geo" -#' @format #' @rdname data "holes_1d_better" -#' @format #' @rdname data "holes_1d_jellyfish" -#' @format #' @rdname data "holes_2d_better" -#' @format #' @rdname data "holes_2d_better_max_tries" - -#' @format -#' @rdname data -"boa" - -#' @format -#' @rdname data -"boa5" - -#' @format -#' @rdname data -"boa6" diff --git a/R/ferrn-package.R b/R/ferrn-package.R index 886c08e..69a1da2 100644 --- a/R/ferrn-package.R +++ b/R/ferrn-package.R @@ -3,4 +3,5 @@ #' @importFrom GpGp fit_model #' @importFrom cli cli_abort #' @importFrom tidyr unnest +#' @importFrom rlang `:=` "_PACKAGE" diff --git a/data-raw/holes.R b/data-raw/holes.R new file mode 100644 index 0000000..a2104d0 --- /dev/null +++ b/data-raw/holes.R @@ -0,0 +1,49 @@ +#' code to prepare `holes` dataset goes her +set.seed(123456); +holes_1d_geo <- animate_dist(boa5, tour_path = guided_tour( + holes(), d = 1, search_f = search_geodesic), rescale = FALSE) + +set.seed(123456) +holes_1d_better <-animate_dist(boa5, tour_path = guided_tour( + holes(), d = 1, search_f = search_better), rescale = FALSE) + +set.seed(123456); +holes_1d_jellyfish <- animate_dist(boa5, tour_path = guided_tour( + holes(), d = 1, search_f = search_jellyfish, n_jellies = 100, + max.tries = 50), rescale = FALSE) + +set.seed(123456) +holes_2d_better <- animate_xy(boa6, tour_path = guided_tour( + holes(), d = 2, search_f = search_better), rescale = FALSE) + +set.seed(123456) +holes_2d_better_max_tries <- animate_xy(boa6, tour_path = guided_tour( + holes(), d = 2, search_f = search_better, max.tries = 500), rescale = FALSE) + +library(tidyverse) +set.seed(1234) +x1 <- rnorm(1000, 0, 1) +x2 <- sample(c(rnorm(500, -3, 1), rnorm(500, 3, 1)), size = 1000) +x3 <- sample(c(rep(-1, 500), rep(1, 500)), size = 1000) +x4 <- sample(c(rnorm(250, -3, 1), rnorm(750, 3, 1)), size = 1000) +x5 <- sample(c(rnorm(330, -5, 1), rnorm(340, 0, 1), rnorm(330, 5, 1)), size = 1000) +x6 <- sample(c(rnorm(450, -5, 1), rnorm(100, 0, 1), rnorm(450, 5, 1)), size = 1000) +x7 <- sample(c(rnorm(500, -5, 1), rnorm(500, 5, 1)), size = 1000) +x8 <- rnorm(1000, 0, 1) +x9 <- rnorm(1000, 0, 1) +x10 <- rnorm(1000, 0, 1) +boa <- tibble(x1 = x1, x2 = x2, x3 = x3, x4 = x4, x5 = x5, + x6 = x6, x7 = x7, x8 = x8, x9 = x9, x10 = x10) %>% +boa <- as_tibble(scale(boa)) +boa5 <- select(boa, x1, x2, x8: x10) +boa6 <- select(boa, x1, x2, x7: x10) + +usethis::use_data(holes_1d_geo, overwrite = TRUE) +usethis::use_data(holes_1d_better, overwrite = TRUE) +usethis::use_data(holes_1d_jellyfish, overwrite = TRUE) +usethis::use_data(holes_2d_better, overwrite = TRUE) +usethis::use_data(holes_2d_max_tries, overwrite = TRUE) +usethis::use_data(boa, overwrite = TRUE) +usethis::use_data(boa5, overwrite = TRUE) +usethis::use_data(boa6, overwrite = TRUE) + diff --git a/data-raw/pipe-sine.R b/data-raw/pipe-sine.R new file mode 100644 index 0000000..6cc2689 --- /dev/null +++ b/data-raw/pipe-sine.R @@ -0,0 +1,27 @@ +## code to prepare `pipe-sine` dataset goes here +library(spinebil) # devtools::install_github("uschiLaa/spinebil") +set.seed(123456) +sine1000 <- spinebil::sinData(6, 1000) %>% scale() +colnames(sine1000) <- paste0("V", 1:6) + +set.seed(123456) +pipe1000 <- spinebil::pipeData(6, 1000) %>% scale() +colnames(pipe1000) <- paste0("V", 1:6) + +set.seed(123456) +pipe1000_8d <- spinebil::pipeData(8, 1000) %>% scale() +colnames(pipe1000_8d) <- paste0("V", 1:8) + +set.seed(123456) +pipe1000_10d <- spinebil::pipeData(10, 1000) %>% scale() +colnames(pipe1000_10d) <- paste0("V", 1:10) + +set.seed(123456) +pipe1000_12d <- spinebil::pipeData(12, 1000) %>% scale() +colnames(pipe1000_12d) <- paste0("V", 1:12) + +usethis::use_data(sine1000, overwrite = TRUE) +usethis::use_data(pipe1000, overwrite = TRUE) +usethis::use_data(pipe1000_8d, overwrite = TRUE) +usethis::use_data(pipe1000_10d, overwrite = TRUE) +usethis::use_data(pipe1000_12d, overwrite = TRUE) diff --git a/data/pipe1000.rda b/data/pipe1000.rda new file mode 100644 index 0000000..05872de Binary files /dev/null and b/data/pipe1000.rda differ diff --git a/data/pipe1000_10d.rda b/data/pipe1000_10d.rda new file mode 100644 index 0000000..b0c9c79 Binary files /dev/null and b/data/pipe1000_10d.rda differ diff --git a/data/pipe1000_12d.rda b/data/pipe1000_12d.rda new file mode 100644 index 0000000..163f439 Binary files /dev/null and b/data/pipe1000_12d.rda differ diff --git a/data/pipe1000_8d.rda b/data/pipe1000_8d.rda new file mode 100644 index 0000000..523b486 Binary files /dev/null and b/data/pipe1000_8d.rda differ diff --git a/data/sine1000.rda b/data/sine1000.rda new file mode 100644 index 0000000..99f0b30 Binary files /dev/null and b/data/sine1000.rda differ diff --git a/docs/index.html b/docs/index.html index 2f7f5fa..1bd377e 100644 --- a/docs/index.html +++ b/docs/index.html @@ -100,7 +100,7 @@

Usage 
 set.seed(123456)
 holes_1d_better <- animate_dist(
-  ferrn::boa5,
+  ferrn::boa5,
   tour_path = guided_tour(holes(), d = 1,
                           search_f =  search_better), 
   rescale = FALSE)
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 9b22a82..754b67f 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-21T16:44Z +last_built: 2024-05-21T17:40Z urls: reference: https://huizezhang-sherry.github.io/ferrn/reference article: https://huizezhang-sherry.github.io/ferrn/articles diff --git a/docs/reference/Rplot002.png b/docs/reference/Rplot002.png index 9905d47..99a48d8 100644 Binary files a/docs/reference/Rplot002.png and b/docs/reference/Rplot002.png differ diff --git a/docs/reference/Rplot003.png b/docs/reference/Rplot003.png index 88d2a0b..b6d8804 100644 Binary files a/docs/reference/Rplot003.png and b/docs/reference/Rplot003.png differ diff --git a/docs/reference/data-1.png b/docs/reference/data-1.png index 2229810..42b5255 100644 Binary files a/docs/reference/data-1.png and b/docs/reference/data-1.png differ diff --git a/docs/reference/data.html b/docs/reference/data.html index 6a12bde..d60f0d1 100644 --- a/docs/reference/data.html +++ b/docs/reference/data.html @@ -1,6 +1,5 @@ -Simulated data — holes_1d_geo • ferrnData object collected during the projection pursuit optimisation — holes_1d_geo • ferrn