multicool/0000755000176200001440000000000013572134411012262 5ustar liggesusersmulticool/NAMESPACE0000644000176200001440000000025713571771015013513 0ustar liggesusersuseDynLib(multicool) export(allPerm) export(B) export(Bell) export(genComp) export(initMC) export(multinom) export(nextPerm) export(S2) export(Stirling2) import(Rcpp,methods) multicool/README.md0000644000176200001440000000002412650526750013544 0ustar liggesusersmulticool ========= multicool/man/0000755000176200001440000000000013567357031013046 5ustar liggesusersmulticool/man/initMC.Rd0000644000176200001440000000223713567360533014525 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/initMC.r \name{initMC} \alias{initMC} \title{Initialise the permutation object} \usage{ initMC(x) } \arguments{ \item{x}{a vector of integers, reals, logicals or characters} } \value{ a object of class \code{mc} which is a list containing elements \itemize{ \item{mode}{ - the mode of the original data in \code{x}, "integer", "double", or \code{mode(x)}} \item{set}{ - either the multiset being permuted if \code{mode} is "integer" or a set of integers corresponding to the elements of the multiset} \item {elements}{ - if \code{mode} is not "integer" then this contains the elements being permuted otherwise \code{NULL} } \item {length} { - the length of the multiset } \item {mc}{ - a pointer to the internal C++ Multicool object. Users should not use this unless they really know what they are doing} } } \description{ This function initialises the permutation object. It must be called before \code{nextPerm} can be called } \examples{ x = c(1,1,2,2) m1 = initMC(x) m1 ## a non-integer example x = rep(letters[1:4],c(2,1,2,2)) m2 = initMC(x) m2 } \seealso{ nextPerm } \author{ James M. Curran } multicool/man/genComp.Rd0000644000176200001440000000474413567357031014736 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/genComp.R \name{genComp} \alias{genComp} \title{Generate all, or a subset, of the integer partitions of an integer n.} \usage{ genComp(n, len = TRUE, addZeros = FALSE) } \arguments{ \item{n}{A positive non-zero integer} \item{len}{Either logical \code{TRUE}, or an integer less than or equal to \code{n}. If the latter form is used then only those partions of length less than or equal to len are returned} \item{addZeros}{If true then the empty partitions are added to the list of partitions.} } \value{ A list with each list element representing an integer partition } \description{ This function will return either all, or a length restricted subset of the integer partitions of an integer n. The method works by considering compositions rather than partions, hence the name. } \details{ This function will return all partions, or a subset, of an integer n. It makes no check to see if this is a sensible thing to do. It also does it in a lazy way in that in the restricted case it generates all partitions and then only returns those that satistfy the length constraint. Users are advised to check how many partitions are possible using partition number function which is implemented the \code{P} function in the \pkg{partions} package. Having said this P(50) is approximately 200 thousand, and P(100) around 190 million, so the function should work well for smallish n. } \note{ This function does not warn the user that the requested set of partitions may be very large. In addition, all working is handled entirely in memory, and so this may cause it to crash if the request is execeptionally large. } \examples{ ## a small numeric example with all 11 partitions of 6 genComp(6) ## a small example with the integer partitions of 6 of length 3 with empty partitions added genComp(6, 3, TRUE) ## a larger example - 627 partions of 20, but restricted to those of length 3 or smaller genComp(20, 3) } \references{ Kelleher, J. (2005), Encoding Partitions As Ascending Compositions, PhD thesis, University College Cork \url{http://jeromekelleher.net/downloads/k06.pdf}. Kelleher, J. and O'Sullivan, B. (2009), Generating All Partitions: A Comparison Of Two Encodings, \url{http://arxiv.org/abs/0909.2331}. Kelleher, J. (2010) Generating Integer Partitions,\url{http://jeromekelleher.net/tag/integer-partitions.html}. } \author{ Jerome Kelleher (algorithm and Python version) and James M. Curran (C++ version/R interface) } \keyword{partitions} multicool/man/Stirling2.Rd0000644000176200001440000000232713567357031015216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Stirling2.R \name{Stirling2} \alias{Stirling2} \alias{S2} \title{Compute Stirling numbers of the second kind} \usage{ Stirling2(n, k) } \arguments{ \item{n}{A vector of one or more positive integers} \item{k}{A vector of one or more positive integers} } \value{ An vector of Stirling numbers of the second kind } \description{ This function computes Stirling numbers of the second kind, \eqn{S(n, k)}{S(n, k)}, which count the number of ways of partitioning n distinct objects in to k non-empty sets. } \details{ The implementation on this function is a simple recurrence relation which defines \deqn{S(n, k) = kS(n - 1, k), + S(n - 1, k - 1)} for \eqn{k > 0} with the inital conditions \eqn{S(0, 0) = 1} and \eqn{S(n, 0) = S(0, n) = 0}. If \code{n} and \code{n} have different lengths then \code{expand.grid} is used to construct a vector of (n, k) pairs } \examples{ ## returns S(6, 3) Stirling2(6, 3) ## returns S(6,1), S(6,2), ..., S(6,6) S2(6, 1:6) ## returns S(6,1), S(5, 2), S(4, 3) S2(6:4, 1:3) } \references{ \url{http://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind#Recurrence_relation} } \author{ James Curran } \keyword{partitions} multicool/man/nextPerm.Rd0000644000176200001440000000150713567357031015142 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/nextPerm.R \name{nextPerm} \alias{nextPerm} \title{Return the next permutation of the multiset} \usage{ nextPerm(mcObj) } \arguments{ \item{mcObj}{an S3 object of class \code{mc} which must be created with \code{initMC}} } \value{ either a vector with the next permutation of the multiset or \code{FALSE} when all permutations have been returned } \description{ This function returns the next permuation of the multiset if there is one. \code{initMC} called before \code{nextPerm} can be called. } \examples{ x = c(1,1,2,2) m1 = initMC(x) for(i in 1:6){ cat(paste(paste(nextPerm(m1),collapse=","),"\\n")) } ## an example with letters x = letters[1:4] m2 = initMC(x) nextPerm(m2) nextPerm(m2) ## and so on } \seealso{ nextPerm } \author{ James M. Curran } multicool/man/Bell.Rd0000644000176200001440000000136713567357031014222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Stirling2.R \name{Bell} \alias{Bell} \alias{B} \title{Compute the Bell numbers} \usage{ Bell(n) } \arguments{ \item{n}{A vector of one or more non-zero positive integers} } \value{ An vector of Bell numbers } \description{ This function computes the Bell numbers, which is the summ of Stirling numbers of the second kind, \eqn{S(n, k)}{S(n, k)}, over \eqn{k = 1,\ldots, n}{k}, i.e. \deqn{B_n = \sum_{k=1}^{n}S(n, k),n \ge 1} } \examples{ ## returns B(6) Bell(6) ## returns B(1), B(2), ..., B(6) B(1:6) } \references{ \url{http://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind#Recurrence_relation} } \seealso{ Stirling2 } \author{ James Curran } \keyword{partitions} multicool/man/allPerm.Rd0000644000176200001440000000240113567357031014726 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/allPerm.R \name{allPerm} \alias{allPerm} \title{Generate and return all permutations of a multiset} \usage{ allPerm(mcObj) } \arguments{ \item{mcObj}{an object of class mc - usually generated by \code{initMC}} } \value{ A matrix with each row being a different permutation of the multiset } \description{ This function will return all permutations of a multiset } \details{ This function will return all permutations of a multiset. It makes no check to see if this is a sensible thing to do. Users are advised to check how many permutations are possible using the \code{multinom} function in this package. } \note{ This function does not warn the user that the requested set of permutations may be very large. In addition, all working is handled entirely in memory, and so this may cause it to crash if the request is execeptionally large. } \examples{ ## a small numeric example with 6 permuations x = c(1,1,2,2) m = initMC(x) allPerm(m) ## a large character example - 60 possibilities x = rep(letters[1:3], 3:1) multinom(x) ## calculate the number of permutations m = initMC(x) allPerm(m) } \seealso{ \code{\link{initMC}}, \code{\link{multinom}} } \author{ James M. Curran } \keyword{permutations} multicool/man/multinom.Rd0000644000176200001440000000576513567357031015216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multinom.R \name{multinom} \alias{multinom} \title{Calculate multinomial coefficients} \usage{ multinom(x, counts = FALSE, useDouble = FALSE) } \arguments{ \item{x}{Either a multiset (with one or more potentially non-unique elements), or if \code{counts} is \code{TRUE} a set of counts of the unique elements of \eqn{X}. If \code{counts} is \code{FALSE} and \code{x} is not numeric, then x will be coerced into an integer vector internally. If \code{counts} is \code{TRUE} then \code{x} must be a vector of integers that are greater than, or equal to zero.} \item{counts}{if \code{counts} is TRUE, then this means x is the set of counts \eqn{n_1, n_2, \ldots, n_k} rather than the set itself} \item{useDouble}{if \code{useDouble} is TRUE then the computation will be done using double precision floating point arithmetic. This option was added because the internal code cannot handle integer overflow. The double precision code will may a result that is closer to the truth for large values, but this is not guaranteed. Ideally something like the GMP library should be used, but this is not a priority at this point in time.} } \value{ A single integer representing the multinomial coefficient for the given multiset, or given set of multiplicities. } \description{ This function calculates the number of permutations of a multiset, this being the multinomial coefficient. If a set \eqn{X} contains \eqn{k} unique elements \eqn{x_1, x_2, \ldots, x_k} with associate counts (or multiplicities) of \eqn{n_1, n_2, \ldots, n_k}, then this function returns \deqn{\frac{n!}{n_1!n_2!\ldots n_k!}}{n!/(n_1!n_2!\ldots n_k!)} where \eqn{n = \sum_{i=1}{k}n_i}{n = n_1 + n_2 + \cdots + n_k}. } \details{ multinom depends on C++ code written by Dave Barber which can be found at \url{http://tamivox.org/dave/multinomial/code.html}. The code may require the STL algorithm library to be included in order to compile it. } \examples{ ## An example with a multiset X = (a,a,a,b,b,c) ## There are 3 a s, 2 b s and 1 c, so the answer should be ## (3+2+1)!/(3!2!1!) = 6!/3!2!1! = 60 x = rep(letters[1:3],3:1) multinom(x) ## in this example x is a vector of counts ## the answer should be the same as above as x = c(3,2,1) x = rep(letters[1:3],3:1) x = as.vector(table(x)) #coerce x into a vector of counts multinom(x, counts = TRUE) ## An example of integer overflow. x is a vector of counts ## c(12,11,8,8,6,5). The true answer from Maple is ## 11,324,718,121,789,252,764,532,876,767,840,000 ## The error in the integer based answer is obvious. ## The error using floating point is not, but from Maple is ## 0.705057123232160000e+10 ## Thanks to Lev Dashevskiy for calling my attention to this. \dontrun{x = c(12,11,8,8,6,5) multinom(x, counts = TRUE, useDouble = FALSE) multinom(x, counts = TRUE, useDouble = TRUE) } } \references{ \url{http://tamivox.org/dave/multinomial/code.html} } \author{ James M. Curran, Dave Barber } \keyword{combinations} \keyword{multinomial} \keyword{permutations} multicool/DESCRIPTION0000644000176200001440000000272413572134411013775 0ustar liggesusersPackage: multicool Type: Package Title: Permutations of Multisets in Cool-Lex Order Version: 0.1-11 Date: 2019-12-04 Author: James Curran, Aaron Williams, Jerome Kelleher, Dave Barber Maintainer: James Curran Description: A set of tools to permute multisets without loops or hash tables and to generate integer partitions. The permutation functions are based on C code from Aaron Williams. Cool-lex order is similar to colexicographical order. The algorithm is described in Williams, A. Loopless Generation of Multiset Permutations by Prefix Shifts. SODA 2009, Symposium on Discrete Algorithms, New York, United States. The permutation code is distributed without restrictions. The code for stable and efficient computation of multinomial coefficients comes from Dave Barber. The code can be download from and is distributed without conditions. The package also generates the integer partitions of a positive, non-zero integer n. The C++ code for this is based on Python code from Jerome Kelleher which can be found here . The C++ code and Python code are distributed without conditions. Encoding: UTF-8 License: GPL-2 Depends: methods, Rcpp (>= 0.11.2) LinkingTo: Rcpp SystemRequirements: C++11 RcppModules: Multicool RoxygenNote: 6.1.1 NeedsCompilation: yes Packaged: 2019-12-05 02:39:27 UTC; jcur002 Repository: CRAN Date/Publication: 2019-12-05 08:00:09 UTC multicool/src/0000755000176200001440000000000013572066737013070 5ustar liggesusersmulticool/src/multicool.cpp0000644000176200001440000001625213571774626015613 0ustar liggesusers#include #include #include #include #include #include "multinomial.h" #include using namespace Rcpp; using namespace std; /* Adapted from Aaron Williams multicool.c Author: Aaron Williams (haron@uvic.ca) Website: http://www.math.mcgill.ca/haron/ This code is distributed without conditions This program outputs the permutations of any multiset in cool-lex order. The program stores a single permutation in a singly-linked list, and then each successive permutation in O(1)-time while using O(1) additional pointers. Input is read from stdin as follows: n e_1 e_2 ... e_n where e_i <= e_{i+1} for all i. For example, if input.txt is a file containing the following single line 6 1 1 2 3 3 3 then multicool < input.txt will output the cool-lex order for the permutations of {1,1,2,3,3,3}: 333211 133321 313321 etc */ // C++ version: James M. Curran (j.curran@auckland.ac.nz) // [[Rcpp::plugins("cpp11")]] class Multicool{ struct list_el { int v; struct list_el * n; }; typedef struct list_el item; item *h; item *t; item *i; int *m_pnInitialState; // stored so that the current state can be reset to the initial state int *m_pnCurrState; int m_nLength; bool m_bFirst; public: // constructor Multicool(IntegerVector x){ int nx = (int)x.size(); i = (item *)NULL; h = NULL; m_pnInitialState = new int[nx]; m_pnCurrState = new int[nx]; m_nLength = nx; m_bFirst = true; for(int ctr = 0; ctr < nx; ctr++){ t = new item; t->v = INT_MAX; t->v = x[ctr]; m_pnCurrState[ctr] = x[ctr]; m_pnInitialState[ctr] = x[ctr]; t->n = h; h = t; if(h->n && h->n->v > h->v){ // std::cout << "Error" << std::endl; // should programme some sensible action here but I don't know what } if(ctr+1 == 2){ i = h; } /*Rprintf("Step %d\n--------\n", ctr + 1); debugPrint(); Rprintf("--------\n");*/ } }; //destructor ~Multicool(void){ // Rprintf("Destructor called\n"); delete [] m_pnInitialState; delete [] m_pnCurrState; while(t){ item *next = t->n; delete t; t = next; } }; private: void debugPrint(void){ char strPtr[] = {'h', 't', 'i'}; for(auto ctr = 0; ctr < 3; ctr++){ item *p; switch(ctr){ case 0: p = h; break; case 1: p = t; break; case 2: p = i; break; } if(p != NULL){ Rprintf("item %c->v: %d\n",strPtr[ctr] , p->v); if(p->n != NULL){ Rprintf("item %c->n: %p\n",strPtr[ctr] , p->n); }else{ Rprintf("item %c->n: NULL\n",strPtr[ctr]); } }else{ Rprintf("%c = NULL\n",strPtr[ctr] ); } } Rprintf("m_nLength %d\n", m_nLength); Rprintf("m_bFirst %d\n", (int)m_bFirst); Rprintf("m_pnInitialState: "); for(auto ctr = 0; ctr < m_nLength; ctr++){ Rprintf("%d ", m_pnInitialState[ctr]); } Rprintf("\n"); Rprintf("m_pnCurrState: "); for(auto ctr = 0; ctr < m_nLength; ctr++){ Rprintf("%d ", m_pnCurrState[ctr]); } Rprintf("\n"); } void print(void){ Rprintf("item h->v: %d\n", h->v); Rprintf("item t->v: %d\n", t->v); Rprintf("item i->v: %d\n", i->v); Rprintf("m_nLength %d\n", m_nLength); Rprintf("m_bFirst %d\n", (int)m_bFirst); int i; Rprintf("m_pnInitialState: "); for(i = 0; i < m_nLength; i++){ Rprintf("%d ", m_pnInitialState[i]); } Rprintf("\n"); Rprintf("m_pnCurrState: "); for(i = 0; i < m_nLength; i++){ Rprintf("%d ", m_pnCurrState[i]); } Rprintf("\n"); } void reset(void){ delete [] m_pnCurrState; while(t){ item *next = t->n; delete t; t = next; } i = (item *)NULL; h = NULL; m_pnCurrState = new int[m_nLength]; m_bFirst = true; for(int ctr = 0; ctr < m_nLength; ctr++){ t = new item; t->v = INT_MAX; t->v = m_pnInitialState[ctr]; m_pnCurrState[ctr] = m_pnInitialState[ctr]; t->n = h; h = t; if(h->n && h->n->v > h->v){ //std::cout << "Error" << std::endl; // should programme some sensible action here but I don't know what } if(ctr+1 == 2){ i = h; } } } void setState(item *b){ item *y; y = b; int ctr = 0; while(y) { m_pnCurrState[ctr++] = y->v; y = y->n ; } } vector getState(void){ vector vState; for(int ctr = 0; ctr < m_nLength; ctr++) vState.push_back( m_pnCurrState[ctr] ); return vState; }; public: List allPerm(void){ this->reset(); vector set = this->getInitialState(); auto lResult = vector>(); while( this->hasNext()){ if (lResult.size() % 1000 == 0) Rcpp::checkUserInterrupt(); lResult.push_back( this->getState() ); } return wrap(lResult); }; int getLength(void){ return m_nLength; }; vector getInitialState(void){ vector vSet(m_pnInitialState, m_pnInitialState + m_nLength); return vSet; }; bool hasNext(void){ item *j; item *t; item *s; /*Rprintf("\n--------\n"); debugPrint(); Rprintf("--------\n");*/ if(m_bFirst){ setState(h); m_bFirst = false; return true; }else{ j = i->n; if(j->n || j->v < h->v) { if (j->n && i->v >= j->n->v) { s = j; } else { s = i; } t = s->n; s->n = t->n; t->n = h; if(t->v < h->v) { i = t; } j = i->n; h = t; setState(h); return true; }else{ return false; } } }; List nextPerm(void){ List lhs; lhs["set"] = as(wrap(getState())); lhs["b"] = hasNext() ? 1 : 0; return lhs; }; }; RCPP_MODULE(Multicool) { using namespace Rcpp; class_( "Multicool") .constructor("Standard constructor") .method("allPerm", &Multicool::allPerm) .method("set", &Multicool::getInitialState) .method("length", &Multicool::getLength) .method("hasNext", &Multicool::hasNext) .method("nextPerm", &Multicool::nextPerm) ; } // int test(void){ // int *i = new int[4]; // i[0] = 1; // i[1] = 1; // i[2] = 2; // i[3] = 2; // // Multicool m(i, 4); // // while(m.hasNext()){ // m.getState(i); // // for(int ctr = 0; ctr < 4; ctr++){ // std::cout << i[ctr]; // } // std::cout << std::endl; // } // // return 0; // } // multinomial coefficient // [[Rcpp::export]] NumericVector multinomCoeff(NumericVector x, bool useDouble){ int nx = x.size(); multinomial::SVI v(nx); int i; for(i = 0; i < nx; i++){ v.at(i) = x[i]; } if(useDouble){ double u = multinomial::multi(v); NumericVector r = NumericVector::create(u); return r; }//else unsigned long u = multinomial::multi(v); NumericVector r = NumericVector::create(u); return r; } multicool/src/multinomial.h0000644000176200001440000001171513015745642015567 0ustar liggesusers#ifndef _MULTINOMIAL_H #define _MULTINOMIAL_H 1 #include #include #include #include #include // Author: Dave Barber // Code downloaded from from http://tamivox.org/dave/multinomial/code.html // There are no terms and conditions attached to the distribution of this code. namespace multinomial { typedef std::vector SVI; typedef SVI::iterator SVII; typedef SVI::const_iterator SVICI; void view (std::ostream & ost, SVI const & v) { ost << "("; if (v.size() > 0) ost << v.at(0); for (size_t i = 1; i < v.size(); ++i) { size_t const vai (v.at(i)); if (vai == 0) break; ost << ", " << vai; } ost << ")"; } // class index calculates subscripts for class combo class index { static SVI pair; static SVI sole; static size_t pair_ind (size_t const, size_t const); static void layer (size_t const); static bool compare (size_t const, size_t const); public: static size_t get (size_t const, size_t const); static size_t get (size_t const); static size_t get (SVI const &); }; SVI index::pair (1, 1); SVI index::sole (1, 0); size_t index::pair_ind (size_t const rem, size_t const top) { return ((rem * (rem + 1)) / 2 + ((top > rem) ? rem : top)); } void index::layer (size_t const rem) { if (pair.size() < pair_ind (rem, 0)) layer (rem - 1); pair.push_back(0); pair.push_back(1); for (size_t top = 2; top <= rem; ++top) { pair.push_back (pair.at (pair_ind (rem - top, top))); if (rem >= top) pair.back() += pair.at (pair_ind (rem, top - 1)); } size_t const y (sole.back()); sole.push_back(pair.at(pair_ind(rem - 1, rem - 1))); sole.back() += y; } bool index::compare (size_t const a, size_t const b) { return a > b; } size_t index::get (size_t const rem, size_t const top) { size_t const ind (pair_ind (rem, top)); if (ind < pair.size()) return pair.at(ind); layer (rem); return pair.at(ind); } size_t index::get (size_t const rem) { if (rem < sole.size()) return sole.at(rem); layer (rem); return sole.at(rem); } size_t index::get (SVI const & part) { SVI temp (part); std::sort (temp.begin(), temp.end(), &compare); size_t minuend (std::accumulate (temp.begin(), temp.end(), 0)); size_t ans (get(minuend)); for (SVICI i = temp.begin(); i != temp.end(); ++i) { if (*i == 0) break; ans += get (minuend, *i - 1); minuend -= *i; } return ans; } // the multinomial values are stored in class combo template < typename result_type > class combo { static std::vector guts; static size_t tier; static void layer (SVI const &); static void layer (size_t const, size_t const, size_t const, SVI &); static void layer (); public: static result_type get (SVI const &); }; template < typename result_type > std::vector combo::guts (1, 1); template < typename result_type > size_t combo::tier (0); template < typename result_type > void combo::layer (SVI const & part) { result_type total (0); SVI temp (part); for (SVII n = temp.begin(); n != temp.end(); ++n) { size_t & tan (*n); if (tan == 0) break; tan--; total += get (temp); tan++; } guts.push_back(total); } template < typename result_type > void combo::layer (size_t const rem, size_t const top, size_t const pos, SVI & part) { if (rem == 0) { layer (part); return; } for (size_t n = 1; ; ++n) { if (n > rem) break; if (n > top) break; part.at(pos) = n; if (top > n) layer (rem - n, n, pos + 1, part); else layer (rem - n, top, pos + 1, part); part.at(pos) = 0; } } template < typename result_type > void combo::layer () { ++tier; SVI part (tier); layer (tier, tier, 0, part); } template < typename result_type > result_type combo::get (SVI const & part) { size_t const ind (index::get(part)); while (guts.size() <= ind) layer(); return guts.at(ind); } // the next two functions are probably all that you really need template < typename result_type > result_type multi (SVI const & part) { return combo::get (part); } size_t parti (size_t const rem, size_t const top) { return index::get (rem, (top > rem) ? rem : top); } } #endif multicool/src/compositions.cpp0000644000176200001440000000264013571773274016324 0ustar liggesusers#include #include using namespace Rcpp; using namespace std; // generate all combinations // [[Rcpp::export]] List generateCompositions(int n){ // Adapted from Python code and algorithm by // Jerome Kelleher (c) 2009 // http://jeromekelleher.net/category/combinatorics.html List A; vector a(n+1); fill(a.begin(), a.end(), 0); int k = 1; int y = n - 1; while(k != 0){ int x = a[k - 1] + 1; k -= 1; while(2*x <= y){ a[k] = x; y -= x; k += 1; } int l = k + 1; while(x <= y){ a[k] = x; a[l] = y; /*for(int i = 0; i < k + 2; i++) cout << a[i] << ' '; */ A.push_back(vector(a.begin(), a.begin() + (k + 2))); //cout << endl; x += 1; y -= 1; } a[k] = x + y; y = x + y - 1; /*for(int i = 0; i < k + 1; i++) cout << a[i] << ' '; cout << endl;*/ A.push_back(vector(a.begin(), a.begin() + k + 1)); } return A; } // Calculate Stirling numbers of the second kind S2(n, k) // [[Rcpp::export]] long Stirling2C(int n, int k){ if((n == 0 && k == 0) || (n > 0 && k == 1) || (n > 0 && n == k)) return 1; if((n == 0 || k == 0)) // n = k = 0 should get caught by the previous if return 0; return k * Stirling2C(n - 1, k) + Stirling2C(n - 1, k - 1); } // Calculate Bell numbers // [[Rcpp::export]] long BellC(int n){ long sum = 0; for(int k = 1; k <= n; k++){ sum += Stirling2C(n, k); } return sum; } multicool/src/RcppExports.cpp0000644000176200001440000000445013567356231016063 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // generateCompositions List generateCompositions(int n); RcppExport SEXP _multicool_generateCompositions(SEXP nSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type n(nSEXP); rcpp_result_gen = Rcpp::wrap(generateCompositions(n)); return rcpp_result_gen; END_RCPP } // Stirling2C long Stirling2C(int n, int k); RcppExport SEXP _multicool_Stirling2C(SEXP nSEXP, SEXP kSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< int >::type k(kSEXP); rcpp_result_gen = Rcpp::wrap(Stirling2C(n, k)); return rcpp_result_gen; END_RCPP } // BellC long BellC(int n); RcppExport SEXP _multicool_BellC(SEXP nSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type n(nSEXP); rcpp_result_gen = Rcpp::wrap(BellC(n)); return rcpp_result_gen; END_RCPP } // multinomCoeff NumericVector multinomCoeff(NumericVector x, bool useDouble); RcppExport SEXP _multicool_multinomCoeff(SEXP xSEXP, SEXP useDoubleSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< bool >::type useDouble(useDoubleSEXP); rcpp_result_gen = Rcpp::wrap(multinomCoeff(x, useDouble)); return rcpp_result_gen; END_RCPP } RcppExport SEXP _rcpp_module_boot_Multicool(); static const R_CallMethodDef CallEntries[] = { {"_multicool_generateCompositions", (DL_FUNC) &_multicool_generateCompositions, 1}, {"_multicool_Stirling2C", (DL_FUNC) &_multicool_Stirling2C, 2}, {"_multicool_BellC", (DL_FUNC) &_multicool_BellC, 1}, {"_multicool_multinomCoeff", (DL_FUNC) &_multicool_multinomCoeff, 2}, {"_rcpp_module_boot_Multicool", (DL_FUNC) &_rcpp_module_boot_Multicool, 0}, {NULL, NULL, 0} }; RcppExport void R_init_multicool(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } multicool/R/0000755000176200001440000000000013572066733012476 5ustar liggesusersmulticool/R/genComp.R0000644000176200001440000000600413567356332014212 0ustar liggesusers#' Generate all, or a subset, of the integer partitions of an integer n. #' #' This function will return either all, or a length restricted subset of the #' integer partitions of an integer n. The method works by considering #' compositions rather than partions, hence the name. #' #' This function will return all partions, or a subset, of an integer n. It #' makes no check to see if this is a sensible thing to do. It also does it in #' a lazy way in that in the restricted case it generates all partitions and #' then only returns those that satistfy the length constraint. Users are #' advised to check how many partitions are possible using partition number #' function which is implemented the \code{P} function in the \pkg{partions} #' package. Having said this P(50) is approximately 200 thousand, and P(100) #' around 190 million, so the function should work well for smallish n. #' #' @param n A positive non-zero integer #' @param len Either logical \code{TRUE}, or an integer less than or equal to #' \code{n}. If the latter form is used then only those partions of length less #' than or equal to len are returned #' @param addZeros If true then the empty partitions are added to the list of #' partitions. #' @return A list with each list element representing an integer partition #' @note This function does not warn the user that the requested set of #' partitions may be very large. In addition, all working is handled entirely #' in memory, and so this may cause it to crash if the request is #' execeptionally large. #' @author Jerome Kelleher (algorithm and Python version) and James M. Curran #' (C++ version/R interface) #' @references Kelleher, J. (2005), Encoding Partitions As Ascending #' Compositions, PhD thesis, University College Cork #' \url{http://jeromekelleher.net/downloads/k06.pdf}. #' #' Kelleher, J. and O'Sullivan, B. (2009), Generating All Partitions: A #' Comparison Of Two Encodings, \url{http://arxiv.org/abs/0909.2331}. #' #' Kelleher, J. (2010) Generating Integer #' Partitions,\url{http://jeromekelleher.net/tag/integer-partitions.html}. #' @keywords partitions #' @examples #' #' ## a small numeric example with all 11 partitions of 6 #' genComp(6) #' #' ## a small example with the integer partitions of 6 of length 3 with empty partitions added #' genComp(6, 3, TRUE) #' #' ## a larger example - 627 partions of 20, but restricted to those of length 3 or smaller #' genComp(20, 3) #' #' @export genComp genComp = function(n, len = TRUE, addZeros = FALSE){ regularize = function(x, regLen){ return(c(x, rep(0, regLen - length(x)))) } if(len & is.logical(len)){ l = generateCompositions(n) if(addZeros) l = lapply(l, regularize, regLen = n) return(l) }else if(is.numeric(len) & len <= n) { constraintFn = function(l){ if(length(l) <= len) return(TRUE) else return(FALSE) } l = generateCompositions(n) l = l[sapply(l, constraintFn)] if(addZeros) l = lapply(l, regularize, regLen = len) return(l) } } multicool/R/zzz.R0000644000176200001440000000014312650526750013450 0ustar liggesusers# .onLoad <- function(libname, pkgname) { # loadRcppModules() # } loadModule("Multicool", TRUE) multicool/R/allPerm.R0000644000176200001440000000261413567356332014221 0ustar liggesusers#' Generate and return all permutations of a multiset #' #' This function will return all permutations of a multiset #' #' This function will return all permutations of a multiset. It makes no check #' to see if this is a sensible thing to do. Users are advised to check how #' many permutations are possible using the \code{multinom} function in this #' package. #' #' @param mcObj an object of class mc - usually generated by \code{initMC} #' @return A matrix with each row being a different permutation of the multiset #' @note This function does not warn the user that the requested set of #' permutations may be very large. In addition, all working is handled entirely #' in memory, and so this may cause it to crash if the request is #' execeptionally large. #' @author James M. Curran #' @seealso \code{\link{initMC}}, \code{\link{multinom}} #' @keywords permutations #' @examples #' #' ## a small numeric example with 6 permuations #' x = c(1,1,2,2) #' m = initMC(x) #' allPerm(m) #' #' ## a large character example - 60 possibilities #' x = rep(letters[1:3], 3:1) #' multinom(x) ## calculate the number of permutations #' m = initMC(x) #' allPerm(m) #' #' @export allPerm allPerm = function(mcObj){ if(class(mcObj) != "mc") stop("mcObject must be of class mc") r = mcObj$mc$allPerm() x = unlist(r) return(matrix(mcObj$elements[x], ncol = mcObj$length, byrow = TRUE)) } multicool/R/Stirling2.R0000644000176200001440000000474113567356332014505 0ustar liggesusers#' Compute Stirling numbers of the second kind #' #' This function computes Stirling numbers of the second kind, \eqn{S(n, #' k)}{S(n, k)}, which count the number of ways of partitioning n distinct #' objects in to k non-empty sets. #' #' The implementation on this function is a simple recurrence relation which #' defines \deqn{S(n, k) = kS(n - 1, k), + S(n - 1, k - 1)} for \eqn{k > 0} #' with the inital conditions \eqn{S(0, 0) = 1} and \eqn{S(n, 0) = S(0, n) = #' 0}. If \code{n} and \code{n} have different lengths then \code{expand.grid} #' is used to construct a vector of (n, k) pairs #' #' @aliases Stirling2 S2 #' @param n A vector of one or more positive integers #' @param k A vector of one or more positive integers #' @return An vector of Stirling numbers of the second kind #' @author James Curran #' @references #' \url{http://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind#Recurrence_relation} #' @keywords partitions #' @examples #' #' ## returns S(6, 3) #' Stirling2(6, 3) #' #' ## returns S(6,1), S(6,2), ..., S(6,6) #' S2(6, 1:6) #' #' ## returns S(6,1), S(5, 2), S(4, 3) #' S2(6:4, 1:3) #' #' @export Stirling2 Stirling2 = function(n, k){ if(any(n < 0) || any(k < 0)) stop("n and k must be positive integers, n >= 0, k >= 0") nN = length(n) nK = length(k) if(nN > 1 || nK > 1){ if(nN != nK){ grid = expand.grid(n = n, k = k) n = grid$n k = grid$k nN = nK = nrow(grid) } } result = rep(0, nN) for(r in 1:nN){ result[r] = Stirling2C(n[r], k[r]) } return(result) } S2 = function(n, k){Stirling2(n, k)} #' Compute the Bell numbers #' #' This function computes the Bell numbers, which is the summ of Stirling #' numbers of the second kind, \eqn{S(n, k)}{S(n, k)}, over \eqn{k = 1,\ldots, #' n}{k}, i.e. \deqn{B_n = \sum_{k=1}^{n}S(n, k),n \ge 1} #' #' #' @aliases Bell B #' @param n A vector of one or more non-zero positive integers #' @return An vector of Bell numbers #' @author James Curran #' @seealso Stirling2 #' @references #' \url{http://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind#Recurrence_relation} #' @keywords partitions #' @examples #' #' ## returns B(6) #' Bell(6) #' #' ## returns B(1), B(2), ..., B(6) #' B(1:6) #' #' @export Bell Bell = function(n){ if(any(n <=0)) stop("n must be greater than or equal to 1") nN = length(n) result = rep(0, nN) for(r in 1:nN) result[r] = sum(Stirling2(n[r], 1:n[r])) return(result) } B = function(n){Bell(n)} multicool/R/initMC.r0000644000176200001440000000476613567360531014056 0ustar liggesusers#' Initialise the permutation object #' #' This function initialises the permutation object. It must be called before #' \code{nextPerm} can be called #' #' #' @param x a vector of integers, reals, logicals or characters #' @return a object of class \code{mc} which is a list containing elements #' \itemize{ #' \item{mode}{ - the mode of the original data in \code{x}, "integer", #' "double", or \code{mode(x)}} #' \item{set}{ - either the multiset being permuted if \code{mode} is "integer" or #' a set of integers corresponding to the elements of the multiset} #' \item {elements}{ - if \code{mode} is not "integer" then this contains the #' elements being permuted otherwise \code{NULL} } #' \item {length} { - the length of the multiset } #' \item {mc}{ - a pointer to the internal C++ Multicool object. Users #' should not use this unless they really know what they are doing} #' } #' @author James M. Curran #' @seealso nextPerm #' @examples #' #' x = c(1,1,2,2) #' m1 = initMC(x) #' m1 #' #' ## a non-integer example #' #' x = rep(letters[1:4],c(2,1,2,2)) #' m2 = initMC(x) #' m2 #' #' @export initMC initMC = function(x){ if(length(x) > 1){ r = NULL if(is.numeric(x)){ ## Test for whole number, with tolerance for representation ## From post by Tony Plate tolerance = .Machine$double.eps^0.5 if(isTRUE(all(abs(x - round(x))< tolerance))){ ## integer args tbl = table(x) elements = as.numeric(names(tbl)) set = rep(1:length(tbl), tbl) r = new(Multicool, set) mcObj = list(mode = "integer", set = r$set(), elements = elements, length = r$length(), mc = r) class(mcObj) = "mc" return(mcObj) }else{ ## doubles tbl = table(x) elements = as.numeric(tbl) set = rep(1:length(tbl), tbl) r = new(Multicool, set) mcObj = list(mode = "double", set = r$set(), elements = elements, length = r$length(), mc = r) class(mcObj) = "mc" return(mcObj) } }else{ ## logicals and characters and who know's whatelse tbl = table(x) elements = names(tbl) set = rep(1:length(tbl), tbl) r = new(Multicool, set) mcObj = list(mode = mode(x), set = r$set(), elements = elements, length = r$length(), mc = r) class(mcObj) = "mc" return(mcObj) } }else{ warning("The permutations of a vector of length 1 are not very interesting") } } multicool/R/multinom.R0000644000176200001440000000665613567356332014503 0ustar liggesusers#' Calculate multinomial coefficients #' #' This function calculates the number of permutations of a multiset, this #' being the multinomial coefficient. If a set \eqn{X} contains \eqn{k} unique #' elements \eqn{x_1, x_2, \ldots, x_k} with associate counts (or #' multiplicities) of \eqn{n_1, n_2, \ldots, n_k}, then this function returns #' \deqn{\frac{n!}{n_1!n_2!\ldots n_k!}}{n!/(n_1!n_2!\ldots n_k!)} where \eqn{n #' = \sum_{i=1}{k}n_i}{n = n_1 + n_2 + \cdots + n_k}. #' #' multinom depends on C++ code written by Dave Barber which can be found at #' \url{http://tamivox.org/dave/multinomial/code.html}. The code may require #' the STL algorithm library to be included in order to compile it. #' #' @param x Either a multiset (with one or more potentially non-unique #' elements), or if \code{counts} is \code{TRUE} a set of counts of the unique #' elements of \eqn{X}. If \code{counts} is \code{FALSE} and \code{x} is not #' numeric, then x will be coerced into an integer vector internally. If #' \code{counts} is \code{TRUE} then \code{x} must be a vector of integers that #' are greater than, or equal to zero. #' @param counts if \code{counts} is TRUE, then this means x is the set of #' counts \eqn{n_1, n_2, \ldots, n_k} rather than the set itself #' @param useDouble if \code{useDouble} is TRUE then the computation will be #' done using double precision floating point arithmetic. This option was added #' because the internal code cannot handle integer overflow. The double #' precision code will may a result that is closer to the truth for large #' values, but this is not guaranteed. Ideally something like the GMP library #' should be used, but this is not a priority at this point in time. #' @return A single integer representing the multinomial coefficient for the #' given multiset, or given set of multiplicities. #' @author James M. Curran, Dave Barber #' @references \url{http://tamivox.org/dave/multinomial/code.html} #' @keywords combinations permutations multinomial #' @examples #' #' ## An example with a multiset X = (a,a,a,b,b,c) #' ## There are 3 a s, 2 b s and 1 c, so the answer should be #' ## (3+2+1)!/(3!2!1!) = 6!/3!2!1! = 60 #' x = rep(letters[1:3],3:1) #' multinom(x) #' #' ## in this example x is a vector of counts #' ## the answer should be the same as above as x = c(3,2,1) #' x = rep(letters[1:3],3:1) #' x = as.vector(table(x)) #coerce x into a vector of counts #' multinom(x, counts = TRUE) #' #' #' ## An example of integer overflow. x is a vector of counts #' ## c(12,11,8,8,6,5). The true answer from Maple is #' ## 11,324,718,121,789,252,764,532,876,767,840,000 #' ## The error in the integer based answer is obvious. #' ## The error using floating point is not, but from Maple is #' ## 0.705057123232160000e+10 #' ## Thanks to Lev Dashevskiy for calling my attention to this. #' \dontrun{x = c(12,11,8,8,6,5) #' multinom(x, counts = TRUE, useDouble = FALSE) #' multinom(x, counts = TRUE, useDouble = TRUE) #' } #' #' @export multinom multinom = function(x, counts = FALSE, useDouble = FALSE){ u = NULL if(!counts){ u = as.vector(table(x)) }else{ ## make sure x is a vector of counts is.wholenumber = function(x, tol = .Machine$double.eps^0.5){abs(x - round(x)) < tol} if(any(!is.wholenumber(x)) || any(x < 0)) stop("if counts == TRUE then all elements of x must be integer and >= 0") u = x } r = .Call('_multicool_multinomCoeff', PACKAGE = 'multicool', u, useDouble) return(r) } multicool/R/RcppExports.R0000644000176200001440000000103313572066733015107 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 generateCompositions <- function(n) { .Call('_multicool_generateCompositions', PACKAGE = 'multicool', n) } Stirling2C <- function(n, k) { .Call('_multicool_Stirling2C', PACKAGE = 'multicool', n, k) } BellC <- function(n) { .Call('_multicool_BellC', PACKAGE = 'multicool', n) } multinomCoeff <- function(x, useDouble) { .Call('_multicool_multinomCoeff', PACKAGE = 'multicool', x, useDouble) } multicool/R/nextPerm.R0000644000176200001440000000156213567356332014430 0ustar liggesusers#' Return the next permutation of the multiset #' #' This function returns the next permuation of the multiset if there is one. #' \code{initMC} called before \code{nextPerm} can be called. #' #' #' @param mcObj an S3 object of class \code{mc} which must be created with #' \code{initMC} #' @return either a vector with the next permutation of the multiset or #' \code{FALSE} when all permutations have been returned #' @author James M. Curran #' @seealso nextPerm #' @examples #' #' x = c(1,1,2,2) #' m1 = initMC(x) #' #' for(i in 1:6){ #' cat(paste(paste(nextPerm(m1),collapse=","),"\n")) #' } #' #' ## an example with letters #' x = letters[1:4] #' m2 = initMC(x) #' nextPerm(m2) #' nextPerm(m2) #' ## and so on #' #' @export nextPerm nextPerm = function(mcObj){ r = mcObj$mc$nextPerm() if(r$b){ return(mcObj$elements[r$set]) }else{ return(FALSE) } } multicool/MD50000644000176200001440000000204513572134411012573 0ustar liggesusers2e0d5bdf053ec547feedba56f6ece75a *DESCRIPTION d4a6a1457647b86a5b0dd75fd1853a05 *NAMESPACE bda644dfe9bb6059b1c40b98760c4623 *R/RcppExports.R fd46d527f579e2fdd2606dbd3cc16de7 *R/Stirling2.R c1a417b51d9ab4683a7b17c468892f66 *R/allPerm.R 08bdd04c625cb8b6b4cc0ea2f640a89e *R/genComp.R d8eb6e6a1af4da3e89aabd8cda4825e1 *R/initMC.r 20d7b05d665114defbb97525c23c9121 *R/multinom.R e876a9d70c279086059211de713736e5 *R/nextPerm.R ade00971c8e6c9298be57c3b2de8c428 *R/zzz.R 4c2f2ae1b1715f46b35dffa29d625ceb *README.md 0539ff92ac6b2f57b2d70f4025241395 *man/Bell.Rd 98ebe7145aff40da04ffb354ce7292a7 *man/Stirling2.Rd 831318e6df229d2fe361711c9eba500d *man/allPerm.Rd 918c3cb363a9492fe840c97b722add39 *man/genComp.Rd c3e9a1690a1e6b642417677464092174 *man/initMC.Rd 5083a8bbed7c1051cf8145433d02ae5f *man/multinom.Rd d661824f5de39bb3b15f74ba3a2b2936 *man/nextPerm.Rd 44db6016c21c085e3f6eacf55f55fb6d *src/RcppExports.cpp d41e58c5224d37bfd0488f11238baed6 *src/compositions.cpp ce241851b8ecdd636ffa3fe691422b22 *src/multicool.cpp 8e6ea24037e92ec9c30f699f4e3f9b8a *src/multinomial.h