library("gifski")
## Warning: package 'gifski' was built under R version 4.2.2
library("gganimate")
## Warning: package 'gganimate' was built under R version 4.2.2
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.2.2

Initials KG

x=c(rep(-1,800),seq(0,-1,length.out=800), seq(0, -1, length.out = 800), seq(2,1, length.out = 800), rep(1, 800), seq(1,2, length.out = 800), seq(1.5,2, length.out = 800), rep(2, 800))
y=c(seq(2,-1,length.out=800),seq(-1, 0.5, length.out = 800), seq(2,0.5,length.out=800), rep(2,800), seq(2,-1, length.out = 800), rep(-1,800), rep(0, 800), seq(0,-1, length.out = 800))
z=rbind(x,y)
plot(y~x,xlim=c(-3,3),ylim=c(-3,3))

We will now Left multiply the matrix

leftx <- function(x, y){
  x%*%y
}
  
leftx(matrix(rep(seq(1,3, length.out=3),3), nrow = 3, ncol = 3),diag(3))
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    2    2    2
## [3,]    3    3    3

We can now implement a shear

for (i in seq(0,4,length.out=20)) {
  z_new<-apply(z,2,function(x) leftx(x,matrix(c(1,i,0,1),nrow=2,ncol=2)))
  plot(z_new[2,]~z_new[1,], xlim=c(-3,3), ylim=c(-3,3))
}

Now we will implement an upscale which will enlargen my initials.

for (i in seq(0,4,length.out=20)) {
  z_ext <- rbind(z, numeric(800))
  trans_matrix <- matrix(c(i,0,0,0,1,0,0,0,1), nrow=3, ncol=3)
  tm <- apply(z_ext, 2, function(x) x %*% trans_matrix)
  plot(tm[2,] ~ tm[1,], xlim=c(-3,3), ylim=c(-3,3))
}

We will now rotate the initials

for (i in seq(0,pi*2,length.out=20)) {
  z_new<-apply(z,2,function(x) leftx(x,matrix(c(cos(i),-sin(i),sin(i),cos(i)),nrow=2,ncol=2)))
   plot(z_new[2,]~z_new[1,], xlim=c(-3,3), ylim=c(-3,3))
}

Now we can implement the projection

for (i in seq(0,2*pi,length.out=20)) {
  z_tri<-rbind(z,rep(0,ncol(z)))
  z_new<-apply(z_tri,2,function(x) leftx(x,matrix(c(1,0,0,0,cos(i),-sin(i),0,sin(i),cos(i)),nrow=3,ncol=3)))
   plot(z_new[2,]~z_new[1,], xlim=c(-3,3), ylim=c(-3,3))
}