More tests

Author: rocky

mathics/packages/DiscreteMath/CombinatoricaLite.m

@@ -333,9 +333,35 @@
 
 
 (****************************************************************************
-*** Combinatorica 0.6 versions until we support more modern WL features *****
+*** Combinatorica 0.9 versions until we support more modern WL features *****
 *****************************************************************************)
 
+Backtrack::usage = "Backtrack[s,partialQ,solutionQ] performs a backtrack search of the state space s, expanding a partial solution so long as partialQ is True and returning the first complete solution, as identified by solutionQ."
+
+Backtrack[space_List,partialQ_,solutionQ_,flag_:One] :=
+	Module[{n=Length[space],all={},done,index,v=2,solution},
+		index=Prepend[ Table[0,{n-1}],1];
+		While[v > 0,
+			done = False;
+			While[!done && (index[[v]] < Length[space[[v]]]),
+				index[[v]]++;
+				done = Apply[partialQ,{Solution[space,index,v]}];
+			];
+			If [done, v++, index[[v--]]=0 ];
+			If [v > n,
+				solution = Solution[space,index,n];
+				If [Apply[solutionQ,{solution}],
+					If [SameQ[flag,All],
+						AppendTo[all,solution],
+						all = solution; v=0
+					]
+				];
+				v--
+			]
+		];
+		all
+	]
+
 (* Note: Until we support With[], this is the Combinatorica 0.6  version of BinarySearch *)
 BinarySearch::usage = "BinarySearch[l,k,f] searches sorted list l for key k and returns the the position of l containing k, with f a function which extracts the key from an element of l."
 BinarySearch[l_List,k_Integer] := BinarySearch[l,k,1,Length[l],Identity]
@@ -351,6 +377,24 @@
 		]
 	]
 
+DistinctPermutations::usage = "DistinctPermutations[l] returns all permutations of the multiset described by list l."
+
+DistinctPermutations[s_List] :=
+	Module[{freq,alph=Union[s],n=Length[s]},
+		freq = Map[ (Count[s,#])&, alph];
+		Map[
+			(alph[[#]])&,
+			Backtrack[
+				Table[Range[Length[alph]],{n}],
+				(Count[#,Last[#]] <= freq[[Last[#]]])&,
+				(Count[#,Last[#]] <= freq[[Last[#]]])&,
+				All
+			]
+		]
+	]
+
+
+
 KSubsets::usage = "KSubsets[l, k] gives all subsets of set l containing exactly k elements, ordered lexicographically."
 KSubsets[l_List,0] := { {} }
 KSubsets[l_List,1] := Partition[l,1]
@@ -397,6 +441,10 @@
 	]
 RandomPermutation[n_Integer?Positive] := RandomPermutation1[n]
 
+Solution[space_List,index_List,count_Integer] :=
+	Module[{i}, Table[space[[ i,index[[i]] ]], {i,count}] ]
+
+
 (* Tableaux stuff not working. Hitting recursion limit....
 TransposeTableau::usage = "TransposeTableau[t] reflects a Young tableau t along the main diagonal, creating a different tableau."
 TransposeTableau[tb_List] :=

test/test_combinatorica.py

@@ -15,8 +15,13 @@ def test_combinatorica():
      """
     )
 
+    # A number of examples from Implementing Discrete Mathematics by
+    # Steven Skiena and
     # A number of examples from Computation Discrete Mathematics by
-    # Sriram Pemmaraju and Steven Skiena
+    # Sriram Pemmaraju and Steven Skiena.
+
+    # Page numbers below come from the first book
+
 
     # Permutation[3] doesn't work
     permutations3 = (
@@ -48,7 +53,7 @@ def test_combinatorica():
             "{c, b, d, a}, {c, d, a, b}, {c, d, b, a}, "
             "{d, a, b, c}, {d, a, c, b}, {d, b, a, c}, "
             "{d, b, c, a}, {d, c, a, b}, {d, c, b, a}}",
-            "LexicographicPermuations"
+            "LexicographicPermuations, Page 4"
         ),
 
         ("Map[RankPermutation, Permutations[Range[4]]]",
@@ -58,11 +63,11 @@ def test_combinatorica():
 
         ("RandomPermutation1[20] === RandomPermutation2[20]",
          "False",
-         "Not likey two of 20! permutations will be the same (different routines)"
+         "Not likey two of 20! permutations will be the same (different routines), Page 7"
          ),
         ("RandomPermutation1[20] === RandomPermutation1[20]",
          "False",
-         "Not likey two of 20! permutations will be the same (same routine)"
+         "Not likley two of 20! permutations will be the same (same routine)"
          ),
         ("RankPermutation[{8, 9, 7, 1, 6, 4, 5, 3, 2}]", "321953", "RankPermutation"),
         (
@@ -73,7 +78,24 @@ def test_combinatorica():
         (
             "MinimumChangePermutations[{a,b,c}]",
             "{{a, b, c}, {b, a, c}, {c, a, b}, {a, c, b}, {b, c, a}, {c, b, a}}",
-            "MinimumChangePermuations",
+            "MinimumChangePermuations, Page 11",
+        ),
+        (
+            "Union[Permutations[{a,a,a,a,a}]]",
+            "{{a, a, a, a, a}}",
+            "simple but wasteful Permutation duplication elimination, Page 12"
+        ),
+        (
+            "DistinctPermutations[{1,1,2,2}]",
+            "{{1, 1, 2, 2}, {1, 2, 1, 2}, {1, 2, 2, 1}, "
+            "{2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 1}}",
+            "DisctinctPermutations of multiset Binomial[6,3] permutations, Page 14"
+        ),
+        (
+            "Multinomial[3,3]",
+            "20",
+
+            "The built-in function Multinomial, Page 14"
         ),
         (
             "Subsets[Range[3]]",