R/sparktex.r

In sparktex: Generate LaTeX sparklines in R

sparktex <- function(y, x=NULL, height=1.75, width=NULL,
					 type=c("sparkline","sparkspike"),
					 color=NULL, linewidth=NULL,
					 rectangle=NULL, sparkdot=NULL, 
                     normalize=FALSE, catfile="", ...) {
	# Preliminaries, and  checks ...
	type <- match.arg(type)

	x <- as.vector(x)
	y <- as.vector(y)
	stopifnot(!any(is.na(y)))
	ly <- length(y)
	
	if (normalize){
		miny <- min(y, na.rm=TRUE)
		y <- y + abs(miny) # brings the bottom to zero
		maxy <- max(abs(min(y)),abs(max(y)))
		y <- signif( y / maxy )
	}
	
	if (is.null(x)) {
		buffer <- .95 / (ly+1)
		x <- round(seq.int(buffer, 1-buffer, length.out=ly), 4)
	}
	if(!length(x)==length(y))
		stop("x and y lengths differ!")

	if (is.null(width))
		width <- min(ly, 10)

	# Start building TeX commands...
	alltex <- paste("% autogenerated by", as.character(sys.call()[[1]]), "\n%", Sys.time(), "\n")
	
	if (!is.null(color))
		alltex <- c(alltex, paste0("\\definecolor{", type, "color}{", color[1], "}{", color[2], "}\n"))
	
	if (!is.null(linewidth)){
		tex <- paste0("{\\setlength{\\", type, 
					  switch(type, 
							 sparkline="thickness", 
							 sparkspike="width"), "}{",linewidth, "px}\n")
		alltex <- c(alltex,tex)
	}

	if (!is.null(height))
		alltex <- c(alltex,paste0("\\renewcommand{\\sparklineheight}{",height,"}\n"))
	
	alltex <- c(alltex, paste0("\\begin{sparkline}{",width,"}","\n"))

	if (!is.null(rectangle)){
		if (is.list(rectangle))
			lapply(rectangle, FUN=function(x) {
				if (length(x)==2)
					x <- c(x,"gray","0.9")
				alltex <<- c(alltex,
							paste0("\\definecolor{sparkrectanglecolor}{",x[3],"}{",x[4],"}\n"),
							paste("\\sparkrectangle",x[1],x[2],"\n"))
			})
		else{
			if (length(rectangle)==2)
				rectangle <- c(rectangle,"gray","0.9")
			alltex <- c(alltex,
						paste0("\\definecolor{sparkrectanglecolor}{",rectangle[3],"}{",rectangle[4],"}\n"),
						paste("\\sparkrectangle",rectangle[1],rectangle[2],"\n"))
		}
	}

	if (type=="sparkline"){
		alltex <- c(alltex, "\\spark")
		for (i in seq_len(ly)){
		  alltex <- c(alltex, paste("\n", x[i], y[i]))
		}
		alltex <- c(alltex, paste(" /","\n"))
	} else if (type=="sparkspike"){
		for (i in seq_len(ly)){
		  alltex <- c(alltex, paste("\\sparkspike ", x[i], y[i], "\n"))
		}
	}

	if (!is.null(sparkdot)){
		for (i in seq_along(sparkdot)){
			if (normalize)
				alltex <- c(alltex, paste("\\sparkdot", sparkdot[[i]][1], signif(sparkdot[[i]][2]/maxy), sparkdot[[i]][3], "\n"))
			else
				alltex <- c(alltex, paste("\\sparkdot", sparkdot[[i]][1], sparkdot[[i]][2], sparkdot[[i]][3], "\n"))
		}
	}

	alltex <- c(alltex, paste0("\\end{sparkline}"), ifelse(!is.null(linewidth), "}\n", "\n"))

	# Write to file, or to screen (default) ...
	alltex <- paste0(alltex, collapse="")
	cat(alltex, file=catfile, ...)

	# Finish...
	return(invisible(list(x=x, y=y, tex=alltex)))
}