# Tag Info

44

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, ...

34

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, since,...

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) = \frac{... 26 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 ... 26 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 ... 25 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 ... 23 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) { ... 22 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 22 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 System`Graph and you can ... 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. ... 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}} 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 ... 20 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, ... 18 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 I propose a more compact approach f[list__] := Join @@ ReplaceList[{list}, {x__, y__} :> Tuples@{f[x], f[y]}] f[x_] := {x}; f[a, b, c, d] // Column {a,{b,{c,d}}} {a,{{b,c},d}} {{a,b},{c,d}} {{a,{b,c}},d} {{{a,b},c},d} One can note that the length of this list is the Catalan number$$ C_n = \frac{1}{1+n}{2n\choose n}  Length[f @@ ConstantArray[...

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_] := Total[Boole[...

16

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. ...

16

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[#, "1"]...

16

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$ ...

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

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 ...

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, Length[res]/...

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 ...

14

Subsets function takes optional third argument with "standard sequence specification", described for example in details of Take function. Using this third argument you can take subsets "in chunks". For example, following code gives three 5-combinations from positions 90000 to 90002, from all 8 trillions 5-combinations of set of 1000 elements: Subsets[Range[...

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

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

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 elements....

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