Nothing
##' @title Scale data to [0,1]
##' @param x vector or matrix
##' @param method character string indicating the method to be used
##' if x is a matrix: scale all x with the same linear
##' transformation or scale the columns/rows of x componentwise
##' @param ... additional arguments passed to range() or rank()
##' @return x scaled to [0,1]
##' @author Marius Hofert
scale01 <- function(x, method=c("columnwise", "rowwise", "all", "pobs"), ...)
{
if(is.data.frame(x)) x <- data.matrix(x)
stopifnot(is.matrix(x))
method <- match.arg(method)
switch(method,
"columnwise" = {
apply(x, 2, FUN=function(x.) {
ran <- range(x., ...)
(x.-ran[1])/diff(ran)
})
},
"rowwise" = {
apply(x, 1, FUN=function(x.) {
ran <- range(x., ...)
(x.-ran[1])/diff(ran)
})
},
"all" = {
ran <- range(x, ...)
(x-ran[1])/diff(ran)
},
"pobs" = {
## If not given, use na.last = "keep"
if(hasArg("na.last")) {
apply(x, 2, rank, ...) / (nrow(x)+1)
} else apply(x, 2, rank, na.last="keep", ...) / (nrow(x)+1)
},
stop("Wrong 'method'"))
}
##' @title Converting an Occupancy Matrix (consisting of 0--4) to
##' a Human Readable Matrix
##' @param x an occupancy matrix
##' @param to symbols being mapped to by the occupancy matrix
##' @return matrix of encoded entries of the occupancy matrix
##' @author Marius Hofert
occupancy_to_human <- function(x, to=c("", "<", ">", "v", "^"))
{
stopifnot(0 <= x, x <= 4, length(to) == 5)
if(is.matrix(x)) {
dm <- dim(x)
matrix(to[x+1], nrow=dm[1], ncol=dm[2])
} else {
to[x+1]
}
}
##' @title Creating a Gray Color with Alpha Blending
##' @param n a number determining the alpha levels if alpha is NULL
##' (= number of distinguishable layers on each pixel); n/10 = number of
##' points needed to saturate
##' @param h see ?hcl
##' @param c see ?hcl
##' @param l see ?hcl
##' @param alpha see ?hcl; if NULL, then alpha is determined from 'n'
##' @param fixup see ?hcl
##' @return hcl alpha blended gray color
##' @author Marius Hofert and Wayne Oldford
gray_alpha_blend <- function(n, h=260, c=0, l=65, alpha=NULL, fixup=TRUE)
hcl(h, c=c, l=l, alpha=if(is.null(alpha)) 1/(n/10 + 1) else alpha, fixup=fixup)
##' @title Defining an arrow
##' @param turn The direction in which the arrow shall point ("l", "r", "d", "u")
##' @param length The length of the arrow
##' @param angle The angle
##' @return A 3-column matrix containing the (x,y) coordinates of the left
##' edge end point, the arrow head and the right edge end point
##' @author Marius Hofert
zen_arrow <- function(turn, length, angle=30)
{
## Convert angle
stopifnot(0 <= angle, angle <= 90)
th <- (pi/2)*angle/90 # now in radians
## Define the 3 points around the center (0,0) determining the base arrow
## (pointing right)
left <- length * c(-0.5, tan(th)) # end point of left edge of the arrow head
right <- length * c(-0.5, -tan(th)) # end point of right edge of the arrow head
head <- length * c( 0.5, 0) # arrow head
## Now turn the base arrow appropriately
rot <- switch(turn,
"l" = { pi },
"r" = { 0 },
"d" = { 3*pi/2 },
"u" = { pi/2 },
stop("Wrong 'turn'"))
rot.mat <- matrix(c(cos(rot), -sin(rot), sin(rot), cos(rot)),
nrow=2, ncol=2, byrow=TRUE)
left <- rot.mat %*% left
right <- rot.mat %*% right
head <- rot.mat %*% head
## Return
cbind(left=left, head=head, right=right)
}
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.