Intro Thoughts
Status Quo
library(tidyverse)
dims_expand <- function(select) {
structure(
list(),
class = "expand"
)
}
ggplot_add.expand <- function(object, plot, object_name) {
# get expression inside of dims parentheses in `aes(dims = dims(var1:var10))`
# would return "var1:var10"
select_specs <- plot$mapping$dims[[2]] |>
as.character() |>
_[-1] |>
paste(collapse = ", ")
# from plot data point to the select_specs variables that are specified
# and save a data frame, in features_df
features_df <- paste0("select(plot$data,", select_specs, ")") |>
rlang::parse_expr() |>
eval()
# create a vector added to the plot data
plot$data$.dims_stasher <- vector("list", nrow(plot$data))
for (i in 1:nrow(features_df)){
# store the features data as a 1 row data frame in vector .dims_stasher...
plot$data$.dims_stasher[[i]] <- features_df[i,]
}
# overwrite dims mapping to point to new vector that contains features_df
plot$mapping <- modifyList(plot$mapping, aes(dims = .dims_stasher))
plot
}
## Experiment
dims <- function(){}
ggplot(mtcars) +
aes(dims = dims(mpg:drat, qsec), x = 1, y = 1) +
geom_point() +
dims_expand()
## Warning: Subsetting quosures with `[[` is deprecated as of rlang 0.4.0
## Please use `quo_get_expr()` instead.
## This warning is displayed once every 8 hours.
p <- last_plot()
p$mapping
## Aesthetic mapping:
## * `x` -> 1
## * `y` -> 1
## * `dims` -> `.dims_stasher`
p$data$.dims_stasher[[1]]
## mpg cyl disp hp drat qsec
## Mazda RX4 21 6 160 110 3.9 16.46
p$data$.dims_stasher |>
bind_rows() |>
ggdims:::pca_layout()
## # A tibble: 32 × 6
## PC1 PC2 PC3 PC4 PC5 PC6
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 -0.569 0.849 -0.365 0.381 -0.498 -0.0411
## 2 -0.661 0.622 -0.209 0.326 -0.440 -0.127
## 3 -1.84 -0.0330 0.0120 0.472 0.120 0.308
## 4 -0.204 -1.37 -0.366 -0.230 0.0616 0.116
## 5 1.64 -0.233 -0.432 -0.522 -0.202 -0.0427
## 6 -0.0359 -2.10 -0.360 0.345 0.215 0.0195
## 7 2.56 0.502 -0.0550 -0.0120 0.268 0.110
## 8 -2.13 -0.913 0.0217 0.0439 -0.0283 0.308
## 9 -2.46 -1.73 1.35 -0.137 0.468 -0.237
## 10 -0.645 0.126 0.375 0.349 -0.261 -0.281
## # ℹ 22 more rows
then a new compute…
compute_pca_rows <- function (data, scales){
data_for_reduction <- data$dims |> bind_rows()
clean_data <- remove_missing(bind_cols(data_for_reduction,
data |> select(-"dims")))
# set.seed(1345)
clean_data[names(data_for_reduction)] |>
ggdims:::pca_layout() |>
bind_cols(clean_data)
}
StatPca <- ggproto("StatPca", Stat, compute_panel = compute_pca_rows,
default_aes =
aes(x = after_stat(PC1),
y = after_stat(PC2)))
ggplot(mtcars) +
aes(dims = dims(mpg:drat, qsec)) +
dims_expand() +
geom_point(stat = StatPca)
layer_data() |> head()
## PC1 PC2 PC3 PC4 PC5 PC6 mpg
## 1 -0.5685952 0.84898005 -0.36520768 0.3807608 -0.49765844 -0.04111557 21.0
## 2 -0.6609821 0.62175339 -0.20930295 0.3257300 -0.43977398 -0.12688943 21.0
## 3 -1.8354366 -0.03297278 0.01197355 0.4718941 0.12036726 0.30806796 22.8
## 4 -0.2035116 -1.36882397 -0.36607373 -0.2302429 0.06164315 0.11584403 21.4
## 5 1.6428524 -0.23338608 -0.43159980 -0.5216783 -0.20180499 -0.04274421 18.7
## 6 -0.0359078 -2.09857825 -0.35994069 0.3451977 0.21541539 0.01946672 18.1
## cyl disp hp drat qsec PANEL group x y shape colour fill
## 1 6 160 110 3.90 16.46 1 -1 -0.5685952 0.84898005 19 black NA
## 2 6 160 110 3.90 17.02 1 -1 -0.6609821 0.62175339 19 black NA
## 3 4 108 93 3.85 18.61 1 -1 -1.8354366 -0.03297278 19 black NA
## 4 6 258 110 3.08 19.44 1 -1 -0.2035116 -1.36882397 19 black NA
## 5 8 360 175 3.15 17.02 1 -1 1.6428524 -0.23338608 19 black NA
## 6 6 225 105 2.76 20.22 1 -1 -0.0359078 -2.09857825 19 black NA
## size alpha stroke
## 1 1.5 NA 0.5
## 2 1.5 NA 0.5
## 3 1.5 NA 0.5
## 4 1.5 NA 0.5
## 5 1.5 NA 0.5
## 6 1.5 NA 0.5
iris |>
mutate(type = sample(1:2, 150, replace = T)) |>
ggplot() +
aes(dims = dims(Sepal.Length:Petal.Width),
color = Species) +
# --------- the following gets wrapped up to geom_pca ------------
dims_expand() +
geom_point(stat = StatPca)
last_plot() +
facet_wrap(~type)
iris |>
mutate(type = sample(1:2, 150, replace = T)) |>
ggplot() +
aes(dims = dims(Sepal.Length:Petal.Width),
color = Species) +
# --------- the following gets wrapped up to geom_pca ------------
dims_expand() +
geom_point(stat = StatPca)
library(ggdims)
##
## Attaching package: 'ggdims'
## The following objects are masked _by_ '.GlobalEnv':
##
## compute_pca_rows, dims, dims_expand
iris |>
mutate(type = sample(1:2, 150, replace = T)) |>
ggplot() +
aes(dims = dims(Sepal.Length:Petal.Width),
color = Species) +
# --------- the following gets wrapped up to geom_pca ------------
ggdims:::dims_expand() +
ggdims:::geom_umap0()
## Warning: Using `as.character()` on a quosure is deprecated as of rlang 0.3.0. Please use
## `as_label()` or `as_name()` instead.
## This warning is displayed once every 8 hours.
## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.
## ℹ The deprecated feature was likely used in the ggdims package.
## Please report the issue to the authors.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
last_plot() +
facet_wrap(facet = vars(Species))
library(ggdims)
penguins |>
mutate(type = sample(1:2, 344, replace = T)) |>
ggplot() +
aes(dims = dims(bill_length_mm:body_mass_g),
color = species) +
# --------- the following gets wrapped up to geom_pca ------------
ggdims:::dims_expand() +
ggdims:::geom_umap0()
last_plot() +
facet_wrap(facet = vars(species))
library(ggplot2)
penguins |>
ggplot() +
facet_wrap(facet = vars(species)) +
aes(x = bill_length_mm) +
aes(y = body_mass_g) +
geom_point(data = penguins |>
select(-species)) +
aes(shape = 21 |> I()) +
aes(fill = "grey" |> I()) +
geom_point(fill = "midnightblue") +
aes(color = "lightgrey" |> I()) +
aes(size = 3 |> I()) +
aes(alpha = 1 |> I())