U12_Animation

R Markdown

U12: 動作與動畫

繪圖+流程->動畫

畫一個臉

symbols( ) # 圓形 矩形

polygon( ) # 多邊形

圖形元件 – 圓形 矩形 多邊形

layout(1)

par( mex = 0.8, mar = c(5, 4, 4, 2) + 0.1 )

plot( 0:10, 0:10, 
      xlab = "", ylab = "", 
      pch = 1:11, col = 1:8, type = "n" )

axis( side = 1, at = 0:10 )

axis( side = 2, at = 0:10 )

# 臉輪廓
symbols( 5, 5, 
         circles = 6, 
         fg = "blue", 
         lwd = 2, 
         inches = FALSE, 
         add = TRUE )

# 眼睛
symbols( 3.5, 6.5, 
         circles = 0.5, 
         fg = "dark violet", bg = "purple", 
         inches = FALSE, add = TRUE )

symbols( 6.5, 6.5, 
         circles = 0.5, 
         fg = "dark violet", 
         inches = FALSE, add = TRUE )

# 眉毛
symbols( 3.5, 8.5, 
         rectangles = matrix(c(1.5, 0.5), nrow =1), 
         fg = "gray", inches = FALSE, add = TRUE )

symbols( 6.5, 8.5, 
         rectangles = matrix(c(1.5, 0.5), nrow =1), 
         fg = "gray", inches = FALSE, add = TRUE )

# 鼻子
symbols( 5, 4.5, 
         rectangles = matrix(c(0.5, 2), nrow =1), 
         fg = "green", bg = "lightgreen", 
         inches = FALSE, add = TRUE )

# 嘴巴
symbols( 5, 1.5, 
         squares = 1.5, 
         fg = "red", 
         lwd = 2, inches = FALSE, add = TRUE )

# 鬍子
polygon( c(3.5, 3, 2), c(3, 3, 2), 
         col = "orange" )

polygon( c(6.5, 7, 8), c(3, 3, 2), 
         col = "orange" )

######################################################### # 繪圖函數 – myFace( ) # draw face

myFace <- function( cx, cy ) {
  # 臉輪廓
  symbols( cx+0, cy+0, 
           circles = 4, 
           fg = "blue", 
           lwd = 2, 
           inches = FALSE, add = TRUE )
  
  # 眼睛
  symbols( cx-1.5, cy+1.5, 
           circles = 0.5, 
           fg = "dark violet", bg = "purple", 
           inches = FALSE, add = TRUE )
  
  symbols( cx+1.5, cy+1.5, 
           circles = 0.5, 
           fg = "dark violet", bg = "purple", 
           inches = FALSE, add = TRUE )
  
  # 眉毛
  symbols( cx-1.5, cy+3.5, 
           rectangles = matrix(c(1.5, 0.5), nrow =1), 
           fg = "gray", 
           inches = FALSE, add = TRUE )
  
  symbols( cx+1.5, cy+3.5, 
           rectangles = matrix(c(1.5, 0.5), nrow =1), 
           fg = "gray", 
           inches = FALSE, add = TRUE )
  
  # 鼻子
  symbols( cx+0, cy-0.5, 
           rectangles = matrix(c(0.5, 2), nrow =1), 
           fg = "green", bg = "lightgreen", 
           inches = FALSE, add = TRUE )
  
  # 嘴巴
  symbols( cx+0, cy-3.5, 
           squares = 1.5, 
           fg = "red", 
           lwd = 2, inches = FALSE, add = TRUE )
  
  # 鬍子
  polygon( c( cx-1.5, cx-2, cx-3), c( cy-2, cy-2, cy-3), 
           col = "orange" )
  
  polygon( c( cx+1.5, cx+2, cx+3), c( cy-2, cy-2, cy-3), 
           col = "orange" )
  
}

draw some faces

plot( 0, 0, 
      xlab = "", ylab = "", 
      xlim = c(0, 100), ylim=c(0,100) )

myFace( 1, 1 )

myFace( 10, 10 )

myFace( 50, 50 )

myFace( 20, 80 )

繪圖函數 – myFaceOff( )

draw face off

myFaceOff <- function( cx, cy ) {
  
  # 臉輪廓
  symbols( cx+0, cy+0, 
           circles = 4, 
           fg = "white", 
           lwd = 2, inches = FALSE, add = TRUE )
  
  # 眼睛
  symbols( cx-1.5, cy+1.5, 
           circles = 0.5, 
           fg = "white", bg = "white", 
           inches = FALSE, add = TRUE )
  
  symbols( cx+1.5, cy+1.5, 
           circles = 0.5, 
           fg = "white", bg = "white", 
           inches = FALSE, add = TRUE )
  
  # 眉毛
  symbols( cx-1.5, cy+3.5, 
           rectangles = matrix(c(1.5, 0.5), nrow =1), 
           fg = "white", 
           inches = FALSE, add = TRUE )
  
  symbols( cx+1.5, cy+3.5, 
           rectangles = matrix(c(1.5, 0.5), nrow =1), 
           fg = "white", 
           inches = FALSE, add = TRUE )
  
  # 鼻子
  symbols( cx+0, cy-0.5, 
           rectangles = matrix(c(0.5, 2), nrow =1), 
           fg = "white", bg = "white", 
           inches = FALSE, add = TRUE )
  
  # 嘴巴
  symbols( cx+0, cy-3.5, 
           squares = 1.5, fg = "white", 
           lwd = 2, 
           inches = FALSE, add = TRUE )
  
  # 鬍子
  polygon( c( cx-1.5, cx-2, cx-3), c( cy-2, cy-2, cy-3),
           col = "white", border = "white" )
  
  polygon( c( cx+1.5, cx+2, cx+3), c( cy-2, cy-2, cy-3), 
           col = "white", border = "white" )
}

# on Console Windows

plot( 0, 0, 
      xlab = "", ylab = "", 
      xlim = c(0, 100), ylim=c(0,100) )

myFace( 1, 1 )

myFace( 10, 10 )

Sys.sleep(1)

myFace( 50, 50 )

Sys.sleep(1)

myFace( 20, 80 )

Sys.sleep(1)

myFaceOff( 20, 80 )

Sys.sleep(1)

myFaceOff( 50, 50 )

Sys.sleep(1)

myFaceOff( 10, 10 )

Sys.sleep(1)

行走路徑與迴圈控制

#########################################################
# rectangular path

x <- c( -15:15, rep(15, 31), 15:-15, rep(-15, 31) ) 

y <- c( rep(15, 31), 15:-15, rep( -15, 31), -15:15 )

#plot( 0, 0, xlab = "", ylab = "", xlim = c(-20, 20), ylim=c(-20,20) )

windows()

plot( x, y, 
      xlim = c( -25, 25 ), ylim=c( -25, 25 )  )

Num <- length(x)

# one way to animate the face
for ( i in 1:Num ){
  myFace( x[i], y[i] )
  Sys.sleep( 1 )
}

plot( x, y, 
      xlim = c( -25, 25 ), ylim=c( -25, 25 )  )

# good way to animate the face
for ( i in 1:Num ){
  myFace( x[i], y[i] )
  #line <- readline()
  Sys.sleep( 0.1 )
  myFaceOff( x[i], y[i] )
  #line <- readline()
}

#########################################################
# circular path by sin cos 

x <- sin(1:90/45*pi)*15

y <- cos(1:90/45*pi)*15

windows()

plot( x, y, 
      xlim = c( -25, 25 ), ylim=c( -25, 25 )  )

# good way to animate the face
for ( i in 1:Num ){
  myFace( x[i], y[i] )
  #line <- readline()
  Sys.sleep( 0.1 )
  myFaceOff( x[i], y[i] )
  #line <- readline()
}

########################################################
# rhombus path

x <- c( -15:15, 15, 15:-15 ) 

y <- c( 1:15, 15, 15:1, 0, -1:-15, -15, -15:-1 )

windows()

plot( x, y, 
      xlim = c( -25, 25 ), ylim=c( -25, 25 )  )

# good way to animate the face
for ( i in 1:Num ){
  myFace( x[i], y[i] )
  #line <- readline()
  Sys.sleep( 0.1 )
  myFaceOff( x[i], y[i] )
  #line <- readline()
}

# random path
x <- sample( -15:15, 20 )

y <- sample( -15:15, 20 )

plot( x, y, 
      xlim = c( -25, 25 ), ylim=c( -25, 25 )  )

# good way to animate the face
for ( i in 1:Num ){
  myFace( x[i], y[i] )
  #line <- readline()
  Sys.sleep( 1 )
  myFaceOff( x[i], y[i] )
  #line <- readline()
}

畫一個動畫 數據相關

Distribution shifts according to the mean

Visualize filtering threshold

Rotating 3D scatter plot

Stick figures

https://davetang.org/muse/2015/02/12/animated-plots-using-r/

Binomial Density

https://www.r-bloggers.com/animated-plots-with-r/

Happy New Year with R

http://sixf.org/en/2015/02/happy-new-year-with-r/

#########################################################
# 數據排序

mySort <- function( x, plottype ) {
  itemCount <- length( x )
  repeat {
    hasChanged <- FALSE
    itemCount <- itemCount - 1
    if ( itemCount >= 1 ){
      for( k in 1 : itemCount ) {
        if ( x[ k ] > x[ k+1 ] ) {
          t <- x[ k ]
          x[ k ] <- x[ k+1 ]
          x[ k+1 ] <- t
          hasChanged <- TRUE
        }
        # print( c( k , x ) )
        # bubble sort plot, vertical plot
        if( plottype == 1 ){
          plot( x, 1:length(x), pch = 1, cex = 8 )
          text( x, 1:length(x), as.character( x ), col = "red", cex=2 )
        }
        
        # bubble sort plot, horizontal plot
        if( plottype == 2 ){
          plot( x, pch = 1, cex = 8  )
          text( 1:length(x), x, as.character( x ), col = "red", cex=2 )
        }
        
        # some waiting time
        Sys.sleep(0.5)
      } 
    }
    if ( !hasChanged ) break;
  }
  return( x )
}

#########################################################


windows()

layout( 1 )

mySort( 5:1, 1 )

## [1] 1 2 3 4 5

mySort( 5:1, 2 )

## [1] 1 2 3 4 5

mySort( 10:1, 1 )

##  [1]  1  2  3  4  5  6  7  8  9 10

mySort( 10:1, 2 )

##  [1]  1  2  3  4  5  6  7  8  9 10

datain <- sample( 1:10, 10, replace=F )

mySort( datain, 1)

##  [1]  1  2  3  4  5  6  7  8  9 10

mySort( datain, 2)

##  [1]  1  2  3  4  5  6  7  8  9 10

數學函數繪圖

curve( ) # 數學函數繪圖

f <- function(x) 0.01 * x^3 * cos(x) - 0.2 * x^2 * sin(x) + 0.05 * x - 1

par( mex = 0.8, mar = c(5, 5, 4, 2) + 0.1 )

curve( f, 
       from = -10, to = 20 )

curve( f, 
       from = -10, to = 10, 
       n = 20 )

two curves

f <- function(x)  0.01 * x^3 * cos(x) - 0.2 * x^2 * sin(x) + 0.05 * x - 1

g <- function(x)  10 * cos(x) * sin(x)

par( mex = 0.8, mar = c(5, 5, 4, 2) + 0.1 )

curve( f, 
       from = -10, to = 10, 
       lty = 1, col = "red", ylab = "" )

curve( g, 
       add = TRUE, 
       lty = 2, col = "blue" )

legend( "topright", 
        legend = c("f", "g"), 
        lty = 1:2, 
        col = c("red", "blue"))