How can we demonstrate the visualization capabilities of R?

We will use R to produce surface plots, heat maps and contour projections of 2D surfaces. We will be utilizing R’s ability to make these visualizations to create digital art that resembles Native American vector patterns.

We will further test the capabilities of R by demonstrating visualizations through recursive methods. The images that we will be trying to implement using recursive means are fractals.

\[ \]

Introduction

What exactly are surface plots, heat maps, contour projections of 2D surfaces. What are fractals?

Heat maps are graphs where a matrix’s individual values are denoted by colors. It is a 2D representation that uses colors to help explain relationships of data that would be easier to decipher than looking at a spreadsheet equivalent. We will implement several functions to show these images.

Fractals are geometric figures that are self-similar across all of its scalar levels. That is to say that a smaller part of a fractal at different scales usually resembles the whole fractal. We will implement the Sierpinksi Carpet Fractal in R.

Methodology

Our first goal is to make digital art using surface plots, heat maps and contour projections of two-dimensional surfaces. To do this we must make a given function \(z\). We first assign the independent variables \(x\) and \(y\) with their corresponding vectors of possible values that we choose. We then make a \(z\) function dependent on \(x\) and \(y\). This function will be what we formulate our plots from.

Our second goal is to show how to make fractals without using the built-in R functions. To do this we will demonstrate how to make a well-known fractal, The Sierpinksi Carpet. To make the Sierpinski Carpet we will construct a matrix: \[\boxed{f(A) = \begin{pmatrix} A_{1,1} & A_{1,2} & A_{1,3} \\ A_{2,1} & 0 & A_{2,3} \\ A_{3,1} & A_{3,2} & A_{3,3} \end{pmatrix}}\] After making this matrix, the idea will be to make a \(for-loop\) that can manipulate this matrix in such a way that when the recursive property is in-effect, each element \(A\) is treated just as the initial matrix \(f(A)\) has been treated.

Analysis

Digital Art Through Surface Plots, Heat Maps and Contour Projections

Here we initialize the surface \(z\) to show the 12 points we will sample from.

library("plot3D")         #required library for plots
x <- c(1,2,3,4)           #vector of x-values
y <- c(-1,0,1)            #vector of y-values
z <- 2*x + 5*y            #given function
M <- mesh(x,y)            #creates a rectangular full 2D or 3D grid
zz <- 2*M$x + 5*M$y       #using Mesh in tandem with our independent variables to get our 12 points
M$x
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    2    2    2
## [3,]    3    3    3
## [4,]    4    4    4
M$y
##      [,1] [,2] [,3]
## [1,]   -1    0    1
## [2,]   -1    0    1
## [3,]   -1    0    1
## [4,]   -1    0    1
zz
##      [,1] [,2] [,3]
## [1,]   -3    2    7
## [2,]   -1    4    9
## [3,]    1    6   11
## [4,]    3    8   13
plot(M$x,M$y, xlim=c(0.5,4.5), ylim=c(-1.5,1.5), col = "blue", pch = 16, xlab="x-values", ylab="y-values")          #plotting our points

This is the plot of the actual surface we generate from the given vectors of \(x\) and \(y\).

persp3D( M$x, M$y, zz, colvar=zz, colkey = FALSE, shade = 0.1, box = FALSE, theta = 60)     #plotting the surface

This is the corresonding heat map of the matrix \(zz\). As we can see colors are assigned to each number from the matrix to produce this heat map. Colors that are close to each other are indicative of close numbers.

zz
##      [,1] [,2] [,3]
## [1,]   -3    2    7
## [2,]   -1    4    9
## [3,]    1    6   11
## [4,]    3    8   13
image(zz, axes=FALSE)

Now that we made a heat map in 2D we are going to up the ante and the dimension by one. We will be using the function \(z = cos(x^{2}+y^{2})*e^{\frac{-1}{\pi})\sqrt{x^{2}+y^{2}}}\) as our given function. Repeating the same steps as above we would generate another plot this time 3-dimensional as our initial function does not generate a simple plane in the \(xyz\) coordinate system. \[ \] To get a better descriptive look at the graphical interpretation of this function we must set the independent variables to all the variables within its domain. Since we are dealing with trig functions the domain is \(-2\pi \ to \ 2*\pi\). This time we will consider the function of two variables z= f(x,y), which defines a surface in 3D: \[z=cos(x^2+y^2)e^{\frac{-1}{\pi}\sqrt{x^2+y^2}}\]

x <- seq(-2*pi,2*pi,length.out = 300)             #vector of x-values
y <- seq(-2*pi,2*pi,length.out = 300)             #vector of y-values
M <- mesh(x,y)                                    #creates a rectangular full 2D or 3D grid
z <- cos(x^2 + y^2)*exp((-1/pi)*sqrt(x^2 + y^2))  #our given function
zz <- cos(M$x^2 + M$y^2)*exp((-1/pi)*sqrt(M$x^2 + M$y^2)) #using Mesh in tandem with our independent variables 
persp3D( M$x, M$y, zz, colvar=zz, colkey = FALSE, shade = 0.5, box = FALSE, theta = 60)    #plotting the surface

We will now use our proven methods our gerenating heat maps and contour plots to generate digital art. Our new function is \[z=cos(x^2+y^2)e^{\frac{-1}{\pi^2}\sqrt{x^2+y^2}}\]. We will sample 27 points from the interval \((-4\pi, 4\pi)\).

x <- seq(-4*pi,4*pi,length.out = 27)              #vector of x-values
y <- seq(-4*pi,4*pi,length.out = 27)              #vector of y-values
M <- mesh(x,y)
z <- cos(x^2 + y^2)*exp((-1/pi)*sqrt(x^2 + y^2))  #our given function
zz <- cos(M$x^2 + M$y^2)*exp((-1/pi)*sqrt(M$x^2 + M$y^2)) #using Mesh in tandem with our independent variables
persp3D( M$x, M$y, zz, colvar=zz, colkey = FALSE, shade = 0.5, box = FALSE, theta = 60)   #plotting the surface

We now show the aerial view of the function now added with contour plots to finish our digital art masterpiece.

image2D(zz, axes=FALSE)
contour2D(zz,add=TRUE,colkey=FALSE,drawlabels=FALSE,axes=FALSE,frame=TRUE)

We repeat the same steps as before this time using \(image()\) to plot the heat map. We also use \(contour()\) to superimpose the contour plot of \(z\). Our new function is \[z=tan(x^2+y^2)e^{\frac{-1}{\pi^2}\sqrt{x^2+y^2}}\]. We will sample 27 points from the interval \((-7\pi, 7\pi)\).

x <- seq(-7*pi,7*pi,length.out = 27)
y <- seq(-7*pi,7*pi,length.out = 27)
M <- mesh(x,y)
z <- tan(x^2 + y^2)*exp((-1/pi^2)*sqrt(x^2 + y^2))
zz <- tan(M$x^2 + M$y^2)*exp((-1/pi^2)*sqrt(M$x^2 + M$y^2))
persp3D( M$x, M$y, zz, colvar=zz, colkey = FALSE, shade = 0.5, box = FALSE, theta = 60)

image(zz,axes=FALSE)
contour(zz,add=TRUE,colkey=FALSE,drawlabels=FALSE,axes=FALSE,frame=TRUE)

Fractals

To make the Sierpinksi Carpet we must first generate a matrix f(A).\[\boxed{f(A) = \begin{pmatrix} A & A & A \\ A & 0 & A \\ A & A & A \end{pmatrix}}\] An effective way to do this is with binding. R has built-in functions to bind elements by row and by column. We take advantage of this by using a couple of binds in quick-succesion. First we bind 3 copies of the element \(A\) by column to form a row of 3 elements of A. That will be our top row of our desired matrix. The middle element in the second row will eventually be our “hole” that we see through each of the iterations. To get the second row with a zero in the middle we do the same bind except that we multiply the middle element by 0. It must be multiplied and not just inputted as zero because if the element is a matrix, the act of multipliying by zero will count as multiplying by the zero matrix.

\[ \] We will first generate the matrix above which is the same as a Level 1 Sierpinski Carpet.

IterateCarpet <- function(A){
  B <- cbind(A,A,A)               #Binds three elements names A into a row of A.
  C <- cbind(A,0*A,A)             #Binds three elements names A into a row of A with the middle element  multiplied by 0 to indicate the hole in the level 1 carpet.
  D <- rbind(B,C,B)               #Binds three rows together to form a 3x3 Matrix
  return(D)                       
}

S <- matrix(1,1,1);
S <- IterateCarpet(S);

image(S,col=c(0, 12), axes=FALSE, asp=1)

Now that we have the Level 1 Carpet we must add a \(for-loop\) that will allow us to add the recursion that will show the self-similar property that fractals are known for.

IterateCarpet <- function(A){
  B <- cbind(A,A,A)
  C <- cbind(A,0*A,A)
  D <- rbind(B,C,B)
  return(D)
}

S <- matrix(1,1,1);
for(i in 1:2)
  S <- IterateCarpet(S);

image(S,col=c(0, 12), axes=FALSE, asp=1)

Level 6 Sierpinski Carpet : As you can see we manipulate recursion by changing the number of iteration in the \(for-loop\).

IterateCarpet <- function(A){
  B <- cbind(A,A,A)
  C <- cbind(A,0*A,A)
  D <- rbind(B,C,B)
  return(D)
}

S <- matrix(1,1,1);
for(i in 1:6)
  S <- IterateCarpet(S);

image(S,col=c(0, 12), axes=FALSE, asp=1)

Now that we know our function is reliable in finding fractals we get creative by manipulating the initial matrix \(f(A)\) solely to get various fractals.

IterateStar <- function(A){
  B <- cbind(A,   A*0,  A)
  C <- cbind(A*0, A,    A*0)
  D <- cbind(A,   A*0,  A)
  E <- rbind(B,C,D)
  return(E)
}

t <- matrix(1,1,1);
for(i in 1:6) t <- IterateStar(t);

image(t,col=c(0, 12), axes=FALSE, asp=1)

IterateModified <- function(A){
  B <- cbind(A*0  , A*0,   A)
  C <- cbind(A*0  , A,   A)
  D <- cbind(A  , A,   A)
  E <- rbind(B,C,D)
  return(E)
}

t <- matrix(1,1,1);
for(i in 1:6) t <- IterateModified(t);

image(t,col=c(0, 12), axes=FALSE, asp=1)

We want to look into other kinds of fractals. Fractals can be created by simulating different kinds of dynamical systems.

wallpaper<-function(n=4E4,x0=1,y0=1,a=1,b=4,c=60){
  x<-c(x0,rep(NA,n-1))
  y<-c(y0,rep(NA,n-1))
  cor<-rep(0,n)
  
  
  for (i in 2:n){
    
    x[i] = y[i-1] - sign(x[i-1])*sqrt(abs( b*x[i-1] - c) )
    y[i] = a - x[i-1]
    cor[i]<-round(sqrt((x[i]-x[i-1])^2+(y[i]-y[i-1])^2),0)
  }
  n.c<-length(unique(cor))
  cores<-heat.colors(n.c)
  
  plot(x,y,pch=".",col=cores[cor])
  
}

wallpaper()

Here we use Euler’s Method to simulate chaotic dynamical systems.

library("rgl")
LiSys <- function(n, a=5, b=16, c=1, x0=5, y0=4, z0=10){
  x<-c(x0,rep(NA,n-1))
  y<-c(y0,rep(NA,n-1))
  z<-c(z0,rep(NA,n-1))
  h<-0.01
  for (i in 2:n){
    x[i] = x[i-1] + h*(a*(y[i-1]-x[i-1]))
    y[i] = y[i-1] + h*(x[i-1]*z[i-1] - y[i-1])
    z[i] = z[i-1] + h*(b - x[i-1]*y[i-1] - c*z[i-1])
  }
  require(rgl)
  rgl.clear()
  rgl.points(x,y,z, color=heat.colors(n), size=2)
}
LiSys(20000)

ThoSys <- function(n, b=0.209, x0=0.5, y0=0.4, z0=0.8){
  x<-c(x0,rep(NA,n-1))
  y<-c(y0,rep(NA,n-1))
  z<-c(z0,rep(NA,n-1))
  h<-0.01
  for (i in 2:n){
    x[i] = x[i-1] + h*(sin(y[i-1]) - b*x[i-1])
    y[i] = y[i-1] + h*(sin(z[i-1]) - b*y[i-1])
    z[i] = z[i-1] + h*(sin(x[i-1]) - b*z[i-1])
  }
  require(rgl)
  rgl.clear()
  rgl.points(x,y,z, color=heat.colors(n), size=2)
}

ThoSys(20000)

The Fractal Dragon has many names, The Dragon Curve, The Heighway Dragon or even The Jurassic Park Fractal. It is very difficult to code but the concept is very easy to understand.

Dragon<-function(Iters){
  Rotation<-matrix(c(0,-1,1,0),ncol=2,byrow=T)        #Rotation multiplication matrix
      Iteration<-list()                               #Set up list for segment matrices    for 1st
    Iteration[[1]] <- matrix(rep(0,16), ncol = 4)
    Iteration[[1]][1,]<-c(0,0,1,0)
    Iteration[[1]][2,]<-c(1,0,1,-1)
    Moveposition<-rep(0,Iters)                        #Which point should be shifted to   origin
    Moveposition[1]<-4
  if(Iters > 1)
    {                                                 #where to move to get to origin
    for(l in 2:Iters)
      {#####################################only if >1, because 1 set                           before for loop
      Moveposition[l]<-(Moveposition[l-1]*2)-2#############sets vector of all positions                          in matrix where last point is
      }
    }
  Move<-list() ########################################vector to add to all points to                    shift start at origin
  for (i in 1:Iters)
    {
      half<-dim(Iteration[[i]])[1]/2
      half<-1:half
      for(j in half)
        {########################################Rotate all points 90 degrees                     clockwise
            Iteration[[i]][j+length(half),]<-c(Iteration[[i]][j,1:2]%*%Rotation,Iteration[[i]][j,3:4]%*%Rotation)
        }
      Move[[i]]<-matrix(rep(0,4),ncol=4)
      Move[[i]][1,1:2]<-Move[[i]][1,3:4]<-(Iteration[[i]][Moveposition[i],c(3,4)]*-1)
      Iteration[[i+1]]<-matrix(rep(0,2*dim(Iteration[[i]])[1]*4),ncol=4)##########move           the dragon, set next Iteration's matrix
      for(k in 1:dim(Iteration[[i]])[1])
        {#########################################move dragon by shifting all previous               iterations point 
          Iteration[[i+1]][k,]<-Iteration[[i]][k,]+Move[[i]]###so the start is at the origin
        }
      xlimits<-c(min(Iteration[[i]][,3])-2,max(Iteration[[i]][,3]+2))#Plot
      ylimits<-c(min(Iteration[[i]][,4])-2,max(Iteration[[i]][,4]+2))
      plot(0,0,type='n',axes=FALSE,xlab="",ylab="",xlim=xlimits,ylim=ylimits)
      s<-dim(Iteration[[i]])[1]
      s<-1:s
      segments(Iteration[[i]][s,1], Iteration[[i]][s,2], Iteration[[i]][s,3], x0 = Iteration[[i]][s,4], col= 'red')
  }
  }#########################################################################

Conclusion

R is mainly known for its value in statistics and its number crunching abilities. However it is not well known that R is a software that you can use to make digital art. We used mathematics to show heat maps and fractals, both with ubiquitous application in the world. We have proved that R is a viable way to show amazing artistic creations.

References

  1. Fischer, Ericka. N.p., n.d. Web. 30 May 2016. https://www.pinterest.com/pin/301600506266463011/?from_navigate=true.
  2. Photographic, Warren. Image Library of Nature & Pets. N.p., n.d. Web. 30 May 2016. http://www.warrenphotographic.co.uk/08811-ammonite.
  3. Rouse, Margaret. “Heat Map Definition.” Search Business Analytics. N.p., n.d. Web. 30 May 2016. http://searchbusinessanalytics.techtarget.com/definition/heat-map. Tom. “What Are Fractals?” Frax. N.p., n.d. Web. 30 May 2016. http://fract.al/background.