combinat/0000755000175100001440000000000011426341446012071 5ustar hornikuserscombinat/DESCRIPTION0000644000175100001440000000044311426447212013576 0ustar hornikusersPackage: combinat Version: 0.0-8 Title: combinatorics utilities Author: Scott Chasalow Maintainer: Vince Carey Description: routines for combinatorics License: GPL-2 Repository: CRAN Date/Publication: 2010-08-05 05:39:22 Packaged: 2010-08-05 00:25:01 UTC; stvjc combinat/INDEX0000644000175100001440000000146110123015374012654 0ustar hornikuserscombn Generate all combinations of the elements of x taken m at a time. dmnom density of multinomial, and support functions hcube Generate all points on a hypercuboid lattice. nsimplex Computes the number of points on a (p, n)-simplex lattice permn Generates all permutations of the elements of x rmultinomial Generate random samples from multinomial distributions x2u Convert an x-encoded simplex-lattice point to a u-encoded simplex-lattice point xsimplex Generates all points on a (p,n) simplex lattice (i.e. a p-part composition of n). combinat/man/0000755000175100001440000000000011426402320012631 5ustar hornikuserscombinat/man/combn.Rd0000644000175100001440000000530207461024703014227 0ustar hornikusers\name{combn} \alias{combn} \alias{combn2} \alias{nCm} \title{ Generate all combinations of the elements of x taken m at a time. } \description{ Generate all combinations of the elements of x taken m at a time. If x is a positive integer, returns all combinations of the elements of seq(x) taken m at a time. If argument "fun" is not null, applies a function given by the argument to each point. If simplify is FALSE, returns a list; else returns a vector or an array. "..." are passed unchanged to function given by argument fun, if any. combn2:Generate all combinations of the elements of x taken two at a time. If x is missing, generate all combinations of 1:n taken two at a time (that is, the indices of x that would give all combinations of the elements of x if x with length n had been given). Exactly one of arguments "x" and "n" should be given; no provisions for function evaluation. nCm: Compute the binomial coefficient ("n choose m"), where n is any real number and m is any integer. Arguments n and m may be vectors; they will be replicated as necessary to have the same length. Argument tol controls rounding of results to integers. If the difference between a value and its nearest integer is less than tol, the value returned will be rounded to its nearest integer. To turn off rounding, use tol = 0. Values of tol greater than the default should be used only with great caution, unless you are certain only integer values should be returned. } \usage{ combn(x, m, fun=NULL, simplify=TRUE, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ vector source for combinations } \item{m}{ number of elements } \item{fun}{ function to be applied to each combination (may be null) } \item{simplify}{ logical, if FALSE, returns a list, otherwise returns vector or array } \item{\dots}{ args to fun } } \details{ Nijenhuis, A. and Wilf, H.S. (1978) Combinatorial Algorithms for Computers and Calculators. NY: Academic Press. } \value{ see simplify argument } \references{ ~put references to the literature/web site here ~ } \author{ Code by Scott Chasalow, R package and doc prep by Vince Carey, stvjc@channing.harvard.edu} \examples{ combn(letters[1:4], 2) combn(10, 5, min) # minimum value in each combination # Different way of encoding points: combn(c(1,1,1,1,2,2,2,3,3,4), 3, tabulate, nbins = 4) #Compute support points and (scaled) probabilities for a #Multivariate-Hypergeometric(n = 3, N = c(4,3,2,1)) p.f.: # table.mat(t(combn(c(1,1,1,1,2,2,2,3,3,4), 3, tabulate,nbins=4))) } %\keyword{ combinatorics } \keyword{ models } combinat/man/dmnom.Rd0000644000175100001440000000132311426366516014251 0ustar hornikusers\name{dmnom} \alias{dmnom} \alias{fact} \alias{logfact} %- Also NEED an `\alias' for EACH other topic documented here. \title{ density of multinomial, and support functions } \description{ density of multinomial } \usage{ dmnom(x, size=sum(x), prob=stop("no prob arg")) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ vector } \item{size}{ total } \item{prob}{ parameter vector (sums to 1) } } %\details{ %} %\value{ %} \author{ code by Scott Chasalow, R pack and maint by VJ Carey } \examples{ dmnom(c(1,1,4,4),10,c(.2,.2,.3,.3)) } \keyword{ models }% at least one, from doc/KEYWORDS %\keyword{ combinatorics }% __ONLY ONE__ keyword per line combinat/man/hcube.Rd0000644000175100001440000000311011426366532014217 0ustar hornikusers\name{hcube} \alias{hcube} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Generate all points on a hypercuboid lattice. } \description{ Generate all points on a hypercuboid lattice. } \usage{ hcube(x, scale, translation) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ Argument x is an integer vector giving the extent of each dimension; the number of dimensions is length(x). } \item{scale}{ Argument scale is a vector of real numbers giving an amount by which to multiply the points in each dimension; it will be replicated as necessary to have the same length as x. } \item{translation}{ Argument translate is a vector of real numbers giving an amount to translate (from the "origin", rep(1,length(x))) the points in each dimension; it will be replicated as necessary to have the same length as x. To use rep(0,length(x)) as the origin, use translation = -1. Scaling, if any, is done BEFORE translation. } } %\details{ %} \value{ A prod(x) by length(x) numeric matrix; element (i,j) gives the location of point i in the jth dimension. The first column (dimension) varies most rapidly. } \references{ ~put references to the literature/web site here ~ } \author{ code by Scott Chasalow, R pack and maint by VJ Carey } \seealso{ fac.design, expand.grid } %\examples{ %} %\\keyword{ combinatorics }% at least one, from doc/KEYWORDS \keyword{ models }% __ONLY ONE__ keyword per line combinat/man/nsimplex.Rd0000644000175100001440000000133211426343132014763 0ustar hornikusers\name{nsimplex} \alias{nsimplex} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Computes the number of points on a (p, n)-simplex lattice } \description{ Computes the number of points on a (p, n)-simplex lattice; that is, the number of p-part compositions of n. This gives the number of points in the support space of a Multinomial(n, q) distribution, where p == length(q). Arguments p and n are replicated as necessary to have the length of the longer of them. } \usage{ nsimplex(p, n) } %- maybe also `usage' for other objects documented here. \arguments{ \item{p}{ vector of integers } \item{n}{ vector of integers } } %\details{ %} \value{ integer } \examples{ nsimplex(3,5) } \keyword{ models } combinat/man/permn.Rd0000644000175100001440000000267311426343142014257 0ustar hornikusers\name{permn} \alias{permn} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Generates all permutations of the elements of x } \description{ Generates all permutations of the elements of x, in a minimal- change order. If x is a positive integer, returns all permutations of the elements of seq(x). If argument "fun" is not null, applies a function given by the argument to each point. "..." are passed unchanged to the function given by argument fun, if any. } \usage{ permn(x, fun=NULL, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ vector } \item{fun}{ if non.null, applied at each perm } \item{\dots}{ args passed to fun } } %\details{ %} \value{ list: each component is either a permutation, or the results of applying fun to a permutation } \references{ Reingold, E.M., Nievergelt, J., Deo, N. (1977) Combinatorial Algorithms: Theory and Practice. NJ: Prentice-Hall. pg. 170. } \seealso{ sample, fact, combn, hcube, xsimplex } \examples{ # Convert output to a matrix of dim c(6, 720) t(array(unlist(permn(6)), dim = c(6, gamma(7)))) # A check that every element occurs the same number of times in each # position apply(t(array(unlist(permn(6)), dim = c(6, gamma(7)))), 2, tabulate, nbins = 6) # Apply, on the fly, the diff function to every permutation t(array(unlist(permn(6, diff)), dim = c(5, gamma(7)))) } \keyword{ models } combinat/man/rmultinomial.Rd0000644000175100001440000000175611426342547015663 0ustar hornikusers\name{rmultinomial} \alias{rmultinomial} \alias{rmultz2} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Generate random samples from multinomial distributions } \description{ rmultinomial: Generate random samples from multinomial distributions, where both n and p may vary among distributions rmultz2: fixed p case } \usage{ rmultinomial(n, p, rows=max(c(length(n), nrow(p)))) rmultz2(n, p, draws=length(n)) } %- maybe also `usage' for other objects documented here. \arguments{ \item{n}{ vector of sizes } \item{p}{ vector or probs } \item{rows}{ numeric giving desired number rows to be output } \item{draws}{ number samples required } } %\details{ %} \value{ a matrix of \code{rows} rows delivering specified samples } %\references{ ~put references to the literature/web site here ~ } \author{ John Wallace, 17 Feb 1997 S-news , mods by Chasalow } \examples{ n <- c(100,20,10) p <- matrix(c(.3,.1,.5,.1,.1,.2,.6,.8,.3),3) rmultinomial(n,p) } \keyword{ models } combinat/man/x2u.Rd0000644000175100001440000000266411426402320013646 0ustar hornikusers\name{x2u} \alias{x2u} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Convert an x-encoded simplex-lattice point to a u-encoded simplex-lattice point } \description{ Convert an x-encoded simplex-lattice point to a u-encoded simplex-lattice point (equivalently, "untabulate" bin counts) } \usage{ x2u(x, labels=seq(along = x)) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ x: A numeric vector. x[i] is interpreted as the count in bin i.} \item{labels}{ A vector. Interpreted as the bin labels; default value is seq(along = x), which causes return of a u-encoded simplex-lattice point. Other values of labels cause return of the result of subscripting labels with the u-encoded simplex-lattice point that would have been obtained if the default value of labels were used. } } %\details{ %} \value{ rep(labels, x), a vector of length sum(x). If labels = seq(along = x) (the default), value is the u-encoded translation of the simplex lattice point, x. Equivalently, value gives the bin numbers, in lexicographic order, for the objects represented by the counts in x. For other values of argument "labels", value gives the bin labels for the objects represented by the counts in x (equivalent to labels[x2u(x)]). } %\references{ } \seealso{ tabulate, rep } %\examples{ %} \keyword{ models } combinat/man/xsimplex.Rd0000644000175100001440000000233211426343162015001 0ustar hornikusers\name{xsimplex} \alias{xsimplex} \title{ Generates all points on a (p,n) simplex lattice (i.e. a p-part composition of n).} \description{ Generates all points on a {p,n} simplex lattice (i.e. a p-part composition of n). Each point is represented as x, a p-dimensional vector of nonnegative integers that sum to n. If argument "fun" is not null, applies a function given by the argument to each point. If simplify is FALSE, returns a list; else returns a vector or an array. "..." are passed unchanged to function given by argument fun, if any. } \usage{ xsimplex(p, n, fun=NULL, simplify=TRUE, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{p}{ first parameter of lattice description } \item{n}{ second parameter of lattice description} \item{fun}{ function to be applied pointwise } \item{simplify}{ logical: if FALSE, value is a list, otherwise a vector or array} \item{\dots}{ parameters to be passed to \code{fun} } } %\details{ %} %\value{ %} %\references{ } % \examples{ #Compute Multinomial(n = 4, pi = rep(1/3, 3)) p.f.: xsimplex(3, 4, dmnom, prob=1/3) } \keyword{models} combinat/R/0000755000175100001440000000000010274464046012274 5ustar hornikuserscombinat/R/combn.R0000644000175100001440000000475707461024702013525 0ustar hornikusers"combn"<- function(x, m, fun = NULL, simplify = TRUE, ...) { # DATE WRITTEN: 14 April 1994 LAST REVISED: 10 July 1995 # AUTHOR: Scott Chasalow # # DESCRIPTION: # Generate all combinations of the elements of x taken m at a time. # If x is a positive integer, returns all combinations # of the elements of seq(x) taken m at a time. # If argument "fun" is not null, applies a function given # by the argument to each point. If simplify is FALSE, returns # a list; else returns a vector or an array. "..." are passed # unchanged to function given by argument fun, if any. # REFERENCE: # Nijenhuis, A. and Wilf, H.S. (1978) Combinatorial Algorithms for # Computers and Calculators. NY: Academic Press. # EXAMPLES: # > combn(letters[1:4], 2) # > combn(10, 5, min) # minimum value in each combination # Different way of encoding points: # > combn(c(1,1,1,1,2,2,2,3,3,4), 3, tabulate, nbins = 4) # Compute support points and (scaled) probabilities for a # Multivariate-Hypergeometric(n = 3, N = c(4,3,2,1)) p.f.: # > table.mat(t(combn(c(1,1,1,1,2,2,2,3,3,4), 3, tabulate,nbins=4))) # if(length(m) > 1) { warning(paste("Argument m has", length(m), "elements: only the first used")) m <- m[1] } if(m < 0) stop("m < 0") if(m == 0) return(if(simplify) vector(mode(x), 0) else list()) if(is.numeric(x) && length(x) == 1 && x > 0 && trunc(x) == x) x <- seq(x) n <- length(x) if(n < m) stop("n < m") e <- 0 h <- m a <- 1:m nofun <- is.null(fun) count <- nCm(n, m, 0.10000000000000002) out <- vector("list", count) out[[1]] <- if(nofun) x[a] else fun(x[a], ...) if(simplify) { dim.use <- NULL if(nofun) { if(count > 1) dim.use <- c(m, count) } else { out1 <- out[[1]] d <- dim(out1) if(count > 1) { if(length(d) > 1) dim.use <- c(d, count) else if(length(out1) > 1) dim.use <- c(length(out1), count) } else if(length(d) > 1) dim.use <- d } } i <- 2 nmmp1 <- n - m + 1 mp1 <- m + 1 while(a[1] != nmmp1) { if(e < n - h) { h <- 1 e <- a[m] j <- 1 } else { h <- h + 1 e <- a[mp1 - h] j <- 1:h } a[m - h + j] <- e + j out[[i]] <- if(nofun) x[a] else fun(x[a], ...) i <- i + 1 } if(simplify) { if(is.null(dim.use)) out <- unlist(out) else out <- array(unlist(out), dim.use) } out } combinat/R/combn2.R0000644000175100001440000000215510274464046013602 0ustar hornikusers"combn2"<- function(x, n) { # DATE WRITTEN: 14 April 1994 LAST REVISED: 14 April 1994 # AUTHOR: Scott D. Chasalow # # DESCRIPTION: # Generate all combinations of the elements of x taken two at a time. # If x is missing, generate all combinations of 1:n taken two # at a time (that is, the indices of x that would give all # combinations of the elements of x if x with length n had been given). # Exactly one of arguments "x" and "n" should be given. # if(!missing(x)) { if(!missing(n)) warning(paste("Only one of arguments x and n allowed;", "argument n was ignored")) n <- length(x) } else if(missing(n)) stop("Arguments \"x\" and \"n\" both missing") if(length(n) > 1) { warning(paste("Argument n has", length(n), "elements: only the first used")) n <- n[1] } if(n == 0) return(NULL) rmat <- array(seq(length = n), c(n, n)) # row(matrix(0,n,n)) cmat <- t(rmat) # col(matrix(0,n,n)) lower.t <- rmat > cmat # lower.tri(matrix(0,n,n)) i1 <- cmat[lower.t] i2 <- rmat[lower.t] if(missing(x)) cbind(i1, i2) else cbind(x[i1], x[i2]) } combinat/R/dmnom.R0000644000175100001440000000056507461024702013532 0ustar hornikusers"dmnom"<- function(x, size = sum(x), prob = stop("no prob arg")) { # DATE WRITTEN: 22 May 1995 LAST REVISED: 22 May 1995 # AUTHOR: Scott Chasalow # p <- max(length(x), length(prob)) x <- rep(x, length = p) prob <- rep(prob, length = p) prob <- prob/sum(prob) if(sum(x) != size) 0 else exp(logfact(size) + sum(x * log(prob) - logfact(x))) } combinat/R/fact.R0000644000175100001440000000004307461024702013324 0ustar hornikusers"fact"<- function(x) gamma(x + 1) combinat/R/hcube.R0000644000175100001440000000322607461024702013503 0ustar hornikusers"hcube"<- function(x, scale, translation) { # DATE WRITTEN: 24 April 1995 LAST REVISED: 1 May 1995 # AUTHOR: Scott D. Chasalow # # DESCRIPTION: # Generate all points on a hypercuboid lattice. # Argument x is an integer vector giving the extent of each dimension; # the number of dimensions is length(x). # Argument scale is a vector of real numbers giving an amount by which # to multiply the points in each dimension; it will be replicated as # necessary to have the same length as x. # Argument translate is a vector of real numbers giving an amount to # translate (from the "origin", rep(1,length(x))) the points in each # dimension; it will be replicated as necessary to have the same # length as x. To use rep(0,length(x)) as the origin, use # translation = -1. Scaling, if any, is done BEFORE translation. # # VALUE: # A prod(x) by length(x) numeric matrix; element (i,j) gives the # location of point i in the jth dimension. The first column # (dimension) varies most rapidly. # # SEE ALSO: # fac.design, expand.grid # ncols <- length(x) nrows <- prod(x) cp <- c(1, cumprod(x)[ - ncols]) out <- lapply(as.list(1:length(x)), function(i, a, b, nr) rep(rep(1:a[i], rep(b[i], a[i])), length = nr), a = x, b = cp, nr = nrows) out <- array(unlist(out), c(nrows, ncols)) if(!missing(scale)) { scale <- rep(scale, length = ncols) out <- sweep(out, 2, scale, FUN = "*") } if(!missing(translation)) { translation <- rep(translation, length = ncols) out <- sweep(out, 2, translation, FUN = "+") } out } combinat/R/logfact.R0000644000175100001440000000004707461024702014032 0ustar hornikusers"logfact"<- function(x) lgamma(x + 1) combinat/R/nCm.R0000644000175100001440000000407507461024702013135 0ustar hornikusers"nCm"<- function(n, m, tol = 9.9999999999999984e-009) { # DATE WRITTEN: 7 June 1995 LAST REVISED: 10 July 1995 # AUTHOR: Scott Chasalow # # DESCRIPTION: # Compute the binomial coefficient ("n choose m"), where n is any # real number and m is any integer. Arguments n and m may be vectors; # they will be replicated as necessary to have the same length. # # Argument tol controls rounding of results to integers. If the # difference between a value and its nearest integer is less than tol, # the value returned will be rounded to its nearest integer. To turn # off rounding, use tol = 0. Values of tol greater than the default # should be used only with great caution, unless you are certain only # integer values should be returned. # # REFERENCE: # Feller (1968) An Introduction to Probability Theory and Its # Applications, Volume I, 3rd Edition, pp 50, 63. # len <- max(length(n), length(m)) out <- numeric(len) n <- rep(n, length = len) m <- rep(m, length = len) mint <- (trunc(m) == m) out[!mint] <- NA out[m == 0] <- 1 # out[mint & (m < 0 | (m > 0 & n == 0))] <- 0 whichm <- (mint & m > 0) whichn <- (n < 0) which <- (whichm & whichn) if(any(which)) { nnow <- n[which] mnow <- m[which] out[which] <- ((-1)^mnow) * Recall(mnow - nnow - 1, mnow) } whichn <- (n > 0) nint <- (trunc(n) == n) which <- (whichm & whichn & !nint & n < m) if(any(which)) { nnow <- n[which] mnow <- m[which] foo <- function(j, nn, mm) { n <- nn[j] m <- mm[j] iseq <- seq(n - m + 1, n) negs <- sum(iseq < 0) ((-1)^negs) * exp(sum(log(abs(iseq))) - lgamma(m + 1)) } out[which] <- unlist(lapply(seq(along = nnow), foo, nn = nnow, mm = mnow)) } which <- (whichm & whichn & n >= m) nnow <- n[which] mnow <- m[which] out[which] <- exp(lgamma(nnow + 1) - lgamma(mnow + 1) - lgamma(nnow - mnow + 1)) nna <- !is.na(out) outnow <- out[nna] rout <- round(outnow) smalldif <- abs(rout - outnow) < tol outnow[smalldif] <- rout[smalldif] out[nna] <- outnow out } combinat/R/nsimplex.R0000644000175100001440000000136607461024702014257 0ustar hornikusers"nsimplex"<- function(p, n) { # DATE WRITTEN: 24 Dec 1997 LAST REVISED: 24 Dec 1997 # AUTHOR: Scott D. Chasalow (Scott.Chasalow@users.pv.wau.nl) # # DESCRIPTION: # Computes the number of points on a {p, n}-simplex lattice; that is, the # number of p-part compositions of n. This gives the number of points in # the support space of a Multinomial(n, q) distribution, where # p == length(q). # # Arguments p and n are replicated as necessary to have the length of the # longer of them. # # REQUIRED ARGUMENTS: # p vector of (usually non-negative) integers # n vector of (usually non-negative) integers # mlen <- max(length(p), length(n)) p <- rep(p, length = mlen) n <- rep(n, length = mlen) out <- nCm(n + p - 1, n) out[p < 0] <- 0 out } combinat/R/permn.R0000644000175100001440000000350507461024702013536 0ustar hornikusers"permn"<- function(x, fun = NULL, ...) { # DATE WRITTEN: 23 Dec 1997 LAST REVISED: 23 Dec 1997 # AUTHOR: Scott D. Chasalow (Scott.Chasalow@users.pv.wau.nl) # # DESCRIPTION: # Generates all permutations of the elements of x, in a minimal- # change order. If x is a positive integer, returns all permutations # of the elements of seq(x). If argument "fun" is not null, applies # a function given by the argument to each point. "..." are passed # unchanged to the function given by argument fun, if any. # # Returns a list; each component is either a permutation, or the # results of applying fun to a permutation. # # REFERENCE: # Reingold, E.M., Nievergelt, J., Deo, N. (1977) Combinatorial # Algorithms: Theory and Practice. NJ: Prentice-Hall. pg. 170. # # SEE ALSO: # sample, fact, combn, hcube, xsimplex # # EXAMPLE: # # Convert output to a matrix of dim c(6, 720) # t(array(unlist(permn(6)), dim = c(6, gamma(7)))) # # # A check that every element occurs the same number of times in each # # position # apply(t(array(unlist(permn(6)), dim = c(6, gamma(7)))), 2, tabulate, # nbins = 6) # # # Apply, on the fly, the diff function to every permutation # t(array(unlist(permn(6, diff)), dim = c(5, gamma(7)))) # if(is.numeric(x) && length(x) == 1 && x > 0 && trunc(x) == x) x <- seq( x) n <- length(x) nofun <- is.null(fun) out <- vector("list", gamma(n + 1)) p <- ip <- seqn <- 1:n d <- rep(-1, n) d[1] <- 0 m <- n + 1 p <- c(m, p, m) i <- 1 use <- - c(1, n + 2) while(m != 1) { out[[i]] <- if(nofun) x[p[use]] else fun(x[p[use]], ...) i <- i + 1 m <- n chk <- (p[ip + d + 1] > seqn) m <- max(seqn[!chk]) if(m < n) d[(m + 1):n] <- - d[(m + 1):n] index1 <- ip[m] + 1 index2 <- p[index1] <- p[index1 + d[m]] p[index1 + d[m]] <- m tmp <- ip[index2] ip[index2] <- ip[m] ip[m] <- tmp } out } combinat/R/rmultinomial.R0000644000175100001440000000123007461024702015122 0ustar hornikusers"rmultinomial"<- function(n, p, rows = max(c(length(n), nrow(p)))) { # 19 Feb 1997 (John Wallace, 17 Feb 1997 S-news) # Generate random samples from multinomial distributions, where both n # and p may vary among distributions # # Modified by Scott Chasalow # rmultinomial.1 <- function(n, p) { k <- length(p) tabulate(sample(k, n, replace = TRUE, prob = p), nbins = k) } #assign("rmultinomial.1", rmultinomial.1)#, frame = 1) n <- rep(n, length = rows) p <- p[rep(1:nrow(p), length = rows), , drop = FALSE] #assign("n", n)#, frame = 1) #assign("p", p)#, frame = 1) t(apply(matrix(1:rows, ncol = 1), 1, function(i) rmultinomial.1(n[i], p[i, ]))) } combinat/R/rmultz2.R0000644000175100001440000000064707461024703014041 0ustar hornikusers"rmultz2"<- function(n, p, draws = length(n)) { # 19 Feb 1997: From s-news 14 Feb 1997, Alan Zaslavsky # 11 Mar 1997: Modified by Scott D. Chasalow # # Generate random samples from a multinomial(n, p) distn: varying n, # fixed p case. # n <- rep(n, length = draws) lenp <- length(p) tab <- tabulate(sample(lenp, sum(n), TRUE, p) + lenp * rep(1:draws - 1, n), nbins = draws * lenp) dim(tab) <- c(lenp, draws) tab } combinat/R/x2u.R0000644000175100001440000000273007461024703013133 0ustar hornikusers"x2u"<- function(x, labels = seq(along = x)) { # DATE WRITTEN: 21 January 1994 LAST REVISED: 21 January 1994 # AUTHOR: Scott Chasalow # # DESCRIPTION: # Convert an x-encoded simplex-lattice point to a u-encoded # simplex-lattice point (equivalently, "untabulate" bin counts) # # USAGE: # x2u(x) # # ARGUMENTS: # x: A numeric vector. x[i] is interpreted as the count in bin i. # labels: A vector. Interpreted as the bin labels; default value is # seq(along = x), which causes return of a u-encoded simplex-lattice # point. Other values of labels cause return of the result of # subscripting labels with the u-encoded simplex-lattice point that # would have been obtained if the default value of labels were used. # # Arguments x and labels must be of equal length. # # VALUE: # rep(labels, x), a vector of length sum(x). If labels = seq(along = x) # (the default), value is the u-encoded translation of the simplex # lattice point, x. Equivalently, value gives the bin numbers, # in lexicographic order, for the objects represented by the counts in # x. For other values of argument "labels", value gives the bin labels # for the objects represented by the counts in x (equivalent to # labels[x2u(x)]). # # SEE ALSO: # tabulate, rep # if(length(labels) != length(x)) stop( "Arguments x and labels not of equal length") rep(labels, x) } combinat/R/xsimplex.R0000644000175100001440000000371007461024703014265 0ustar hornikusers"xsimplex"<- function(p, n, fun = NULL, simplify = TRUE, ...) { # DATE WRITTEN: 11 February 1992 LAST REVISED: 10 July 1995 # AUTHOR: Scott Chasalow # # DESCRIPTION: # Generates all points on a {p,n} simplex lattice (i.e. a p-part # composition of n). Each point is represented as x, a # p-dimensional vector of nonnegative integers that sum to n. # If argument "fun" is not null, applies a function given # by the argument to each point. If simplify is FALSE, returns # a list; else returns a vector or an array. "..." are passed # unchanged to function given by argument fun, if any. # EXAMPLE: # Compute Multinomial(n = 4, pi = rep(1/3, 3)) p.f.: # xsimplex(3, 4, dmnom, prob=1/3) # if(p < 1 || n < 0) return(if(simplify) numeric(0) else list()) p1 <- p - 1 x <- numeric(p) x[1] <- n nofun <- is.null(fun) out <- if(nofun) x else fun(x, ...) if(p == 1 || n == 0) { return(if(simplify) out else list(out)) } count <- nCm(n + p - 1, n) if(simplify) { dim.use <- NULL if(nofun) { if(count > 1) dim.use <- c(p, count) } else { d <- dim(out) if(count > 1) { if(length(d) > 1) dim.use <- c(d, count) else if(length(out) > 1) dim.use <- c(length(out), count) } else if(length(d) > 1) dim.use <- d } } out <- vector("list", count) target <- 1 i <- 0 while(1) { i <- i + 1 out[[i]] <- if(nofun) x else fun(x, ...) x[target] <- x[target] - 1 if(target < p1) { target <- target + 1 x[target] <- 1 + x[p] x[p] <- 0 } else { x[p] <- x[p] + 1 while(x[target] == 0) { target <- target - 1 if(target == 0) { i <- i + 1 out[[i]] <- if(nofun) x else fun(x, ...) if(simplify) { if(is.null(dim.use)) out <- unlist(out) else out <- array(unlist(out), dim.use) } return(out) } } } } }