Bulgarian Solitaire

2011, Kenneth Levasseur
Mathematical Sciences
UMass Lowell
Kenneth_Levasseur@uml.edu

See http://en.wikipedia.org/wiki/Bulgarian_solitaire for a definition of Bulgarian Solitaire.

Bulgaria[pile_List]:=Sort[Select[Prepend[pile-1,Length[pile]],#>0&],#1>#2&]

BulgariaGraphLabeled[n_]:=Graph[Map[#->Bulgaria[#]&,IntegerPartitions[n]],VertexLabels->"Name",PlotRange->All,PlotRangePadding->1.5]

Alternate labeled graph suggested by Leonardo Tambellini:

BulgariaGraphLabeled[n_]:=Graph[Map[#->Bulgaria[#]&,IntegerPartitions[n]],VertexLabels->Map[#->Length[#]&,IntegerPartitions[n]],PlotRange->All,PlotRangePadding->1.5]

BulgariaGraph[n_]:=Graph[Map[#->Bulgaria[#]&,IntegerPartitions[n]],PlotRange->All,ImageSize->{450,300}]

Manipulate[BulgariaGraph[k],{{k,5},2,20,1}]

BulgariaGraphLabeled[5]

BulgariaGraphLabeled[11]//Show[#,ImageSize->{500,300}]&

BulgariaGraphLabeled[18]

BulgariaGraph[25]

BulgariaGraph[35]

BulgariaGraph[100]