block by timelyportfolio ab27c49724c140a72aae

TraMineR + rcdimple | Analyze State Sequence Data with dimple htmlwidget

Full Screen

As I read the TraMineR vignette, I thought this state sequence diagram would be an interesting use case for rcdimple. I’ll throw in a little ggplot2, dplyr, tidyr, and pipeR for free.

See the live example.

code.R

# examples from TraMineR vignette
#   http://cran.r-project.org/web/packages/TraMineR/vignettes/TraMineR-state-sequence.pdf

library("TraMineR")

library("pipeR")
library("tidyr")
library("dplyr")
library("ggplot2")

#  devtools::install_github("timelyportfolio/rcdimple")
library("rcdimple")

data("mvad")

mvad.alphab <- c("employment", "FE", "HE", "joblessness", "school", "training")
mvad.seq <- seqdef(mvad, 17:86, xtstep = 6, alphabet = mvad.alphab)

mvad.seq %>>%
  (data.frame(id = rownames(.),.)) %>>%
  gather(date, state, -id) %>>%
  mutate( date = as.Date(paste0(date,"-01"),format="%b.%y-%d") )

mvad.seq %>>%
  (data.frame(id = rownames(.),.)) %>>%
  gather(date, state, -id) %>>%
  mutate( date = as.Date(paste0(date,"-01"),format="%b.%y-%d") ) %>>%
  mutate( id = as.numeric(id) ) %>>%
  filter( id < 50 ) %>>%
  (~
    ggplot(., aes(x = date, y = factor(id), color=state) ) %>>%
    (print( . + geom_point()))
  ) %>>%
  mutate( date = format( date, "%Y-%m-%d") ) %>>%
  dimple( 
    id ~ date
    ,type = "bar"
    ,groups = "state"
    ,barGap = 0.25
  ) %>>%
  xAxis(
    type = "addTimeAxis", inputFormat = "%Y-%m-%d", outputFormat = "%b %Y"
    , timePeriod = htmlwidgets::JS('d3.time.months'), timeInterval = 12
    , floatingBarWidth = 10
  ) %>>%
  yAxis( type = "addCategoryAxis" ) %>>%
  add_legend( x = "10%", width = "80%" )

# an area chart with cumulative n per state by date
mvad.seq %>>%
  (data.frame(id = rownames(.),.)) %>>%
  gather(date, state, -id) %>>%
  mutate( date = as.Date(paste0(date,"-01"),format="%b.%y-%d") ) %>>%
  mutate( id = as.numeric(id) ) %>>%
  mutate( date = format( date, "%Y-%m-%d") ) %>>%
  group_by( date, state ) %>>%
  tally %>>%
  ungroup %>>%  
  dimple( 
    n ~ date
    ,groups = "state"
    ,type = "area"
    ,interpolation = "basis"
    ,lineWeight = 0
  ) %>>%
  xAxis(
    type = "addTimeAxis", inputFormat = "%Y-%m-%d", outputFormat = "%b %Y"
    , timePeriod = htmlwidgets::JS('d3.time.months'), timeInterval = 12
    , floatingBarWidth = 10
  ) %>>%
  add_legend( x = "10%", width = "80%" ) %>>%
  default_colors( RColorBrewer::brewer.pal( 9, "Set1" ) )
  
  
mvad.seq %>>%
  seqtrate %>>%
  (structure(data.frame( state0 = rownames(.), . ), names = c("state0",rownames(.)))) %>>%
  gather( state1, pct, -state0 ) %>>%
  filter( !(state0 == state1 ) ) %>>%
  dimple(
    state1 ~ state0
    ,z = "pct"
    ,type = "bubble"
  ) %>>%
  yAxis( type = "addCategoryAxis" ) %>>%
  colorAxis(
    type = "addColorAxis"
    , colorSeries = "pct"
    , palette = rev(gray.colors(8))
  )