This tutorial is about creating animated graphics in r with several packages particulary the gganimate package.

dir<-"/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/DataMiningscience/gganimate/gganimatetutorials"

knitr::opts_knit$set(root.dir = normalizePath(dir))

setwd(dir)
#==================================================================
#  Set up parallel processing
# leave two cores for operating system
#==================================================================

cluster <- makeCluster(detectCores() - 2) 
registerDoParallel(cluster)
#==================================================================
#display all coumns of data with dplyr
# Print first 1000 rows of dataset
#==================================================================

options(dplyr.width = Inf)

options(dplyr.print_max = 1000)



average=data.table::fread("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Econ9000/averageoecd.csv")

incidence=data.table::fread("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Econ9000/incidenceoecd.csv")

duration=data.table::fread("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Econ9000/unemploydur.csv")

#str(duration)

#glimpse(duration)

str(incidence)
## Classes 'data.table' and 'data.frame':   52387 obs. of  21 variables:
##  $ COUNTRY              : chr  "AUS" "AUS" "AUS" "AUS" ...
##  $ Country              : chr  "Australia" "Australia" "Australia" "Australia" ...
##  $ SEX                  : chr  "MW" "MW" "MW" "MW" ...
##  $ Sex                  : chr  "All persons" "All persons" "All persons" "All persons" ...
##  $ AGE                  : int  1519 1519 1519 1519 1519 1519 1519 1519 1519 1519 ...
##  $ Age                  : chr  "15 to 19" "15 to 19" "15 to 19" "15 to 19" ...
##  $ DURATION             : chr  "UN1" "UN1" "UN1" "UN1" ...
##  $ Duration             : chr  "< 1 month" "< 1 month" "< 1 month" "< 1 month" ...
##  $ FREQUENCY            : chr  "A" "A" "A" "A" ...
##  $ Frequency            : chr  "Annual" "Annual" "Annual" "Annual" ...
##  $ TIME                 : int  2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 ...
##  $ Time                 : int  2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 ...
##  $ Unit Code            : chr  "PC" "PC" "PC" "PC" ...
##  $ Unit                 : chr  "Percentage" "Percentage" "Percentage" "Percentage" ...
##  $ PowerCode Code       : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ PowerCode            : chr  "Units" "Units" "Units" "Units" ...
##  $ Reference Period Code: logi  NA NA NA NA NA NA ...
##  $ Reference Period     : logi  NA NA NA NA NA NA ...
##  $ Value                : num  27.2 25.4 28.5 28.7 32.2 ...
##  $ Flag Codes           : logi  NA NA NA NA NA NA ...
##  $ Flags                : logi  NA NA NA NA NA NA ...
##  - attr(*, ".internal.selfref")=<externalptr>
#str(average)
Sys.setenv("plotly_username"="Nana148")
Sys.setenv("plotly_api_key"="••••••••••")
theme_set(theme_bw())
p <- ggplot(incidence, aes(Time, Value, size =Value, frame = COUNTRY)) +
  geom_smooth(method="loess", colour = '#0072B2') +labs(y="Unemployment rate(%)",x="Year")
  


#suppressWarnings(suppressMessages(gganimate(p)))


gganimate(p, "output.html")
#gganimate(p, interval = 0.9, "output.html")

#suppressWarnings(suppressMessages(gganimate(p,"/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/DataMiningscience/oecd.gif")))


p <- ggplot(incidence, aes(Time, Value, size =Value, frame = COUNTRY)) +
  geom_point(aes()) 

p <- ggplotly(p)

p <- p %>%
  animation_slider(
    currentvalue = list(prefix = "Country ", font = list(color="red"))
  )
p

Fig. 30 

theme_set(theme_bw())
p <- ggplot(incidence, aes(Time, Value, size =Value, frame = COUNTRY))+
#p <- ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, color = continent, frame = year)) +
  stat_summary(fun.y="mean", geom="line",color="purple")+labs(y="Unemployment rate(%)",x="Year")


#gganimate::gganimate(p)

#gganimate(p, "output.gif")
#gganimate::gganimate_save(p,"/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/DataMiningscience/oecd1.gif")

p <- ggplotly(p)

p <- p %>%
  animation_slider(
    currentvalue = list(prefix = "Country ", font = list(color="red"))
  )
p

Fig. 30 

theme_set(theme_bw())
p <- ggplot(incidence, aes(Time, Value, size =Value, frame = COUNTRY))+
#p <- ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, color = continent, frame = year)) +
  stat_summary(fun.data="mean_cl_boot",color="purple")+labs(y="Unemployment rate(%)",x="Year")

#gganimate::gganimate(p)

gganimate(p, "output.mp4")
p <- ggplotly(p)

p <- p %>%
  animation_slider(
    currentvalue = list(prefix = "Country ", font = list(color="red"))
  )
p

Fig. 30 

# Create a shareable link to your chart
# Set up API credentials: https://plot.ly/r/getting-started
#chart_link = api_create(p, filename="gganimations/unemployment")
theme_set(theme_bw())
p <- ggplot(incidence, aes(Time, Value, size =Value, frame = COUNTRY))+

  
  geom_bar(stat="identity") +
labs(y="Unemployment rate(%)",x="Year")

#gganimate::gganimate(p)
library(plotly)

p <- incidence %>%
  plot_ly(
    x = ~Time, 
    y = ~Value, 
    size = ~Value, 
    #color = ~continent, 
    frame = ~COUNTRY, 
    text = ~COUNTRY, 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  ) %>%
  layout(title = "Unemployment Rates Accross OECD Countries",
         xaxis = list(title = "Year"),
         yaxis = list (title = "Unemployment rate(%)"))



p %>% 
  animation_opts(
    1000, easing = "elastic", redraw = FALSE
  ) %>% 
  animation_button(
    x = 1, xanchor = "right", y = 0, yanchor = "bottom"
  ) %>%
  animation_slider(
    currentvalue = list(prefix = "COUNTRY ", font = list(color="red"))
  )

Fig. 30 

p

Fig. 30 

# Create a shareable lin
library(imager)
fname="/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/DataMiningscience/gganimate/gganimatetutorials/output.mp4"

#load.video(fname,skip=2)%>%play
d<-tq_get("AMZN",from="2018-01-01")
d$Index<-1:dim(d)[1]
d%>%head()
## # A tibble: 6 x 8
##   date        open  high   low close  volume adjusted Index
##   <date>     <dbl> <dbl> <dbl> <dbl>   <dbl>    <dbl> <int>
## 1 2018-01-02  1172  1190  1171  1189 2694500     1189     1
## 2 2018-01-03  1188  1205  1188  1204 3108800     1204     2
## 3 2018-01-04  1205  1216  1205  1210 3022100     1210     3
## 4 2018-01-05  1218  1229  1210  1229 3544700     1229     4
## 5 2018-01-08  1236  1253  1232  1247 4279500     1247     5
## 6 2018-01-09  1257  1259  1242  1253 3661300     1253     6
p10<-d %>%
ggplot(aes(x = date, y = close,frame=Index, cumulative = TRUE)) +
geom_line() +
#geom_ma(color = "darkgreen") +
 theme_calc() + scale_color_calc()


gganimate(p10,interval = 0.5, title_frame = T, "output2.html")
p10 <- ggplotly(p10)

p10 <- p10 %>% 
  animation_opts(
    1000, easing = "elastic", redraw = FALSE
  )

p

Fig. 30 

library(plotly)
library(quantmod)

getSymbols("AAPL",src='yahoo')
## [1] "AAPL"
df <- data.frame(Date=index(AAPL),coredata(AAPL))
df <- tail(df, 90)
df$ID <- seq.int(nrow(df))

accumulate_by <- function(dat, var) {
  var <- lazyeval::f_eval(var, dat)
  lvls <- plotly:::getLevels(var)
  dats <- lapply(seq_along(lvls), function(x) {
    cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
  })
  dplyr::bind_rows(dats)
}

df <- df %>%
  accumulate_by(~ID)

p <- df %>%
  plot_ly(
    x = ~ID, 
    y = ~AAPL.Close, 
    frame = ~frame,
    type = 'scatter', 
    mode = 'lines', 
    fill = 'tozeroy', 
    fillcolor='rgba(114, 186, 59, 0.5)',
    line = list(color = 'rgb(114, 186, 59)'),
    text = ~paste("Day: ", ID, "<br>Close: $", AAPL.Close), 
    hoverinfo = 'text'
  ) %>%
  layout(
    title = "AAPL: Last 90 days",
    yaxis = list(
      title = "Close", 
      range = c(0,200), 
      zeroline = F,
      tickprefix = "$"
    ),
    xaxis = list(
      title = "Day", 
      range = c(0,30), 
      zeroline = F, 
      showgrid = F
    )
  ) %>% 
  animation_opts(
    frame = 100, 
    transition = 0, 
    redraw = FALSE
  ) %>%
  animation_slider(
    currentvalue = list(
      prefix = "Day "
    )
  )

p

Fig. 30 

# Get stock prices
stocks <- c("AAPL", "FB", "NFLX", "GOOG","AMZN") %>%
tq_get(from = "2018-01-01")
stocks$Index<-1:dim(stocks)[1]
stocks%>%head()
## # A tibble: 6 x 9
##   symbol date        open  high   low close   volume adjusted Index
##   <chr>  <date>     <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl> <int>
## 1 AAPL   2018-01-02   170   172   169   172 25555900      172     1
## 2 AAPL   2018-01-03   173   175   172   172 29517900      172     2
## 3 AAPL   2018-01-04   173   173   172   173 22434600      172     3
## 4 AAPL   2018-01-05   173   175   173   175 23660000      174     4
## 5 AAPL   2018-01-08   174   176   174   174 20567800      174     5
## 6 AAPL   2018-01-09   175   175   173   174 21584000      174     6
# Plot for stocks
p<-stocks %>%
ggplot(aes(date, adjusted, color = symbol,frame=Index, cumulative = TRUE)) +
geom_line() +
labs(title = "Multi stock example",
xlab = "Date",
ylab = "Adjusted Close")+
theme_tq() +
scale_color_tq()

gganimate(p,interval = 0.5, title_frame = F, "output3.html")
p <- ggplotly(p)

p <- p %>% 
  animation_opts(
    1000, easing = "elastic", redraw = FALSE
  )
library(plotly)

accumulate_by <- function(dat, var) {
  var <- lazyeval::f_eval(var, dat)
  lvls <- plotly:::getLevels(var)
  dats <- lapply(seq_along(lvls), function(x) {
    cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
  })
  dplyr::bind_rows(dats)
}

dd <- stocks %>%
  accumulate_by(~date)


dd$symbol=as_factor(dd$symbol)


dd%>%dplyr::group_by(symbol)%>%tally()
## # A tibble: 5 x 2
##   symbol     n
##   <fct>  <int>
## 1 AAPL    1128
## 2 FB      1128
## 3 NFLX    1128
## 4 GOOG    1128
## 5 AMZN    1128
dd%>%dplyr::group_by(symbol)%>%dplyr::count()
## # A tibble: 5 x 2
## # Groups:   symbol [5]
##   symbol     n
##   <fct>  <int>
## 1 AAPL    1128
## 2 FB      1128
## 3 NFLX    1128
## 4 GOOG    1128
## 5 AMZN    1128
dd$Index=rep(1:5,each=1128)



p <- dd %>%
  plot_ly(
    x = ~as.numeric(dd$date), 
    y = ~close,
    split = ~symbol,
    frame = ~Index, 
    type = 'scatter',
    mode = 'lines', 
    line = list(simplyfy = F)
  ) %>% 
  layout(
    xaxis = list(
      title = "Date",
      zeroline = F
    ),
    yaxis = list(
      title = "Closing Price",
      zeroline = F
    )
  ) %>% 
  animation_opts(
    frame = 2000, 
    transition = 0, 
    redraw = FALSE
  ) %>%
  
  animation_button(
    x = 1, xanchor = "right", y = 0, yanchor = "bottom"
  )

p

Fig. 30 

saveHTML({


  
plot(d$date, d$close, type = "l", 
  xlab = "date", ylab = "Price")

ani.options(interval = 0.5, loop = T, title = "Stock price of Vanke")

ani.options(d$date, d$Index, lwd = 4)

}, img.name = 'stock_plot', htmlfile = "stock.html", title = 'Stock Price Animation',
         description = c(''))
## don't try to open the output automatically
#ani.options(autobrowse = FALSE)




saveHTML({
  for(i in 1:100){
    curve(sin(x), from = -5 + (i * 0.05), to = 5 + (i * 0.05), col = "red", ylab = "")
    curve(cos(x), from = -5 + (i * 0.05), to = 5 + (i * 0.05), add = TRUE, col = "blue", ylab = "")
    legend("topright", legend = c("sin(x)", "cos(x)"), fill = c("red", "blue"), bty = "n")
  }
}, interval = 0.1, ani.width = 550, ani.height = 350)
library(animation)
saveHTML({
  for(i in 1:seq(10,100,length.out = 10)){
    #sample(x, size, replace = FALSE, prob = NULL)

    plot(d$date[i], d$close[i], type = "l", 
  xlab = "date", ylab = "Price")
    

  
  }
}, interval = 0.5, ani.width = 550, ani.height = 350)
library(plotly)



p <- d %>%
  plot_ly(
    x = ~close,
    y = ~volume,
    frame = ~Index,
    type = 'scatter',
    mode = 'markers',
    showlegend = F
  )


p <- p %>% 
  animation_opts(
    2000, easing = "elastic", redraw = FALSE
  )

p

Fig. 30 

# You can also save the animation to a file, such as an GIF, video, or an animated webpage:
# 
# gganimate(p, "output.gif")
# gganimate(p, "output.mp4")
# gganimate(p, "output.swf")
# gganimate(p, "output.html")
#==================================================================
#  Stop Cluster
#
#==================================================================

stopCluster(cluster)
sessionInfo()
## R version 3.4.1 (2017-06-30)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Sierra 10.12.6
## 
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] grid      parallel  stats     graphics  grDevices utils     datasets 
## [8] methods   base     
## 
## other attached packages:
##  [1] imager_0.40.2              magrittr_1.5              
##  [3] plyr_1.8.4                 bindrcpp_0.2              
##  [5] gridExtra_2.3              scales_0.5.0.9000         
##  [7] tweenr_0.1.5               animation_2.5             
##  [9] ggthemes_3.4.0             doParallel_1.0.11         
## [11] iterators_1.0.9            foreach_1.4.4             
## [13] ggmap_2.6.1                plotly_4.7.1              
## [15] tidyquant_0.5.3            forcats_0.2.0             
## [17] stringr_1.3.0              dplyr_0.7.4               
## [19] purrr_0.2.4                readr_1.1.1               
## [21] tidyr_0.8.0                tibble_1.4.2              
## [23] ggplot2_2.2.1.9000         tidyverse_1.2.1           
## [25] quantmod_0.4-12            TTR_0.23-3                
## [27] PerformanceAnalytics_1.5.2 xts_0.10-1                
## [29] zoo_1.8-1                  lubridate_1.7.1           
## [31] magick_1.6                 gganimate_0.1.0.9000      
## 
## loaded via a namespace (and not attached):
##  [1] colorspace_1.3-2    rjson_0.2.15        timetk_0.1.0       
##  [4] rprojroot_1.2       htmlTable_1.11.2    base64enc_0.1-3    
##  [7] rstudioapi_0.7      xml2_1.2.0          codetools_0.2-15   
## [10] splines_3.4.1       mnormt_1.5-5        knitr_1.20         
## [13] readbitmap_0.1-4    Formula_1.2-2       jsonlite_1.5       
## [16] broom_0.4.3         cluster_2.0.6       png_0.1-7          
## [19] shiny_1.0.5         mapproj_1.2-5       compiler_3.4.1     
## [22] httr_1.3.1          backports_1.1.1     bmp_0.3            
## [25] assertthat_0.2.0    Matrix_1.2-12       lazyeval_0.2.1     
## [28] cli_1.0.0           acepack_1.4.1       htmltools_0.3.6    
## [31] tools_3.4.1         gtable_0.2.0        glue_1.2.0         
## [34] reshape2_1.4.3      maps_3.2.0          Rcpp_0.12.15       
## [37] cellranger_1.1.0    nlme_3.1-131        crosstalk_1.0.0    
## [40] psych_1.7.8         proto_1.0.0         rvest_0.3.2        
## [43] mime_0.5            pacman_0.4.6        hms_0.4.1          
## [46] RColorBrewer_1.1-2  yaml_2.1.17         curl_3.1           
## [49] geosphere_1.5-7     rpart_4.1-11        latticeExtra_0.6-28
## [52] stringi_1.1.6       checkmate_1.8.5     RgoogleMaps_1.4.1  
## [55] rlang_0.2.0.9000    pkgconfig_2.0.1     evaluate_0.10.1    
## [58] lattice_0.20-35     bindr_0.1           htmlwidgets_1.0    
## [61] labeling_0.3        tidyselect_0.2.3    R6_2.2.2           
## [64] Hmisc_4.1-1         pillar_1.1.0        haven_1.1.1        
## [67] foreign_0.8-69      withr_2.1.1.9000    survival_2.41-3    
## [70] sp_1.2-5            nnet_7.3-12         modelr_0.1.1       
## [73] crayon_1.3.4        utf8_1.1.3          Quandl_2.8.0       
## [76] rmarkdown_1.8       jpeg_0.1-8          readxl_1.0.0.9000  
## [79] data.table_1.10.4-3 digest_0.6.15       xtable_1.8-2       
## [82] httpuv_1.3.5        munsell_0.4.3       viridisLite_0.3.0  
## [85] quadprog_1.5-5