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.
# 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))
)