Nothing
#' 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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.