diff --git a/DESCRIPTION b/DESCRIPTION index 6146e4c..38cca8d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rBAPS Title: Bayesian Analysis of Population Structure -Version: 0.0.0.9013 +Version: 0.0.0.9014 Date: 2020-11-09 Authors@R: c( diff --git a/R/dec2bitv.R b/R/dec2bitv.R new file mode 100644 index 0000000..2124936 --- /dev/null +++ b/R/dec2bitv.R @@ -0,0 +1,16 @@ +dec2bitv <- function(d, n) { + # DEC2BITV Convert a decimal integer to a bit vector. + # bits <- dec2bitv(d, n) is just like the built - in dec2bin, except the answer is a vector, not a as.character. + # n is an optional minimum length on the bit vector. + # If d is a vector, each row of the output array will be a bit vector. + + if (nargin() < 2) { + n <- 1 # Need at least one digit even for 0. + } + d <- d[] + + f <- e <- NA + c(f, e) <- log2(max(d)) # How many digits do we need to represent the numbers? + bits <- floor(d * 2 ^ (seq(1 - max(n, e), 0))) %% 2 + return(bits) +} diff --git a/R/ind2subv.R b/R/ind2subv.R index 6fef574..92b4943 100644 --- a/R/ind2subv.R +++ b/R/ind2subv.R @@ -1,38 +1,37 @@ -ind2subv <- function(siz, ndx) stop("Needs translation") -# function sub = ind2subv(siz, ndx) -# % IND2SUBV Like the built-in ind2sub, but returns the answer as a row vector. -# % sub = ind2subv(siz, ndx) -# % -# % siz and ndx can be row or column vectors. -# % sub will be of size length(ndx) * length(siz). -# % -# % Example -# % ind2subv([2 2 2], 1:8) returns -# % [1 1 1 -# % 2 1 1 -# % ... -# % 2 2 2] -# % That is, the leftmost digit toggle fastest. -# % -# % See also SUBV2IND +ind2subv <- function(siz, ndx) { + # IND2SUBV Like the built - in ind2sub, but returns the answer as a row vector. + # sub <- ind2subv(siz, ndx) + # siz and ndx can be row or column vectors. + # sub will be of size length(ndx) * length(siz). + # Example + # ind2subv([2 2 2], 1:8) returns + # [1 1 1 + # 2 1 1 + # ... + # 2 2 2] + # That is, the leftmost digit toggle fastest. + # + # See also SUBV2IND -# n = length(siz); + n <- length(siz) -# if n==0 -# sub = ndx; -# return; -# end + if (n == 0) { + sub <- ndx + return(sub) + } -# if all(siz==2) -# sub = dec2bitv(ndx-1, n); -# sub = sub(:,n:-1:1)+1; -# return; -# end + if (all(siz == 2)) { + sub <- dec2bitv(ndx - 1, n) + sub <- sub[, seq(n, 1, - 1)] + 1 + return(sub) + } -# cp = [1 cumprod(siz(:)')]; -# ndx = ndx(:) - 1; -# sub = zeros(length(ndx), n); -# for i = n:-1:1 % i'th digit -# sub(:,i) = floor(ndx/cp(i))+1; -# ndx = rem(ndx,cp(i)); -# end + cp <- c(1, cumprod(t(siz[]))) + ndx <- ndx[] - 1 + sub <- zeros(length(ndx), n) + for (i in seq(n, 1, -1)) {# i'th digit + sub[, i] <- floor(ndx / cp[i]) + 1 + ndx <- ndx %% cp(i) + } + return(sub) +} diff --git a/R/rBAPS-package.R b/R/rBAPS-package.R index 25e3934..810a2f1 100644 --- a/R/rBAPS-package.R +++ b/R/rBAPS-package.R @@ -10,5 +10,5 @@ #' size sortrows squeeze strcmp times zeros disp #' @importFrom stats runif #' @importFrom zeallot %<-% -#' @importFrom matlab2r nargin +#' @importFrom matlab2r nargin log2 NULL