Mathematica的Combinatorica`程序包使用笔记

目录

• 官方给出的程序包使用指南和一些示例
• 引论
• 步骤
  • • 0x00 导入程序包
    • 0x01 Integer Partitions
    • 0x02 Integer Compositions
    • 0x03 partitions of a set
      • sp的正传
        • 分成若干个小的分区
      • sp的番外
        • 分成若干个非空线性序列
        • 分成若干个圆排列
    • 0x04 Graph
    • 0x05 Permutations
• Logs
• 附录A 生成组合，排列，笛卡尔积等等

官方给出的程序包使用指南和一些示例

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, 3] + # & /@ Compositions[n - k, k](*正好3部分，和数都是正整数*)
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数

(*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互为逆运算*)

(*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映射*)

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矩阵*)

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*)

(*-----生成所有无牛牌型-----*)
(*生成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]