Quick start

I made a gist² containing the functions needed to produce a simple animation of a 2×2 matrix transformation. If you are reading this post with the sole goal of creating an animation like the one below³, you can copy and run this code chunk to render a 2×2 matrix transformation gif (the input to argument m can be any 2×2 matrix of interest).

if (!requireNamespace("devtools")) install.packages("devtools")
devtools::source_gist("https://gist.github.com/brshallo/6a125f9c96dac5445cebb97cc62bfc9c")

animate_matrix_transformation(m = matrix(c(0.5, 0.5, 0.5, -0.25), nrow = 2))

Over the next several sections I’ll walk through the thinking behind this code (culminating in the Visualizations section, where this animation will be shown again). Sections in the Appendix contain variations on this animation that add-on additional simple transformations and layers.

Helper functions

construct_grid(): given vectors of x and y intercepts, return a dataframe with columns x, y, xend, yend (meant for input into geom_segment()).

library(tidyverse)
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)
}

Use with geom_segment() to make simple grids:

construct_grid() %>% 
  ggplot(aes(x = x, y = y, xend = xend, yend = yend))+
  geom_segment()+
  coord_fixed()+
  ggforce::theme_no_axes()+
  theme(panel.border = element_blank())

transform_df_coords(): Given dataframe, column names of coordinates⁴, and a transformation matrix, return dataframe with transformed coordinates.

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)
}

transform_df_coords() is just matrix multiplication, but facilitates applying matrix transformations on a dataframe where each row (in specified columns) represents a vector / coordinate point⁵.

Example in \(\mathbb{R}^2\):

transform_df_coords(tibble(x = 1:4, y = 1:4), x, y, m = matrix(1:4, nrow = 2)) %>% 
  knitr::kable()

Again, this is the same as:

\[ \left(\begin{array}{cc} 1 & 3\\ 2 & 4 \end{array}\right) \left(\begin{array}{cc} 1 & 2 & 3 & 4 \\ 1 & 2 & 3 & 4 \end{array}\right) = \left(\begin{array}{cc} 4 & 8 & 12 & 16 \\ 6 & 12 & 18 & 24 \end{array}\right)\]

(Just with a ‘tidy’ dataframe as output.)

Also works with more dimensions, see example in \(\mathbb{R}^3\):

transform_df_coords(tibble(x = 1:5, y = 1:5, z = 1:5), x, y, z, m = matrix(1:9, nrow = 3)) %>% 
  knitr::kable()

However for our visualizations, we only care about examples in 2 dimensions (when we are applying a 2×2 matrix transformation).

Construct objects for graph

For a simple animation I will build dataframes that contain the coordinates for the following objects⁶:

• a starting grid and a transformed grid
• a starting basis vector and a transformed basis vector

To play nicely with gganimate the start and transformed objects need to have additional properties⁷:

• a field that groups like objects across the animation (e.g. id column)
• a field that designates transitions between start and transformed states (e.g. time column)

For my example I will be applying the following matrix transformation to our basis vectors⁸. \[ \left(\begin{array}{cc} 0.5 & 0.5\\ 0.5 & -0.25 \end{array}\right)\]

Define transformation matrix:

# same as above examples using `matrix()` but I find inputting into tribble more
# intuitive for 2x2 matrix
transformation_matrix <- tribble(~ x, ~ y,
                                 0.5, 0.5,
                                 0.5, -0.25) %>% 
  as.matrix()

Construct grids:

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 = transformation_matrix) %>% 
  transform_df_coords(xend, yend, m = transformation_matrix)

grid_all <- bind_rows(
  mutate(grid_start, time = 1),
  mutate(grid_trans, time = 2)
)

Construct basis vectors:

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 = transformation_matrix) %>% 
  transform_df_coords(xend, yend, m = transformation_matrix)

basis_all <- bind_rows(
  mutate(basis_start, time = 1),
  mutate(basis_trans, time = 2)
)

Build visualization

Define breaks in grid:

# If you just want to use the starting grid for the breaks, could do
x_breaks <- unique(grid_start$x)
y_breaks <- unique(grid_start$y)

Define visualization:

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")

p

p + gganimate::transition_states(time, wrap = FALSE)

Appendix

The code used to construct images within the appendix is very similar to code already shown¹¹.

rotate_trans <- tribble(~ x, ~ y,
                        cos(pi / 2), -sin(pi / 2),
                        sin(pi / 2), cos(pi / 2)) %>%
  as.matrix()

sheer_trans <- tribble(~ x, ~ y,
                      1, 0,
                      0.5, 1) %>%
  as.matrix() 

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 = rotate_trans) %>% 
  transform_df_coords(xend, yend, m = rotate_trans)

grid_trans2 <- grid_trans %>% 
  # need to `transform_df_coords()` twice as each segment is made up of 2 points
  transform_df_coords(x, y, m = sheer_trans) %>% 
  transform_df_coords(xend, yend, m = sheer_trans)

grid_all <- bind_rows(
  mutate(grid_start, time = 1),
  mutate(grid_trans, time = 2),
  mutate(grid_trans2, time = 3)
) 

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 %>% 
  # need to `transform_df_coords()` twice as each segment is made up of 2 points
  transform_df_coords(x, y, m = rotate_trans) %>% 
  transform_df_coords(xend, yend, m = rotate_trans)

basis_trans2 <- basis_trans %>% 
  # need to `transform_df_coords()` twice as each segment is made up of 2 points
  transform_df_coords(x, y, m = sheer_trans) %>% 
  transform_df_coords(xend, yend, m = sheer_trans)

basis_all <- bind_rows(
  mutate(basis_start, time = 1),
  mutate(basis_trans, time = 2),
  mutate(basis_trans2, time = 3)
) 

p_mult <- 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") 

p_mult 

p_mult + 
  gganimate::transition_states(time, wrap = FALSE) 

circle_df <- tibble(x0 = 0, y0 = 0, r = 5)

p_rotation <- ggplot(aes(), data = filter(grid_all, time <= 2))+
  geom_segment(aes(x = x, y = y, group = id, xend = xend, yend = yend))+
  geom_segment(aes(x = x, y = y, group = id, xend = xend, yend = yend, colour = vec), arrow = arrow(length = unit(0.02, "npc")), size = 1.2, data = filter(basis_all, time <= 2 ))+
  scale_x_continuous(breaks = x_breaks, minor_breaks = NULL)+
  scale_y_continuous(breaks = y_breaks, minor_breaks = NULL)+
  coord_fixed()+
  ggforce::geom_circle(aes(x0 = 0, y0 = 0, r = 5), data = circle_df)+
  theme_minimal()+
  theme(axis.text = element_blank(),
        axis.title = element_blank(),
        legend.position = "none")

p_rotation + gganimate::transition_states(time, wrap = FALSE) 

animate_matrix_transformation(m = matrix(c(-1, 0, 0, 1), nrow = 2))

points_start <- crossing(x = c(-3.5:3.5), y = c(-3.5:3.5)) %>% 
  mutate(id = nrow(grid_start) + nrow(basis_start) + row_number())
 
points_trans <- points_start %>% 
  transform_df_coords(x, y, m = rotate_trans)

points_all <- bind_rows(
  mutate(points_start, time = 1),
  mutate(points_trans, time = 2))

p_points <- p +
  geom_point(data = points_all, colour = "royalblue3")

p_points + gganimate::transition_states(time, wrap = FALSE)

# maybe just my eyes... maybe need to increase framerate... or something

p_points <- p_rotation +
  geom_point(aes(x, y), data = points_all, colour = "royalblue3")

p_points + gganimate::transition_states(time, wrap = FALSE) 

x_breaks <-
  seq(
    from = 
      floor(min(c(grid_all$x, grid_all$xend))), 
    to = 
      ceiling(max(c(grid_all$x, grid_all$xend))), 
    by = 1)

y_breaks <-
  seq(
    from = 
      floor(min(c(grid_all$y, grid_all$yend))), 
    to = 
      ceiling(max(c(grid_all$y, grid_all$yend))), 
    by = 1)