Source this to load functions needed for visualizing 2x2 matrix transformations.
if (!requireNamespace("tidyverse")) install.packages('tidyverse') | |
if (!requireNamespace("gganimate")) install.packages('gganimate') | |
library(tidyverse) | |
library(gganimate) | |
construct_grid <- function(xintercepts = -5:5, yintercepts = -5:5){ | |
bind_rows( | |
crossing(x = xintercepts, | |
y = min(yintercepts), | |
yend = max(yintercepts)) %>% | |
mutate(xend = x), | |
crossing(y = yintercepts, | |
x = min(xintercepts), | |
xend = max(xintercepts)) %>% | |
mutate(yend = y) | |
) %>% | |
select(x, y, xend, yend) | |
} | |
transform_df_coords <- function(df, ..., m = diag(length(df))){ | |
df_names <- names(df) | |
df_coords <- df %>% | |
select(...) | |
df_coords_names <- names(df_coords) | |
df_matrix <- df_coords %>% | |
as.matrix() %>% | |
t() | |
df_coords_new <- (m %*% df_matrix) %>% | |
t() %>% | |
as_tibble() %>% | |
set_names(df_coords_names) | |
df_other <- df %>% | |
select(-one_of(df_coords_names)) | |
bind_cols(df_coords_new, df_other) %>% | |
select(df_names) | |
} | |
animate_matrix_transformation <- function(m, return_static = FALSE){ | |
grid_start <- construct_grid() %>% | |
mutate(id = row_number()) | |
grid_trans <- grid_start %>% | |
# need to `transform_df_coords()` twice as each segment is made up of 2 points | |
transform_df_coords(x, y, m = m) %>% | |
transform_df_coords(xend, yend, m = m) | |
grid_all <- bind_rows( | |
mutate(grid_start, time = 1), | |
mutate(grid_trans, time = 2) | |
) | |
basis_start <- tibble( | |
x = c(0, 0), | |
y = c(0, 0), | |
xend = c(1, 0), | |
yend = c(0, 1), | |
# `vec` is unnecessary, will just use to differentiate colors | |
vec = c("i", "j") | |
) %>% | |
mutate(id = nrow(grid_start) + row_number()) | |
basis_trans <- basis_start %>% | |
transform_df_coords(x, y, m = m) %>% | |
transform_df_coords(xend, yend, m = m) | |
basis_all <- bind_rows( | |
mutate(basis_start, time = 1), | |
mutate(basis_trans, time = 2) | |
) | |
x_breaks <- unique(grid_start$x) | |
y_breaks <- unique(grid_start$y) | |
p <- ggplot(aes(x = x, y = y, group = id), data = grid_all)+ | |
geom_segment(aes(xend = xend, yend = yend))+ | |
geom_segment(aes(xend = xend, yend = yend, colour = vec), data = basis_all, arrow = arrow(length = unit(0.02, "npc")), size = 1.2)+ | |
scale_x_continuous(breaks = x_breaks, minor_breaks = NULL)+ | |
scale_y_continuous(breaks = y_breaks, minor_breaks = NULL)+ | |
coord_fixed()+ | |
theme_minimal()+ | |
theme(axis.text = element_blank(), | |
axis.title = element_blank(), | |
legend.position = "none") | |
if(return_static) return(p) | |
p + gganimate::transition_states(time, wrap = FALSE) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment