Mathematica的Combinatorica`程序包使用笔记
目录
官方给出的程序包使用指南和一些示例
http://reference.wolfram.com/language/Combinatorica/tutorial/Combinatorica.html
引论
Mathematica的Combinatorica`是官方提供的用于处理组合数学问题的一个程序包。涉及到的主题包括但不限于：分拆，图论等等。
分拆可以看我的这篇文章
在线的Combinatorica`程序包文档可以看这个
在线的Combinatorica/guide/PartitionsAndCompositions可以看这个
步骤
这里使用Mathematica 12.0进行演示
0x00 导入程序包
Needs[ "Combinatorica`"]
如果报Warning了不管它，可以继续使用
之后可以?Combinatorica`*查看包里的内容及用法
下面混用程序包里的函数和mma12.0自带的函数进行演示
0x01 Integer Partitions
全部方案
Partitions[5](*全部方案*)
IntegerPartitions[5](*全部方案，和上面的几乎一样*)
和数被限制
Partitions[5, 3](*和数最大是3，逆字典序陈列出来*)
IntegerPartitions[10, All, {2, 3, 4}](*和数只能是2，3，4*)
和数数目被限制
IntegerPartitions[5, 3](*最多3部分*)
IntegerPartitions[5, {3}](*刚好3部分*)
IntegerPartitions[5, {2, 4}](*最少2部分，最多4部分*)
Flatten[Table[IntegerPartitions[10, {k}] , {k, {2, 4}}], 1] (*和数个数只能是2，4*)
由一种Partition方案绘制FerrersDiagram
FerrersDiagram[Partitions[10] [[18]]] (*参数换成 {5, 2, 1, 1, 1} 也行*)
FerrersDiagram的转置
FerrersDiagram@TransposePartition[Partitions[10][[18]]]
Ferrers图按照规则填上合适的数就成为了YoungTableau(这里的Tableau是转置过的，不知道怎么转过来)
TableForm[Tableaux[{3, 1}], TableAlignments -> {Right, Top}]
0x02 Integer Compositions
全部方案
IntegerCompositions[n_] :=
Flatten[Table[
ConstantArray[1, k] + # & /@ Compositions[n - k, k], {k, 1, n}],
1] (*全部方案，基于对和数可为0的Composition改造得到*)
IntegerCompositions[n_] :=
Flatten[Table[Permutations[Partitions[n][[k]]], {k, 1, len}],
1] /. {len -> Length@Partitions[n]}
(*全部方案，由Partition的排列生成*)
和数受限制
len = Length@Partitions[5, 3];
Flatten[ Table[Permutations[Partitions[5, 3][[k]]], {k, 1, len}] , 1]
(*和数最大是3*)
len = Length@IntegerPartitions[10, All, {2, 3, 4}];
Flatten[Table[
Permutations[IntegerPartitions[10, All, {2, 3, 4}][[k]]], {k, 1,
len}], 1]
(*和数只能是2，3，4*)
和数数目受限制
IntegerCompositions[n_, k_] :=
( ConstantArray[1, k] + # ) & /@ Compositions[n - k, k] (*正好k部分，和数都是正整数*)
NumberOfCompositions[10, 3](*正好3部分的方案数目*)
Length@Compositions[10, 3](*正好3部分的方案数目，和上面几乎一样*)
Flatten[Table[Compositions[10, k], {k, 1, 5}], 1] (*最多5部分的全部方案，这个我没找到现成的函数*)
Flatten[Table[Compositions[10, k], {k, {2, 3, 5}}], 1] (*和数个数只能是2,3,5的全部方案，这个我没找到现成的函数*)
和数数目受限制而且和数大小受限制
(*n的k个和数且和数在[1,r]的Compostition的方案个数*)
nCompokSummandsEachRange1r[n_, k_, r_] :=
Module[{sum = 0}, If[r <= 0 || k <= 0, 0,
Sum[(-1)^j*Binomial[k, j]*Binomial[n - r*j - 1, k - 1], {j, 0,
Min[k, Floor[(n - k)/r]]}]
]
]
0x03 partitions of a set
sp的正传
分成若干个小的分区
准确的说，是partitions of a set of n distinguishable elements
中文的话？集合分拆？
虽然但是，我真的很想写这个，
会涉及到第二类斯特林数，Bell数，乃至Bell多项式。最兴奋的是通过设置Bell Polynomial的参数就可以得到第一类第二类第三类斯特林数，可以看这个词条。
(*set partition*)
SetPartitions[{a, b, c}] (*无限制*)
RGFToSetPartition[#] & /@ RGFs[5] (*基于RGF生成，和上面给出的结果一致，顺序可能不同*)
SetPartitionListViaRGF[5] （*和上面的完全一样，又封装了一遍*）
KSetPartitions[3, 2] (*表示{1,2,3}集合分拆，限定为2部分*)
KSetPartitions[{a,b,c}, 2] (*限定为2部分*)
数学一点的话，当然要谈到RGF和SetPartitions的bijection
图片来自这篇论文 https://arxiv.org/pdf/1605.04807.pdf
或者你看东田纳西州立大学的这个slide
映射关系如下,这是一个bijection
(*RGF相关*)
RGFs[5] (*给出所有长度为5的RGF序列*)，
SetPartitionToRGF[#] & /@ SetPartitions[5] (*基于sp生成，和上面给出的结果一致，顺序可能不同*)
RandomRGF[5] (*相当于从上面的结果里随机选一个*)
RGFToSetPartition[{1, 2, 1, 2, 1}, {a, b, c, d, e}] (*RGF到SetPartition的映射*)
RGFToSetPartition[{1, 2, 1, 2, 1}] (*第二个参数缺省的话会进行联想[n]*)
RGFToSetPartition[{1, 2, 1, 2, 1},{a,b}] (*非法输入不会计算结果*)
(*有rank的函数基本上不用看了，你会写[[]]的话*)
RankSetPartition[#] & /@ SetPartitions[4] (*这个结果是Range[0, 14]*)
sp也可以理解成一个SYT吗？
SYT的定义看这里
sp的番外
给自己挖坑，有空会来填的
分成若干个非空线性序列
无符号拉赫数（也是无符号第三类斯特林数）计算的是将含有\(n\)个元素的集合拆分为\(k\)个非空线性有序子集的方法数目。
SetPartitions[3]
Table[Map[Permutations, %6[[i]]] // Tuples, {i, 1, Length@%6}] // MatrixForm
(*或者这么写？*)
SetPartitionsToSequences[n_]:=Table[Map[Permutations, SetPartitions[n][[i]]] // Tuples, {i, 1, BellB[n]}] // MatrixForm
分成若干个圆排列
这个我也不知道该分到哪一类去，，，和SetPartition和Permutation都有点关系
无符号第一类斯特林数计算的是将含有\(n\)个元素的集合拆分为\(k\)个非空圆排列的方法数目。
ToCycles[#] & /@ Permutations[5] // MatrixForm (*基于Permutation圆分解生成全部方案*)
Select[ToCycles[#] & /@ Permutations[5], Length[#] == 2 &] （*S1(5,2)的全部方案*）
0x04 Graph
这个坑开了就写不完的啊，我拒绝记录
ShowGraph /@ % (*当你生成了List<Graph>的东西，想要可视化*)
0x05 Permutations
可以看我的排列研究系列文章
这个感觉也写不完
ToCycles[{2, 1, 3}] （*对一个排列做圆分解*）
FromCycles@% (*由圆分解得到一个排列*)
ToInversionVector[{5, 2, 3, 4, 1}]
## 结果是{4, 1, 1, 1}，表明有1左侧有4个数比1大，4左侧有有1个数比4大...
InversePermutation[{2, 3, 1, 4}] (*对Permutation做Inverse(圆分解后每个圆反转)*)
Involutions[5] （*Involution是说inverse(圆分解后每个圆反转)和自己相同的那些Permutation*）
Logs
upd 2021-03-30 完成初稿
upd 2021-04-03 以后求Composition或者Partition的全部解还是FrobeniusSolve 吧，人生苦短
note 2021-04-08 发现Combinatorica包的Compositions[n, k]函数会把和数为0的情况给了出来，于是选择了其他方法来实现无限制的Compostions
note 2021-06-26 发现有些东西比如生成组合，生成排列，生成笛卡尔积经常用到，我放在最后了
note 2021-11-08
吐个槽，mma重复造轮子是出了名的
另一个有意思的点是，你可以试着输入NumberOf，看会联想出来哪些东西
upd 2021-11-08 想写的东西过多，甚至题目改成了 Mathematica的Combinatorica`程序包使用笔记
附录A 生成组合，排列，笛卡尔积等等
FoldList[Plus, 0, {a, b, c, d}] (*前缀和*)
Total[MapIndexed[#1 x^First[#2] &, {a, b, c, d, e}]] (*系数列表转多项式*)
MapIndexed[Labeled, {x^2, x + y, y^2, y^3}] (*相当于zipWithIndex*)
z^3/(1 - z^2) // Apart (*Apart把一个有理表达式改写成具有最小分母的项的和. *)
z^3/(1 - z^2) // Apart // Together (*Together将各项合并公分母，并消去结果中的因子.Together和Apart互为逆运算*)
Cases[expr, _Symbol, Infinity] // Union 获得expr里的全部变量和常数
(*Horner多项式形式*)
Fold[x #1 + #2 &, 0, {a, b, c, d, e}] (*创建一个嵌套的Horner多项式形式*)
HornerForm[Reverse[{a, b, c, d, e}].x^Range[0, 4], x]
Fold[1/(#2 + #1) &, x, Reverse[{a, b, c, d}]] (*形成连分式*)
(*数码列表转10进制数*)
StringJoin[ToString@# & /@ {1, 2, 3, 4}] // ToExpression
Fold[10 #1 + #2 &, 0, {4, 5, 1, 6, 7, 8}]
Fold[#2 - #1 &, 0, Reverse[{a, b, c, d, e}]] (*形成一个交错总和*)
Fold[#2[#1] &, x, {a, b, c, d}] (*对x做a映射后，结果做b映射，结果做c映射，结果做d映射*)
Range[10] // Count[_?PrimeQ] //AbsoluteTiming (*相当于PrimePi[10]*)
PermutationProduct[I] (*你们要的恒等函数*)
Map[#^2 &, {1, 2, 3}] （*Map操作几乎必会好吧*）
{0, 1, 2, 3} // Map[#^2 + 1 &, #] &
func[x_] := If[ListQ[x], x, "a" <> ToString[x] <> "b"];Map[func[#] &, {{1, fa}, {1, fa, "cd"}, 1, "fs"}]
（*Map操作几乎必会好吧*）
Table[RotateLeft[{2, 3, 4, 5}, -n], {n, 0, 3}] (*生成一个List的Rotate变换后的序列*)
Subsets[{1, 2, 2}] (*生成幂集*)
Permutations[{a, b, c, d}, {2}](*生成排列*)
Select[Permutations[{a, b, c, d}], Signature[#] == 1 &] (*生成逆序对数为偶的所有排列，4!/2=12个*)
Flatten[Outer[List, {a, b}, {x, y, z}, {1, 2, 3}], 2](*生成全部笛卡尔积*)
Tuples[{{a, b}, {1, 2, 3, 4}, {x}}] (*生成全部笛卡尔积*)
Tuples[{0, 1}, 3] (*生成全部的01三元组*)
Subsets[{a, a, b, b}, {2}](*生成大小为2的全部子集，共6个*)
Subsets[{a, a, b, b}, {2}] // Union (*生成本质不同(规则是放在置换群下是否相同)的子集，共3个。i.e.可重复元素的组合*)
Boole[Outer[Greater, {1, 2, 3, 4, 5}, {1, 2, 3, 4, 5}]] // MatrixForm (*生成5\times 5的下三角矩阵*)
MatrixForm[m = Array[Subscript[a, ##] &, {3, 3}]] (*优雅地写一个形式3*3矩阵*)
jordanMatrix[\[Lambda]_, n_] := DiagonalMatrix[Table[\[Lambda], {n}]] + DiagonalMatrix[Table[1, {n - 1}], 1](*优雅地写一个Jordan矩阵*)
(* 得到所有cyclic-permutations *)
rotateToMinFirst[list_List] :=
RotateLeft[list, Position[list, Min[list]][[1, 1]] - 1]
cyclicPermutations[list_List] :=
Union[rotateToMinFirst /@ Permutations[list]];
Join @@ Table[#*n & /@ ConstantArray[1, 4], {n, 1, 13}]（*生成52张牌的deck，无花色*）
Flatten[Outer[List, {"spade", "heart", "diamond", "club"}, Range[1, 10]], 1] (*生成40张牌的deck，有花色*)
Select[Subsets[Range[1, 10], {3}], Mod[Total[#], 10] == 0 &] (*1~10里选3张牌和的个位是0的本质不同的全部组合方案*)
Sort[{{a, 2}, {c, 1}, {d, 3}}, #1[[2]] < #2[[2]] &] (*比较每个元素的第二部分，以进行排序*)
ReverseSort[{{a, 2}, {c, 1}, {d, 3}}, #1[[2]] < #2[[2]] &] (*逆向排序的一种思路是直接改函数名为ReverseSort*)
Cases[{{3, 2, 1}, {1, 2, 5}, {3, 1, 2}}, {OrderlessPatternSequence[1, 2, 3]}] (*选出在置换群意义下和123相同的list*)
生成幂集
s={1,2,3}
Column@Subsets@s
按照各个单项式中x的阶降序，排列多项式的项 https://mathematica.stackexchange.com/questions/37339/how-can-i-sort-the-polynomial-by-the-degree-of-x
OrderedForm[x_] := HoldForm[+##] & @@ (x^#1[[1]] #2 & @@@ CoefficientRules[#, x]) &;
f1 // OrderedForm[x]
(*-----生成所有无牛牌型-----*)
(*生成40张牌的deck，无花色*)
set = Join @@
Table[#*n & /@ ConstantArray[1, 4], {n, 1, 10}]
(*所有5张牌的牌型*)
subset = Subsets[set, {5}]
(*3张牌和的个位是0的本质不同的全部组合方案*)
cow = Select[Subsets[set, {3}], Mod[Total[#], 10] == 0 &] //
Union
(*有牛牌型的Pattern*)
invalidPattern = {Alternatives @@
Apply[PatternSequence[___, #1, ___, #2, ___, #3, ___] &, cow, {1}]}
(*从全部方案中去除掉有牛的方案，剩下的就是无牛的*)
DeleteCases[subset, invalidPattern]
