R/plot.stslist.modst.R

In TraMineR: Trajectory Miner: a Sequence Analysis Toolkit

## =============================
## Plot the modal state sequence
## =============================

plot.stslist.modst <- function(x, cpal = NULL, ylab = NULL, yaxis = TRUE,
  xaxis = TRUE, xtlab = NULL, xtstep = NULL, tick.last = NULL,
  info = TRUE, cex.axis = 1, cex.plot, ...) {

  TraMineR.check.depr.args(alist(cex.axis = cex.plot))

  sep.ylab <- (isFALSE(yaxis) && (is.null(ylab) || !is.na(ylab)))
  cex.lab <- par("cex.lab")
  if ("cex.lab" %in% names(list(...))) cex.lab <- list(...)[["cex.lab"]]

	seql <- ncol(x)
	statl <- attr(x,"alphabet")
	n <- attr(x, "nbseq")
	nr <- attr(x,"nr")

	if (is.null(cpal)) {cpal <- attr(x,"cpal")}

	## Adding an entry for missing in the legend
	if (any(x==nr)) {
		missing.color <- attr(x,"missing.color")
		cpal <- c(cpal, missing.color)
		statl <- c(statl, nr)
	}
	nbstat <- length(statl)

	weighted <- attr(x, "weighted")
	if (weighted) {wlab <- "weighted "}
	else {wlab <- NULL}

	if (is.null(xtlab)) {xtlab <- colnames(x)}
	if (is.null(xtstep)) {
		if (!is.null(attr(x,"xtstep"))) {xtstep <- attr(x,"xtstep")}
		## For sequence objects created with previous versions
		else {xtstep <- 1}
	}
	if(is.null(tick.last)){
		tick.last <- ifelse(!is.null(attr(x, "tick.last")), attr(x, "tick.last"), FALSE)
	}

	if (is.null(ylab)) ylab <- paste("State freq. (",wlab,"n=",round(n,2),")",sep="")

	## ============================
	## Max distance for axis limits
	## ============================
	mod <- attr(x, "Frequencies")
	prof.freq <- matrix(0, nrow=nbstat, ncol=seql)

	## Preparing the matrix for plot
	for (i in 1:seql) {
		smax <- which(statl==x[,i])
		prof.freq[smax,i] <- mod[i]
	}

	## Frequency of the representative sequence
	nbrep <- attr(x,"Occurrences")
	ctfreq <- round((nbrep/n)*100,1)
	txt <- paste("Modal state sequence (",nbrep," occurrences, freq=", ctfreq ,"%)", sep="")

    if (sep.ylab) {
        sylab <- ylab
        ylab <- NA
    }


	barplot(prof.freq,
		space=0,
		## mgp=c(2.5,0.6,0),
		cex.names=cex.axis,
		ylim=c(0,1.2),
		col=cpal,
		## main=title,
		axisnames=FALSE,
		ylab=ylab,
		axes=FALSE,
		...)

	if(info) text(seql/2, 1.1, txt, cex=cex.axis)

	## Plotting the x axis
	if (xaxis) {
		tpos <- seq(1,seql, xtstep)
    if (tick.last & tpos[length(tpos)] < seql) tpos <- c(tpos,seql)
		axis(1, at=tpos-0.5, labels=xtlab[tpos], pos=-0.02,
		# mgp=c(3,0.5,0),
		cex.axis=cex.axis)
	}

	## Axis for the state frequencies
	if (yaxis)
		axis(2, at=seq(0,1.0,0.25), labels=c("0","0.25",".5","0.75","1"),
			las=2, cex.axis=cex.axis)
    if (sep.ylab)
        title(ylab=sylab, line=1, cex.lab=cex.lab)


}