# Tag Info

## Hot answers tagged combinatorics

41

Preamble and motivation While I am much late to the party here, I hope this answer will not be totally useless. This is a first in a series of posts where I will advocate a wider use of Java in our workflow, and present/describe certain toolset to reduce the mental overhead of this. So, my motivation here is not to provide a faster or more elegant solution, ...

29

The answer of @R.M. already explains the essence of the problem. You can streamline the process of removing the Combinatorica from the $ContextPath by loading it via Block[{$ContextPath}, Needs["Combinatorica"]] (or use Get intead of Needs, although Needs is a preferred way to load a package). In this way, you don't have to do anything afterwards, ...

29

Letting $j_k = i_{k+1}-i_k-1$ and writing $$Q(n) = P(n) - P(n-1) = C\sum_{0 \le j_1, j_2, \cdots, j_{51}\vert j_1+\cdots+j_{51}=n-52} \prod_{k=1}^{51}\left(\frac{k}{52}\right)^{j_k}\,,$$ with $C$ a constant, exhibits the $P(n)$ as cumulative sums of the $Q(n)$ and shows that $Q(n)$ is the coefficient of $x^{n-52}$ in the formal power series $$q(x) = ... 25 Mathematica supports two related functions, LongestCommonSequence[] and LongestCommonSubsequence[]. The first one finds the longest (contiguous or non-contiguous) sequence common to the two strings given as arguments to it: LongestCommonSequence["AAABBBBCCCCC", "CCCBBBAAABABA"] "AAABB" while the second function is constrained to give the longest ... 23 Here is an alternative version of Mr. Wizard's uniqueTuples function, which is faster on the data I have tested. The idea is to create a function f which has the following properties: It returns an empty Sequence[] if two of its arguments are the same For any other input it outputs a List of the arguments, but also sets a downvalue so that next time it is ... 22 A very simple and straightforward test for square-freeness (and should be reasonably fast) is: squareFreeQ[str_] := StringFreeQ[str, x__ ~~ x__] Testing on your inputs: squareFreeQ["0101"] (* False*) squareFreeQ["0102012021"] (* True *) You can then possibly restrict this further to operate only on certain alphabets using Repeated and Alternatives. ... 22 Chunks of weak compositions Here is slightly modified version of algorithm used in CombinatoricaNextComposition converted to a LibraryFunction. Needs["CCompilerDriver"] " #include \"WolframLibrary.h\" DLLEXPORT mint WolframLibrary_getVersion() { return WolframLibraryVersion; } DLLEXPORT int WolframLibrary_initialize(WolframLibraryData libData) { ... 21 Try with partitions[list_, l_] := Join @@ Table[ {x, ##} & @@@ partitions[list ~Complement~ x, l], {x, Subsets[list, {l}, Binomial[Length[list] - 1, l - 1]]} ] partitions[list_, l_] /; Length[list] === l := {{list}} The list must have a length multiple of l 21 Here is one way: ClearAll[f]; f[tree_List] := Flatten[f[{}, tree], 1]; f[accum_List, {x_, y_List}] := f[{accum, x}, #] & /@ y; f[x_, y_] := Flatten[{x, y}]; The usage is f[B] 21 Let's replace 52 with d. Then we are seeking to compute$$ p_d(n) = \frac{(d-1)!}{d^{d-1}} \sum_{1 = i_1 < i_2 < \cdots < i_{d-1} < i_{d} \leqslant n} \left[ \prod_{k=1}^{d-1} \left( \frac{k}{d} \right)^{i_{k+1}-i_k-1} \right] \tag{1}  The set $\{i_2, \ldots,i_d\}$ is a length $d-1$ subset of natural consecutive numbers from 2 to $n$. The ...

21

The solution is straightforward: Subsets, specifically Subsets[{1,2,3}, {2}] gives {{1, 2}, {1, 3}, {2, 3}} To generate the lower indices, just Reverse them Reverse /@ Subsets[{1,2,3}, {2}] which gives {{2, 1}, {3, 1}, {3, 2}}

19

In a sense described below, this answer finds $422716$ distinct solutions. The innovations presented here are using postfix operators to eliminate problems with parentheses; avoiding having to deal with unary negation; initially computing "too many" solutions, some of which make no sense, and eliminating them at the end (rather than writing more ...

19

Shadowing occurs only when there are two functions with the same name that are in $ContextPath. So right after you do <<Combinatorica, do the following:$ContextPath = Rest@$ContextPath; What this does is that it removes Combinatorica (which is the package you just loaded). Now the only Graph function that's on the path is SystemGraph and you can ... 17 Copying my clock post? Impossible! Anyway, Chapter one: using brute force. Before you complain: I'm a physicist, this is how we do mathematics: by experiment. Ha! We need cards! Inconveniently, Mathematica currently lacks built-in support for Kings. We therefore have to use a workaround: let's call the named cards by their numbers. A is 1, J is 11 etc. ... 17 Also, using pattern matching,just in case: {{a, b, c, d, e, f, g}, {x, a, r, b, c, j}} /. {{___, Longest[y__], ___}, {___, y__, ___}} -> {y} (* -> {b, c} *) Edit With this approach you can do one thing that seems not trivial by using the faster LongestCommonSequence[] function: finding the maximal common subsequence among several lists: {{1, 2, 3, ... 17 Here is a summary of comments (before @ciao's best answer above), with a change in notation. These functions calculate the number of partitions of n into exactly k distinct parts of size at most m. NumberOfWays000[n_, k_, m_] := Count[Map[Length,Map[DeleteDuplicates, IntegerPartitions[n,{k},Range[m]]]], k] NumberOfWays001[n_, k_, m_] := ... 16 This seems pretty quick, particularly on larger cases / larger k, e.g. 451, 29, 101 finishes in a few seconds on the loungebook. N.B. - I have not tested this exhaustively, just thrown together from ideas... If[Min[#3, #1 - Tr@Range@(#2 - 1)] < 0, 0, SeriesCoefficient[QPochhammer[-x y, x, Min[#3, #1 - Tr@Range@(#2 - 1)]], {x , ... 15 The following seems fast and less memory bound, because it's based on SatisfiabilityCount[], a wonderful function to count boolean valued functions with boolean arguments: count[l : {_String ..}] := Module[{x, sp}, sp[s_String, sub_String] := StringPosition[s, sub][[All, 1]]; SatisfiabilityCount[ And @@ Not /@ (And @@@ (x /@ sp[#, ... 15 Here is a totally different approach based on the fact that successive products forming the generating function are due to multiplication by a binomial$1+t*z^j$. Form a matrix$v$of zeros with$n+1$rows and$k+1$columns. Initialize the top left corner to 1. Iterate$v=v+w$where$w$is the matrix$v$shifted down by$j$rows and to the right by 1. The ... 14 Showing humongous data by screen-fulls can be done using Manipulateas follows: (* generate some data to show *) res = Tuples[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, 7]; (* size of the data*) ByteCount[res] (* ==> 1003290792 *) screenNumbers = 100; Manipulate[ Take[res, {i screenNumbers + 1, (i + 1) screenNumbers}], {i, 0, ... 14 These things I have coded up before Mathematica 7 and the introduction of the built in function LongestCommonSubsequence. The built-in version is of course faster, though still this implementation might be of interest as it has a bit wider functionality. Also, with some fine-tuning and compilation the performance can be surely increased. ... 14 I don't think there is a carpet graph built-in, but it's hard to be sure that something is not there. Still it's not hard to construct a Graph -- not quite the same thing as drawing it (I wasn't sure what you meant). There are probably more efficient ways, but adapting Mr.Wizard's carpet function, it is fairly straightforward to make an edge between ... 13 Take all subsets of length 10, then for each one find all splits into two sets of five such that the first of the ten is in the first part of the split. In[29]:= Timing[ msets = Subsets[Range[12], {10}]; m2 = Flatten[ Map[With[{fst = First[#], subs = Subsets[Rest[#], {4}], mset = #}, With[{s2 = Map[Join[{fst}, #] &, subs]}, Map[{#, ... 13 Ok, I'll stick to "making MMA do the thinking" The list of all the possibile hands a player can have playerPossibilities = Tuples[Range[13], {2}]; The list of all the triplets of hands the 3 players could have been handed allPossibilities = Tuples[playerPossibilities, {3}]; A function that returns True if a1 won a1winsQ[{h1 : {_, _}, h2_, h3_}] := # ... 13 The Combinatorica package is now considered obsolete and not compatible with Mathematica's built-in Graph theory functionality. The function CycleGraph, which you are using, is a built-in function and is not understood by the Combinatorica package. You have to replace CycleGraph[i] simply by Cycle[i], which is the corresponding object in Combinatorica. You ... 13 EDIT: As @Rojo points out in the comments, my code doesn't really find all solutions. For example, a term of the form a * (b * c + d) can't be represented with "precedence plus/minus" operators. I'm not sure if it is salvageable, but as it is, the code below does not find all solutions. A very simple solution would be to define two new operators$\oplus\$ ...

13

Just for the sake of functional programming here is a solution which is neither in speed nor memory comparable to Subsets but which only uses basic list operations and pattern matching: makePairs[{e_, es__}] := Join[{e, #} & /@ {es}, makePairs[{es}]]; makePairs[{e_}] := {}; It grabs the first element of the list and makes pairs with the other ...

12

Edit 2015 While I found Simon Woods's code informative to the degree that I awarded it a bounty it seems that the only reason it performed better than mine was that DeleteDuplicates was slow. Fred Simons pointed out that my (original) code is no longer slow, and actually outperforms Simon Woods' function. Experimentation showed that using Union in version ...

12

Combinatorica has the function NextPermutation which allows you to iterate over the permutations. There may be ways of generating a smaller subset if you have more information about what you are looking for.

Only top voted, non community-wiki answers of a minimum length are eligible