R/spathxy.R

In plothelper: New Plots Based on 'ggplot2' and Functions to Create Regular Shapes

#' Reordering Points to Form a "s" Shape
#'
#' This is a convenient function to generate points with
#' x and y coordinates (which form a 2-column data.frame).
#' It is much like \code{expand.grid}. The points generated 
#' by \code{expand.grid} always in this "s" order: the bottom 
#' line, form left to right, and the second line, from left to right.
#' However, \code{spathxy} allows you choose the order you 
#' want. See examples.
#' 
#' @param x a vector of values to be paired with y.
#' @param y a vector of values to be paired with x.
#' @param first the first direction. It may be one of 
#' "right", "left", "top", "bottom". Default is "right".
#' @param second the second direction. It may be one of 
#' "right", "left", "top", "bottom". Default is "top".
#' @param change_line tail-to-tail or tail-to-head. Default 
#' is FALSE which means tail-to-tail. See examples.
#' @param stringsAsFactors to be passed to \code{data.frame}.
#' 
#' @return always a 3-column data frame. Column x 
#' and y are coordinates of points; column index contains 
#' the index number of points.
#' 
#' @export
#' @examples
#' library(ggplot2)
#' #
#' # dat1 is generated by expand.grid
#' # Note the difference between dat1 and dat2.
#' # dat3 is the same as dat1.
#' dat1=expand.grid(1: 3, 1: 7)
#' colnames(dat1)=c("x", "y")
#' dat2=spathxy(1: 3, 1: 7, 
#' 	change_line=FALSE, first="right", second="top")
#' dat3=spathxy(1: 3, 1: 7, 
#' 	change_line=TRUE, first="right", second="top")
#' #
#' mycolor=rainbow(nrow(dat1), end=0.6)
#' ggplot(dat1)+geom_path(aes(x, y), color=mycolor, size=3)
#' ggplot(dat2)+geom_path(aes(x, y), color=mycolor, size=3)
#' ggplot(dat3)+geom_path(aes(x, y), color=mycolor, size=3)
spathxy=function(x, y, first="right", second="top", change_line=FALSE, stringsAsFactors=TRUE){
	nx=length(x)
	ny=length(y)
	if (is.factor(x)) x=as.character(x)
	if(is.factor(y)) y=as.character(y)
	stopifnot(is.logical(change_line))
	if (nx==0) stop("x must not be of length 0.")
	if (ny==0) stop("y must not be of length 0.")
	stopifnot(first %in% c("left", "right", "top", "bottom"))
	stopifnot(second %in% c("left", "right", "top", "bottom"))	
	if(first %in% c("left", "right")) stopifnot (second %in% c("top", "bottom"))
	if(first %in% c("top", "bottom")) stopifnot (second %in% c("left", "right"))
	
	ht=if (change_line) ", with tail linking head" else ", with tail linking tail"
	
	# 1
	if (first=="right" & second=="top"){
		x=if (change_line) rep_len(list(x, x), ny) else rep_len(list(x, rev(x)), length.out=ny)
		y=rep(y, each=nx)
		message("from bottom-left corner, to right, to top", ht)
	}
	# 2
	if (first=="top" & second=="right"){
		y=if (change_line) rep_len(list(y, y), nx) else rep_len(list(y, rev(y)), length.out=nx)
		x=rep(x, each=ny)
		message("from bottom-left corner, to top, to right", ht)
		}
	# 3
	if (first=="left" & second=="top"){
		x=if (change_line) rep_len(list(rev(x), rev(x)), ny) else rep_len(list(rev(x), x), length.out=ny)
		y=rep(y, each=nx)
		message("from bottom-right corner, to left, to top", ht)
	}
	# 4
	if (first=="top" & second=="left"){
		y=if (change_line) rep_len(list(y, y), nx) else rep_len(list(y, rev(y)), length.out=nx)
		x=rep(rev(x), each=ny)
		message("from bottom-right corner, to top, to left", ht)
	}
	# 5
	if (first=="right" & second=="bottom"){
		x=if (change_line) rep_len(list(x, x), ny) else rep_len(list(x, rev(x)), length.out=ny)
		y=rep(rev(y), each=nx)
		message("from top-left corner, to right, to bottom", ht)
	}
	# 6
	if (first=="bottom" & second=="right"){
		y=if (change_line) rep_len(list(rev(y), rev(y)), nx) else rep_len(list(rev(y), y), length.out=nx)
		x=rep(x, each=ny)
		message("from top-left corner, to bottom, to right", ht)
	}
	# 7
	if (first=="left" & second=="bottom"){
		x=if (change_line) rep_len(list(rev(x), rev(x)), ny) else rep_len(list(rev(x), x), length.out=ny)
		y=rep(rev(y), each=nx)
		message("from top-right corner, to left, to bottom", ht)
	}
	# 8
	if (first=="bottom" & second=="left"){
		y=if (change_line) rep_len(list(rev(y), rev(y)), nx) else rep_len(list(rev(y), y), length.out=nx)
		x=rep(rev(x), each=ny)
		message("from top-right corner, to bottom, to left", ht)
	}
	res=data.frame(x=unlist(x), y=unlist(y), stringsAsFactors=stringsAsFactors)
	index=1: nrow(res)
	cbind(res, index)
}