library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6      ✔ purrr   0.3.5 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.5.0 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(gifski)

Assignment

One of the most useful applications for linear algebra in data science is image manipulation. We often need to compress, expand, warp, skew, etc. images. To do so, we left multiply a transformation matrix by each of the point vectors.

Part 1

For this assignment, build the first letters for both your first and last name using point plots in R.

For example, the following code builds an H.

x=c(rep(0,500),seq(0,1,length.out=1000), rep(1,500))
y=c(seq(-1,1,length.out=500),rep(0,1000), seq(-1,1,length.out=500))
z=rbind(x,y)
plot(y~x, xlim=c(-3,3), ylim=c(-3,3))

My initials are JW, so now let’s plot the J.

Equation for circle is:

\[ (x-h)^2 + (y-k)^2=r^2 \]

This result is a pair of equations in the form:

\[ y=\pm \sqrt{r^2-(x-h)^2}+k \]

Plot J

Therefore, we want the lower half (or negative) for the bottom part of the J.

# horizontal straight line
x_1_j = seq(-2,0,length.out=500)
y_1_j = rep(2,500)

# vertical straight line
x_2_j = rep(-1,500)
y_2_j = seq(2,-1,length.out=500)

# half circle
x_3_j = seq(-3,-1, length.out=500)
y_3_j = -sqrt(1 - (x_3_j -(-2))^2) - 1

x_j = c(x_1_j, x_2_j, x_3_j)
y_j = c(y_1_j, y_2_j, y_3_j)

# plot
plot(y_j~x_j, xlim=c(-3,4),ylim=c(-3,3))

Now let’s plot the W.

Plot W

This can be achieved by plotting four lines with diagonal slopes, with two half as long as the others. We can implement this using:

\[ y = mx + b \] Where m is the slope of the line, b is the intercept, and xand y are the distance from each axis. We can calculate m by dividing rise by run:

\[ m=\frac{y_2-y_1}{x_2-x_1} \]

Then we can substitute m for each point to get b.

We will start the W at point (1,2), right after the J.

Line 1: m = -4, b = 6, y = -4x + 6

  • From (1,2) to (2,-2)

Line 2: m = -4, b = -6, y = -4x - 6

  • From (2,-2) to (2.5,0)

Line 3: m = 4, b = -10, y = 4x -10

  • From (2.5,0) to (3,-2)

Line 4: m = 0, b = -2, y = -4x - 6

  • From (3,-2) to (4,2)
x_1_w <- seq(1,2,length.out=1000)
y_1_w <- -4 * x_1_w + 6

x_2_w <- seq(2, 2.5, length.out=500)
y_2_w <- 4 * x_2_w - 10

x_3_w <- seq(2.5, 3, length.out=500)
y_3_w <- -4 * x_3_w + 10

x_4_w <- seq(3, 4, length.out=1000)
y_4_w <- 4 * x_4_w - 14

x_w <- c(x_1_w, x_2_w, x_3_w, x_4_w)
y_w <- c(y_1_w, y_2_w, y_3_w, y_4_w)

w_plot <- plot(y_w~x_w, xlim=c(-3,4),ylim=c(-3,3))

Let’s put these together

Plot JW together

# define x
x <- c(x_j, x_w)
y <- c(y_j, y_w)
jw <- rbind(x,y)

# plot jw
plot(y~x, xlim=c(-3,4),ylim=c(-3,3))

Part 2

Then, write R code that will left multiply (%>%) a square matrix (x) against each of the vectors of points (y). Initially, that square matrix will be the Identity matrix. Use a loop that changes the transformation matrix incrementally to demonstrate 1) shear, 2) scaling, 3) rotation , and 4) projection in animated fashion.

Identity matrix

Create an identity matrix.

(identity <- diag(2))
##      [,1] [,2]
## [1,]    1    0
## [2,]    0    1

Shear matrix

Create a shear matrix parallel to the x-axis of factor 2.

(shear <- matrix(c(1,0,2,1), nrow = 2,ncol = 2))
##      [,1] [,2]
## [1,]    1    2
## [2,]    0    1

Scale

Create a matrix that scales

(scale <- matrix(c(0.1,0,0,0.1), nrow = 2, ncol = 2))
##      [,1] [,2]
## [1,]  0.1  0.0
## [2,]  0.0  0.1

Rotation

Create a matrix for rotation.

(rotate <- matrix(c(cos(0),sin(0),-sin(0), cos(0)), nrow = 2, ncol = 2))
##      [,1] [,2]
## [1,]    1    0
## [2,]    0    1

Projection

Create a projection matrix onto the x-axis.

(project <- matrix(c(1,0,0,0), nrow = 2, ncol = 2))
##      [,1] [,2]
## [1,]    1    0
## [2,]    0    0

Let’s put this all together

Final animation

# create list of transformation types
trans_type <- c("identity","shear","scale","rotate","project")

# loop through transformation types
for (t in trans_type) {
  # sets loop for transformation, applies and plots it
  for (i in seq(0,pi*2, length.out=30)) {
    trans_matrix.data <- dplyr::case_when(
      t=="identity" ~ identity,
      t=="shear" ~ matrix(c(1,0,i*2,1), nrow = 2,ncol = 2),
      t=="scale" ~ matrix(c(i+0.1,0,0,i+0.1), nrow = 2, ncol = 2),
      t=="rotate" ~ matrix(c(cos(i),sin(i),-sin(i), cos(i)), nrow = 2, ncol = 2),
      t=="project" ~ matrix(c(1,0,0,0), nrow = 2, ncol = 2))
    trans_matrix <- matrix(trans_matrix.data, nrow = 2)
    tjw <- apply(jw, 2, function(z) z %*% trans_matrix)
    plot(tjw[2,] ~ tjw[1,], xlim=c(-3,4),ylim=c(-3,3), xlab = "x",ylab = "y")
  }
}