-
Notifications
You must be signed in to change notification settings - Fork 4
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Added new function sl.remap.array() to remap a numeric array (can als…
…o be a vector) along one of its dimensions from an old to a new dimension variable vector. Based partly on code from sl.trajectory.remaptime().
- Loading branch information
1 parent
0e34e22
commit 3ebc5be
Showing
2 changed files
with
246 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,156 @@ | ||
| sl.remap.array <- function (input.dimvals,input.data,new.dimvals,remap.dim=1,method="linear",extrapolate=FALSE,return.remapinfo=FALSE,verbose=TRUE) { | ||
|
|
||
| if (method != "nearestneighbour" && method != "linear") { | ||
| stop("'method' must be one of 'nearestneighbour' and 'linear'.") | ||
| } | ||
|
|
||
| input.N = length(input.dimvals) | ||
| new.N = length(new.dimvals) | ||
| input.dim = dim(input.data) | ||
| if (is.null(input.dim)) {input.data = array(input.data); input.dim = dim(input.data)} # convert vector into 1D array | ||
| ND = length(input.dim) | ||
| if (ND > 4) {stop("'input.data' must not have more than 4 dimensions")} | ||
| if (remap.dim > ND) {stop("'remap.dim' is larger than the number of dimensions of 'input.data'")} | ||
| if (input.N != input.dim[remap.dim]) {stop("length of 'input.dimvals' is inconsistent with 'input.data' and 'remap.dim'")} | ||
| new.dim = input.dim | ||
| new.dim[remap.dim] = new.N | ||
|
|
||
| if (new.N > 1) { | ||
| if (any(new.dimvals[2:new.N] <= new.dimvals[1:(new.N-1)])) {stop("'new.dimvals' must increase strict monotonously")} | ||
| } | ||
| if (input.N <= 1) {stop("'input.dimvals' must have at least two elements")} | ||
| if (any(input.dimvals[2:input.N] <= input.dimvals[1:(input.N-1)])) {stop("'input.dimvals' must increase strict monotonously")} | ||
|
|
||
| if (new.dimvals[new.N] > input.dimvals[input.N]) { | ||
| if (new.dimvals[1] > input.dimvals[input.N]) { | ||
| if (verbose) {warning("New dimension values completely out of original dimension values.")} | ||
| if (!extrapolate) { | ||
| if (verbose) {warning("All values will be 'NA'.")} | ||
| } else { | ||
| if (verbose) {warning("All values will be extrapolated.")} | ||
| } | ||
| } else { | ||
| if (verbose) {warning("Maximum of new dimension values above maximum of original dimension values.")} | ||
| if (extrapolate) { | ||
| if (verbose) {warning("Values outside original dimension range will be extrapolated.")} | ||
| } else { | ||
| if (verbose) {warning("Values outside original dimension range will be 'NA'.")} | ||
| } | ||
| } | ||
| } | ||
| if (new.dimvals[1] < input.dimvals[1]) { | ||
| if (new.dimvals[new.N] < input.dimvals[1]) { | ||
| if (verbose) {warning("New dimension values completely out of original dimension values.")} | ||
| if (!extrapolate) { | ||
| if (verbose) {warning("All values will be 'NA'.")} | ||
| } else { | ||
| if (verbose) {warning("All values will be extrapolated.")} | ||
| } | ||
| } else { | ||
| if (verbose) {warning("Minimum of new dimension values below minimum of original dimension values.")} | ||
| if (extrapolate) { | ||
| if (verbose) {warning("Values outside original dimension range will be extrapolated.")} | ||
| } else { | ||
| if (verbose) {warning("Values outside original dimension range will be 'NA'.")} | ||
| } | ||
| } | ||
| } | ||
|
|
||
| weights.left = rep(NA,new.N) | ||
| weights.left.ind = rep(NA,new.N) | ||
| i.input = 1 | ||
| for (i.new in 1:new.N) { | ||
| while (i.input < (input.N-1) && new.dimvals[i.new] > input.dimvals[i.input+1]) { | ||
| i.input = i.input + 1 | ||
| } | ||
| weights.left.ind[i.new] = i.input | ||
| weights.left[i.new] = (input.dimvals[i.input+1] - new.dimvals[i.new]) / (input.dimvals[i.input+1] - input.dimvals[i.input]) | ||
| } | ||
| if (!extrapolate) { | ||
| weights.left[weights.left < 0 | weights.left > 1] = NA | ||
| } | ||
| if (method == "nearestneighbour") { | ||
| weights.left[weights.left > .5] = 1 | ||
| weights.left[weights.left <= .5] = 0 | ||
| } | ||
|
|
||
| new.data = array(dim=new.dim) | ||
| if (ND == 1) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[i.new] = (input.data[wli]*wl + input.data[wli+1]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 2 && remap.dim == 1) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[i.new,] = (input.data[wli,]*wl + input.data[wli+1,]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 2 && remap.dim == 2) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[,i.new] = (input.data[,wli]*wl + input.data[,wli+1]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 3 && remap.dim == 1) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[i.new,,] = (input.data[wli,,]*wl + input.data[wli+1,,]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 3 && remap.dim == 2) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[,i.new,] = (input.data[,wli,]*wl + input.data[,wli+1,]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 3 && remap.dim == 3) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[,,i.new] = (input.data[,,wli]*wl + input.data[,,wli+1]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 4 && remap.dim == 1) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[i.new,,,] = (input.data[wli,,,]*wl + input.data[wli+1,,,]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 4 && remap.dim == 2) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[,i.new,,] = (input.data[,wli,,]*wl + input.data[,wli+1,,]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 4 && remap.dim == 3) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[,,i.new,] = (input.data[,,wli,]*wl + input.data[,,wli+1,]*(1-wl)) | ||
| } | ||
| } | ||
| if (ND == 4 && remap.dim == 4) { | ||
| for (i.new in 1:new.N) { | ||
| wli = weights.left.ind[i.new] | ||
| wl = weights.left[i.new] | ||
| new.data[,,,i.new] = (input.data[,,,wli]*wl + input.data[,,,wli+1]*(1-wl)) | ||
| } | ||
| } | ||
|
|
||
| if (return.remapinfo) { | ||
| return(list(data=new.data,remapinfo=list(weights.left.ind=weights.left.ind,weights.left=weights.left))) | ||
| } else { | ||
| return(list(data=new.data)) | ||
| } | ||
|
|
||
|
|
||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,90 @@ | ||
| \name{sl.remap.array} | ||
| \alias{sl.remap.array} | ||
| %- Also NEED an '\alias' for EACH other topic documented here. | ||
| \title{ | ||
| Remap Array | ||
| } | ||
| \description{ | ||
| Remap a numeric array along one of its dimensions from an old to a new dimension variable vector. | ||
| } | ||
| \usage{ | ||
| sl.remap(input.data, input.dimvals, new.dimvals, remap.dim = 1, method = "linear", extrapolate = FALSE, return.remapinfo = FALSE, verbose = TRUE) | ||
| } | ||
| %- maybe also 'usage' for other objects documented here. | ||
| \arguments{ | ||
| \item{input.data}{ | ||
| a numeric array (can also be a vector or matrix) with \code{D <= 4} dimensions specifying the original data values. The dimension specified by \code{remap.dim} must have the same length as \code{input.dimvals}; the remapping is performed along this dimension while the other dimensions are kept. | ||
| } | ||
| \item{input.dimvals}{ | ||
| a numeric vector of length \code{N > 1} specifying the original dimension variable values; must increase strict monotonously. | ||
| } | ||
| \item{new.dimvals}{ | ||
| a numeric vector of length \code{M >= 1} specifying the new dimension variable values; must increase strict monotonously. | ||
| } | ||
| \item{remap.dim}{ | ||
| an integer for which \code{1 <= remap.dim <= D} specifying the dimension along which the data is remapped. | ||
| } | ||
| \item{method}{ | ||
| a character specifying the interpolation method. Must be one of \code{"linear"} (default) and \code{"nearestneighbour"}. | ||
| } | ||
| \item{extrapolate}{ | ||
| a logical value specifying whether or not to extrapolate to dimension variable values outside the original dimension range. Default is \code{FALSE} which implies that corresponding values will be \code{NA}. If \code{TRUE}, the method specified in the argument \code{method} will be used also for the extrapolation. | ||
| } | ||
| \item{return.remapinfo}{ | ||
| a logical value specifying whether or not to return information on the remapping (nearest-neighbour-before indices and weights). Default is \code{FALSE}. | ||
| } | ||
| \item{verbose}{ | ||
| a logical value specifying whether to produce warnings, in particular when the new dimension variable axis reaches outside the original dimension variable axis. Default is \code{TRUE}. | ||
| } | ||
| } | ||
| %\details{ | ||
| %} | ||
| \value{ | ||
| \item{data }{an array with \code{D} dimensions (like the input array \code{input.data}) where all expect the remapped dimension have the same length as in \code{input.data}, but the remapped dimension has the same length as \code{new.dimvals} instead of \code{input.dimvals}.} | ||
|
|
||
| If \code{return.remapinfo=TRUE}, an additional list element \code{remapinfo} is returned, with the following sub-elements: | ||
| \item{weights.left.ind }{an integer vector of length \code{M} with the indices of the original points directly before the corresponding new points.} | ||
| \item{weights.left }{an numeric vector of length \code{M} with the weights given to the points provided in \code{weights.left.ind}; the respective subsequent points were given the weights \code{(1-weights.left)}.} | ||
| } | ||
| \references{ | ||
| %% ~put references to the literature/web site here ~ | ||
| } | ||
| \author{ | ||
| Helge Goessling | ||
| } | ||
| \note{ | ||
| This function is similar to \code{sl.trajectory.remaptime} but works on arrays (including vectors) instead of 1-dimensional spatial line objects on spheres (such as trajectories). | ||
| } | ||
|
|
||
| %% ~Make other sections like Warning with \section{Warning }{....} ~ | ||
|
|
||
| \seealso{ | ||
| \code{\link{sl.trajectory.remaptime}} | ||
| } | ||
|
|
||
| \examples{ | ||
| # Vector remapping | ||
| x = seq(-2, 3, by=0.5) | ||
| y = x^2 | ||
| x.remap = seq(-1, 5, by=0.3) | ||
| y.remap.lin = as.vector(sl.remap.array(input.dat=y, input.dimvals=x, new.dimvals=x.remap, | ||
| extrapolate=TRUE)$data) | ||
| y.remap.nn = as.vector(sl.remap.array(input.dat=y, input.dimvals=x,new.dimvals=x.remap, | ||
| extrapolate=TRUE, method="nearestneighbour")$data) | ||
|
|
||
| plot(x,y,ylim=c(0,20),type="p",xlim=c(-2,5)) | ||
| points(x.remap,y.remap.lin,col="red") | ||
| points(x.remap,y.remap.nn,col="blue") | ||
|
|
||
| # Matrix remapping | ||
| dat1 = matrix(seq(0.5,3,by=0.5),ncol=3) | ||
| dat2 = sl.remap.array(input.dat=dat1, input.dimvals=1:3, new.dimvals = seq(1.5,3.5,by=0.5), | ||
| remap.dim=2, extrapolate=TRUE) | ||
|
|
||
| print(dat1) | ||
| print(dat2$data) | ||
| } | ||
| % Add one or more standard keywords, see file 'KEYWORDS' in the | ||
| % R documentation directory. | ||
| %\keyword{ ~kwd1 } | ||
| %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line |