From 82393366d263dfb031b56266e001d4bd9794ce6f Mon Sep 17 00:00:00 2001 From: rocky Date: Tue, 15 Dec 2020 09:49:32 -0500 Subject: [PATCH 1/5] Use V0.9 in testing. It seems more complete --- .../packages/DiscreteMath/CombinatoricaLite.m | 2 ++ .../packages/DiscreteMath/CombinatoricaV0.9.m | 36 +++++++++++++++++++ test/test_combinatorica.py | 22 ++++++++---- 3 files changed, 54 insertions(+), 6 deletions(-) diff --git a/mathics/packages/DiscreteMath/CombinatoricaLite.m b/mathics/packages/DiscreteMath/CombinatoricaLite.m index 6dc3afcf79..f12006ea7e 100644 --- a/mathics/packages/DiscreteMath/CombinatoricaLite.m +++ b/mathics/packages/DiscreteMath/CombinatoricaLite.m @@ -284,6 +284,8 @@ ] *) +SetPartitions::usage = "SetPartitions[set] returns the list of set partitions of set. SetPartitions[n] returns the list of set partitions of {1, 2, ..., n}. If all set partitions with a fixed number of subsets are needed use KSetPartitions." + SetPartitions[{}] := {{}} SetPartitions[s_List] := Flatten[Table[KSetPartitions[s, i], {i, Length[s]}], 1] diff --git a/mathics/packages/DiscreteMath/CombinatoricaV0.9.m b/mathics/packages/DiscreteMath/CombinatoricaV0.9.m index ceb22ea627..15b03e37a5 100644 --- a/mathics/packages/DiscreteMath/CombinatoricaV0.9.m +++ b/mathics/packages/DiscreteMath/CombinatoricaV0.9.m @@ -595,6 +595,7 @@ PermutationQ[p_List] := (Sort[p] == Range[Length[p]]) Permute[l_List,p_?PermutationQ] := l [[ p ]] +Permute[l_List,p_List] := Map[ (Permute[l,#])&, p] /; (Apply[And, Map[PermutationQ, p]]) LexicographicPermutations[{l_}] := {{l}} @@ -1000,8 +1001,11 @@ Join[ prev, Map[(Append[#,First[l]])&,Reverse[prev]] ] ] +(* We have a builtin that does this. +GrayCode doesn't work? Subsets[l_List] := GrayCode[l] Subsets[n_Integer] := GrayCode[Range[n]] +*) LexicographicSubsets[l_List] := LexicographicSubsets[l,{{}}] @@ -3131,6 +3135,38 @@ (aj < Max[b]) ] +KSetPartitions::usage = "KSetPartitions[set, k] returns the list of set partitions of set with k blocks. KSetPartitions[n, k] returns the list of set partitions of {1, 2, ..., n} with k blocks. If all set partitions of a set are needed, use the function SetPartitions." +KSetPartitions[{}, 0] := {{}} +KSetPartitions[s_List, 0] := {} +KSetPartitions[s_List, k_Integer] := {} /; (k > Length[s]) +KSetPartitions[s_List, k_Integer] := {Map[{#} &, s]} /; (k === Length[s]) +KSetPartitions[s_List, k_Integer] := + Block[{$RecursionLimit = Infinity}, + Join[Map[Prepend[#, {First[s]}] &, KSetPartitions[Rest[s], k - 1]], + Flatten[ + Map[Table[Prepend[Delete[#, j], Prepend[#[[j]], s[[1]]]], + {j, Length[#]} + ]&, + KSetPartitions[Rest[s], k] + ], 1 + ] + ] + ] /; (k > 0) && (k < Length[s]) + +KSetPartitions[0, 0] := {{}} +KSetPartitions[0, k_Integer?Positive] := {} +KSetPartitions[n_Integer?Positive, 0] := {} +KSetPartitions[n_Integer?Positive, k_Integer?Positive] := KSetPartitions[Range[n], k] + +SetPartitions::usage = "SetPartitions[set] returns the list of set partitions of set. SetPartitions[n] returns the list of set partitions of {1, 2, ..., n}. If all set partitions with a fixed number of subsets are needed use KSetPartitions." + +SetPartitions[{}] := {{}} +SetPartitions[s_List] := Flatten[Table[KSetPartitions[s, i], {i, Length[s]}], 1] + +SetPartitions[0] := {{}} +SetPartitions[n_Integer?Positive] := SetPartitions[Range[n]] + + End[] Protect[ diff --git a/test/test_combinatorica.py b/test/test_combinatorica.py index adb74bec9f..a35a3239e2 100644 --- a/test/test_combinatorica.py +++ b/test/test_combinatorica.py @@ -11,7 +11,7 @@ def test_combinatorica(): session.evaluate( """ - Needs["DiscreteMath`CombinatoricaLite`"] + Needs["DiscreteMath`CombinatoricaV0.9`"] """ ) @@ -168,6 +168,16 @@ def test_combinatorica(): "{5, 4, 6, 1, 3, 8, 7, 2}", "InversePermutation: 7 is fixed point. Page 18", ), + ( + "star = Automorphisms[Star[5]]", + "{{1, 2, 3, 4, 5}, {1, 2, 4, 3, 5}, {1, 3, 2, 4, 5}, {1, 3, 4, 2, 5}, " + "{1, 4, 2, 3, 5}, {1, 4, 3, 2, 5}, {2, 1, 3, 4, 5}, {2, 1, 4, 3, 5}, " + "{2, 3, 1, 4, 5}, {2, 3, 4, 1, 5}, {2, 4, 1, 3, 5}, {2, 4, 3, 1, 5}, " + "{3, 1, 2, 4, 5}, {3, 1, 4, 2, 5}, {3, 2, 1, 4, 5}, {3, 2, 4, 1, 5}, " + "{3, 4, 1, 2, 5}, {3, 4, 2, 1, 5}, {4, 1, 2, 3, 5}, {4, 1, 3, 2, 5}, " + "{4, 2, 1, 3, 5}, {4, 2, 3, 1, 5}, {4, 3, 1, 2, 5}, {4, 3, 2, 1, 5}}", + "Automorphisms, Page 19" + ), ( "KSubsets[Range[5], 3]", "{{1, 2, 3}, {1, 2, 4}, {1, 2, 5}, {1, 3, 4}, {1, 3, 5}, {1, 4, 5}, " @@ -182,11 +192,11 @@ def test_combinatorica(): "{4, 0, 1}, {4, 1, 0}, {5, 0, 0}}", "Compositions", ), - ( - "SetPartitions[3]", - "{{{1, 2, 3}}, {{1}, {2, 3}}, {{1, 2}, {3}}, {{1, 3}, {2}}, {{1}, {2}, {3}}}", - "SetPartitions" - ), + # ( + # "SetPartitions[3]", + # "{{{1, 2, 3}}, {{1}, {2, 3}}, {{1, 2}, {3}}, {{1, 3}, {2}}, {{1}, {2}, {3}}}", + # "SetPartitions" + # ), ( "TransposePartition[{8, 6, 4, 4, 3, 1}]", "{6, 5, 5, 4, 2, 2, 1, 1}", From 4445408e0128578516cc8173b05ffe98c50e696e Mon Sep 17 00:00:00 2001 From: rocky Date: Tue, 15 Dec 2020 15:55:40 -0500 Subject: [PATCH 2/5] More tests --- test/test_combinatorica.py | 214 +++++++++++++++++++++---------------- 1 file changed, 120 insertions(+), 94 deletions(-) diff --git a/test/test_combinatorica.py b/test/test_combinatorica.py index a35a3239e2..18c93f7567 100644 --- a/test/test_combinatorica.py +++ b/test/test_combinatorica.py @@ -7,41 +7,32 @@ from mathics.core.evaluation import Evaluation import pytest - -def test_combinatorica(): - session.evaluate( - """ - Needs["DiscreteMath`CombinatoricaV0.9`"] +session.evaluate( + """ +Needs["DiscreteMath`CombinatoricaV0.9`"] """ - ) +) - # 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. +# 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. - # Page numbers below come from the first book +# Page numbers below come from the first book - # Permutation[3] doesn't work - permutations3 = ( - r"{{1, 2, 3}, {1, 3, 2}, {2, 1, 3}, {2, 3, 1}, {3, 1, 2}, {3, 2, 1}}" - ) +def test_combinatorica_permutations_1_1(): + for str_expr, str_expected, message in ( ( "Permute[{a, b, c, d}, Range[4]]", "{a, b, c, d}", - "Permute list with simple list", + "Permute list with simple list; 1.1 Page 3", ), ( "Permute[{a, b, c, d}, {1,2,2,4}]", "Permute[{a, b, c, d}, {1,2,2,4}]", - "Incorrect permute: index 2 duplicated", - ), - ( - "Permute[{A, B, C, D}, %s]" % permutations3, - "{{A, B, C}, {A, C, B}, {B, A, C}, {B, C, A}, {C, A, B}, {C, B, A}}", - "Permute", + "Incorrect permute: index 2 duplicated; 1.1 Page 3", ), ( "LexicographicPermutations[{a,b,c,d}]", @@ -53,74 +44,143 @@ 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, Page 4" + "LexicographicPermuations, 1.1.1 Page 4", + ), + # NthPermutation does not work + ( + "Map[RankPermutation, Permutations[Range[4]]]", + "Range[0, 23]", + "Permutations uses lexographic order; 1.1.2, Page 6", ), - - ("Map[RankPermutation, Permutations[Range[4]]]", - "Range[0, 23]", - "Permutations uses lexographic order" - ), - - ("RandomPermutation1[20] === RandomPermutation2[20]", - "False", - "Not likey two of 20! permutations will be the same (different routines), Page 7" - ), - ("RandomPermutation1[20] === RandomPermutation1[20]", - "False", - "Not likley two of 20! permutations will be the same (same routine)" - ), - ("RankPermutation[{8, 9, 7, 1, 6, 4, 5, 3, 2}]", "321953", "RankPermutation"), ( - "Permute[{5,2,4,3,1}, InversePermutation[{5,2,4,3,1}]]", - "{1, 2, 3, 4, 5}", - "InversePermute", + "RandomPermutation1[20] === RandomPermutation2[20]", + "False", + "Not likey two of the 20! permutations will be the same, 1.1.3, Page 7", + ), + ( + "RandomPermutation1[20] === RandomPermutation1[20]", + "False", + "Not likley two of 20! permutations will be the same (same routine)", ), ( "MinimumChangePermutations[{a,b,c}]", "{{a, b, c}, {b, a, c}, {c, a, b}, {a, c, b}, {b, c, a}, {c, b, a}}", - "MinimumChangePermuations, Page 11", + "MinimumChangePermuations; 1.1.4, Page 11", ), ( "Union[Permutations[{a,a,a,a,a}]]", "{{a, a, a, a, a}}", - "simple but wasteful Permutation duplication elimination, Page 12" + "simple but wasteful Permutation duplication elimination, 1.1.5, 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" + "DisctinctPermutations of multiset Binomial[6,3] permutations, 1.1.5, Page 14", ), + ("Multinomial[3,3]", "20", "The built-in function Multinomial, Page 14"), ( - "Multinomial[3,3]", + "DistinctPermutations[{A,B,C}]", + "{{A, B, C}, {A, C, B}, {B, A, C}, {B, C, A}, {C, A, B}, {C, B, A}}", + "DisctinctPermutations all n! permutations, Page 14", + ), + ( + "BinarySearch[Table[2i,{i, 30}],40]", "20", - "The built-in function Multinomial, Page 14" + "BinarySearch: 40 is one of the first 30 even numbers; 1.1.6, Page 16", ), ( - "DistinctPermutations[{A,B,C}]", - "{{A, B, C}, {A, C, B}, {B, A, C}, {B, C, A}, {C, A, B}, {C, B, A}}", - "DisctinctPermutations all n! permutations, Page 14" + "BinarySearch[Table[2i,{i, 30}],41]", + "41/2", + "BinarySearch: BinarySearch: 41 is not even; 1.1.6, Page 16", ), ( "Sort[ Subsets [Range[4]],(Apply[Plus, #1]<=Apply[Plus,#2])& ]", "{{}, {1}, {2}, {3}, {1, 2}, {4}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, " "{1, 2, 3}, {3, 4}, {1, 2, 4}, {1, 3, 4}, {2, 3, 4}, {1, 2, 3, 4}}", - "Sort to total order subsets, Page 15" + "Sort to total order subsets, Page 15", ), ( - "Subsets[Range[3]]", - "{{}, {1}, {2}, {3}, {1, 2}, {1, 3}, {2, 3}, {1, 2, 3}}", - "Subsets", + "InversePermutation[{4,8,5,2,1,3,7,6}]", + "{5, 4, 6, 1, 3, 8, 7, 2}", + "InversePermutation: 7 is fixed point. Page 18", ), ( - "BinarySearch[Table[2i,{i, 30}],40]", - "20", - "BinarySearch: 40 is one of the first 30 even numbers, Page 16" + "star = Automorphisms[Star[5]]", + "{{1, 2, 3, 4, 5}, {1, 2, 4, 3, 5}, {1, 3, 2, 4, 5}, {1, 3, 4, 2, 5}, " + "{1, 4, 2, 3, 5}, {1, 4, 3, 2, 5}, {2, 1, 3, 4, 5}, {2, 1, 4, 3, 5}, " + "{2, 3, 1, 4, 5}, {2, 3, 4, 1, 5}, {2, 4, 1, 3, 5}, {2, 4, 3, 1, 5}, " + "{3, 1, 2, 4, 5}, {3, 1, 4, 2, 5}, {3, 2, 1, 4, 5}, {3, 2, 4, 1, 5}, " + "{3, 4, 1, 2, 5}, {3, 4, 2, 1, 5}, {4, 1, 2, 3, 5}, {4, 1, 3, 2, 5}, " + "{4, 2, 1, 3, 5}, {4, 2, 3, 1, 5}, {4, 3, 1, 2, 5}, {4, 3, 2, 1, 5}}", + "Automorphisms, Page 19", ), + ): + check_evaluation(str_expr, str_expected, message) + + +def test_combinatorica_permutations_1_2(): + + for str_expr, str_expected, message in ( ( - "BinarySearch[Table[2i,{i, 30}],41]", - "41/2", - "BinarySearch: BinarySearch: 41 is not even" + "MultiplicationTable[Permutations[Range[3]], Permute ]", + "{{1, 2, 3, 4, 5, 6}, " + "{2, 1, 5, 6, 3, 4}, " + "{3, 4, 1, 2, 6, 5}, " + "{4, 3, 6, 5, 1, 2}, " + "{5, 6, 2, 1, 4, 3}, " + "{6, 5, 4, 3, 2, 1}}", + "Symmetric group S_n. S_n is not commutative. 1.2 Page 17" + ), + ( + "InversePermutation[{4,8,5,2,1,3,7,6}]", + "{5, 4, 6, 1, 3, 8, 7, 2}", + "InversePermutation: 7 is fixed point. 1.2 Page 18", + ), + ( + "star = Automorphisms[Star[5]]", + "{{1, 2, 3, 4, 5}, {1, 2, 4, 3, 5}, {1, 3, 2, 4, 5}, {1, 3, 4, 2, 5}, " + "{1, 4, 2, 3, 5}, {1, 4, 3, 2, 5}, {2, 1, 3, 4, 5}, {2, 1, 4, 3, 5}, " + "{2, 3, 1, 4, 5}, {2, 3, 4, 1, 5}, {2, 4, 1, 3, 5}, {2, 4, 3, 1, 5}, " + "{3, 1, 2, 4, 5}, {3, 1, 4, 2, 5}, {3, 2, 1, 4, 5}, {3, 2, 4, 1, 5}, " + "{3, 4, 1, 2, 5}, {3, 4, 2, 1, 5}, {4, 1, 2, 3, 5}, {4, 1, 3, 2, 5}, " + "{4, 2, 1, 3, 5}, {4, 2, 3, 1, 5}, {4, 3, 1, 2, 5}, {4, 3, 2, 1, 5}}", + "Automorphisms, 1.2.3 Page 19", + ), + ( + "relation = SamenessRelation[star]", + "{{1, 1, 1, 1, 0}, " + "{1, 1, 1, 1, 0}, " + "{1, 1, 1, 1, 0}, " + "{1, 1, 1, 1, 0}, " + "{0, 0, 0, 0, 1}}", + "Sameness, 1.2.3 Page 19", + ), + # ( + # "PermutationGroupQ[Range[4], {4, 2, 3, 1}]", + # "True", + # "PermutationGroupQ, 1.2.3 Page 20", + # ), + ): + check_evaluation(str_expr, str_expected, message) + + +def test_combinatorica_rest(): + + # Permutation[3] doesn't work + permutations3 = ( + r"{{1, 2, 3}, {1, 3, 2}, {2, 1, 3}, {2, 3, 1}, {3, 1, 2}, {3, 2, 1}}" + ) + for str_expr, str_expected, message in ( + ( + "Permute[{A, B, C, D}, %s]" % permutations3, + "{{A, B, C}, {A, C, B}, {B, A, C}, {B, C, A}, {C, A, B}, {C, B, A}}", + "Permute", + ), + ( + "Subsets[Range[3]]", + "{{}, {1}, {2}, {3}, {1, 2}, {1, 3}, {2, 3}, {1, 2, 3}}", + "Subsets", ), ( "BinarySearch[{2, 3, 9}, 7] // N", @@ -153,45 +213,11 @@ def test_combinatorica(): "2", "BinarySearch - find where key is a list", ), - # ( - # "TableForm[ MultiplicationTable[Permutations[Range[3]], Permute ] ]", - # "1 2 3 4 5 6\n" - # "2 1 5 6 3 4\n" - # "3 4 1 2 6 5\n" - # "4 3 6 5 1 2\n" - # "5 6 2 1 4 3\n" - # "6 5 4 3 2 1\n", - # "Symmetric group S_n. S_n is not commutative. Page 17" - # ), ( "InversePermutation[{4,8,5,2,1,3,7,6}]", "{5, 4, 6, 1, 3, 8, 7, 2}", "InversePermutation: 7 is fixed point. Page 18", ), - ( - "star = Automorphisms[Star[5]]", - "{{1, 2, 3, 4, 5}, {1, 2, 4, 3, 5}, {1, 3, 2, 4, 5}, {1, 3, 4, 2, 5}, " - "{1, 4, 2, 3, 5}, {1, 4, 3, 2, 5}, {2, 1, 3, 4, 5}, {2, 1, 4, 3, 5}, " - "{2, 3, 1, 4, 5}, {2, 3, 4, 1, 5}, {2, 4, 1, 3, 5}, {2, 4, 3, 1, 5}, " - "{3, 1, 2, 4, 5}, {3, 1, 4, 2, 5}, {3, 2, 1, 4, 5}, {3, 2, 4, 1, 5}, " - "{3, 4, 1, 2, 5}, {3, 4, 2, 1, 5}, {4, 1, 2, 3, 5}, {4, 1, 3, 2, 5}, " - "{4, 2, 1, 3, 5}, {4, 2, 3, 1, 5}, {4, 3, 1, 2, 5}, {4, 3, 2, 1, 5}}", - "Automorphisms, Page 19" - ), - ( - "KSubsets[Range[5], 3]", - "{{1, 2, 3}, {1, 2, 4}, {1, 2, 5}, {1, 3, 4}, {1, 3, 5}, {1, 4, 5}, " - "{2, 3, 4}, {2, 3, 5}, {2, 4, 5}, {3, 4, 5}}", - "Ksubsets", - ), - ( - "Compositions[5,3]", - "{{0, 0, 5}, {0, 1, 4}, {0, 2, 3}, {0, 3, 2}, {0, 4, 1}, {0, 5, 0}, " - "{1, 0, 4}, {1, 1, 3}, {1, 2, 2}, {1, 3, 1}, {1, 4, 0}, {2, 0, 3}, " - "{2, 1, 2}, {2, 2, 1}, {2, 3, 0}, {3, 0, 2}, {3, 1, 1}, {3, 2, 0}, " - "{4, 0, 1}, {4, 1, 0}, {5, 0, 0}}", - "Compositions", - ), # ( # "SetPartitions[3]", # "{{{1, 2, 3}}, {{1}, {2, 3}}, {{1, 2}, {3}}, {{1, 3}, {2}}, {{1}, {2}, {3}}}", @@ -200,7 +226,7 @@ def test_combinatorica(): ( "TransposePartition[{8, 6, 4, 4, 3, 1}]", "{6, 5, 5, 4, 2, 2, 1, 1}", - "TransposePartition" + "TransposePartition", ), ): check_evaluation(str_expr, str_expected, message) From d436c1d4fc291564add4d9c8be363fdef1ccdd67 Mon Sep 17 00:00:00 2001 From: rocky Date: Wed, 16 Dec 2020 15:56:56 -0500 Subject: [PATCH 3/5] Start adding book section correspondences --- .../packages/DiscreteMath/CombinatoricaLite.m | 23 +++++++++++++++++++ .../packages/DiscreteMath/CombinatoricaV0.9.m | 12 ++++++++++ test/test_combinatorica.py | 15 ------------ 3 files changed, 35 insertions(+), 15 deletions(-) diff --git a/mathics/packages/DiscreteMath/CombinatoricaLite.m b/mathics/packages/DiscreteMath/CombinatoricaLite.m index f12006ea7e..5c9d26b50c 100644 --- a/mathics/packages/DiscreteMath/CombinatoricaLite.m +++ b/mathics/packages/DiscreteMath/CombinatoricaLite.m @@ -25,7 +25,30 @@ authors, Wolfram Research, or Cambridge University Press, their licensees, distributors and dealers shall in no event be liable for any indirect, incidental, or consequential damages. + *) +(* :History: + Version 2.1 updated to Mathematica 6 by John M. Novak, 2006. + Version 2.0 most code rewritten Sriram V. Pemmaraju, 2000-2002 + Too many changes to describe here. Read the book! + Version 1.1 modification by ECM, March 1996. + Replaced K with CompleteGraph because K is now the + default generic name for the summation index in + symbolic sum. + Added CombinatorialFunctions.m and Permutations.m to + BeginPackage, and commented out CatalanNumber, + PermutationQ, ToCycles, FromCycles, and + RandomPermutation so there would be no shadowing of + symbols among the DiscreteMath packages. + Replaced old BinarySearch with new code by Paul Abbott + correctly implementing binary search. + Version 1.0 by Steven S. Skiena, April 1995. + Version .9 by Steven S. Skiena, February 1992. + Version .8 by Steven S. Skiena, July 1991. + Version .7 by Steven S. Skiena, January 1991. + Version .6 by Steven S. Skiena, June 1990. + *) +(* And for the 0.6 version: Version 0.6 6/11/90 Beta Release Copyright (c) 1990 by Steven S. Skiena diff --git a/mathics/packages/DiscreteMath/CombinatoricaV0.9.m b/mathics/packages/DiscreteMath/CombinatoricaV0.9.m index 15b03e37a5..78afb66bee 100644 --- a/mathics/packages/DiscreteMath/CombinatoricaV0.9.m +++ b/mathics/packages/DiscreteMath/CombinatoricaV0.9.m @@ -597,6 +597,8 @@ Permute[l_List,p_?PermutationQ] := l [[ p ]] Permute[l_List,p_List] := Map[ (Permute[l,#])&, p] /; (Apply[And, Map[PermutationQ, p]]) +(* Section 1.1.1 Lexicographically Ordered Permutions, Pages 3-4 *) + LexicographicPermutations[{l_}] := {{l}} LexicographicPermutations[{a_,b_}] := {{a,b},{b,a}} @@ -617,6 +619,8 @@ ] ] +(* Section 1.1.2 Ranking and Unranking Permutations, Pages 5-6 *) + RankPermutation[{1}] = 0 RankPermutation[p_?PermutationQ] := (p[[1]]-1) (Length[Rest[p]]!) + @@ -636,6 +640,8 @@ NextPermutation[p_?PermutationQ] := NthPermutation[ RankPermutation[p]+1, Sort[p] ] +(* Section 1.1.3 RandomPermutations, Pages 6-7 *) + RandomPermutation1[n_Integer?Positive] := Map[ Last, Sort[ Map[({RandomInteger[],#})&,Range[n]] ] ] @@ -651,6 +657,7 @@ RandomPermutation[n_Integer?Positive] := RandomPermutation1[n] +(* Section 1.1.4 Permutation from Transpostions, Page 11 *) MinimumChangePermutations[l_List] := Module[{i=1,c,p=l,n=Length[l],k}, c = Table[1,{n}]; @@ -668,6 +675,7 @@ ] ] +(* Section 1.1.5 Backtracking and Distict Permutations, Page 12-13 *) Backtrack[space_List,partialQ_,solutionQ_,flag_:One] := Module[{n=Length[space],all={},done,index,v=2,solution}, index=Prepend[ Table[0,{n-1}],1]; @@ -709,6 +717,8 @@ ] ] +(* Section 1.1.6 Sorting and Searching, Page 14-16 *) + MinOp[l_List,f_] := Module[{min=First[l]}, Scan[ (If[ Apply[f,{#,min}], min = #])&, l]; @@ -739,6 +749,7 @@ ] ] +(* Section 1.2.1 Multiplying Permutations, Page 17 *) MultiplicationTable[elems_List,op_] := Module[{i,j,n=Length[elems],p}, Table[ @@ -748,6 +759,7 @@ ] ] +(* Section 1.2.2 The Inverse of a Permutation, Page 18 *) InversePermutation[p_?PermutationQ] := Module[{inverse=p, i}, Do[ inverse[[ p[[i]] ]] = i, {i,Length[p]} ]; diff --git a/test/test_combinatorica.py b/test/test_combinatorica.py index 18c93f7567..d823c3a5f4 100644 --- a/test/test_combinatorica.py +++ b/test/test_combinatorica.py @@ -100,21 +100,6 @@ def test_combinatorica_permutations_1_1(): "{1, 2, 3}, {3, 4}, {1, 2, 4}, {1, 3, 4}, {2, 3, 4}, {1, 2, 3, 4}}", "Sort to total order subsets, Page 15", ), - ( - "InversePermutation[{4,8,5,2,1,3,7,6}]", - "{5, 4, 6, 1, 3, 8, 7, 2}", - "InversePermutation: 7 is fixed point. Page 18", - ), - ( - "star = Automorphisms[Star[5]]", - "{{1, 2, 3, 4, 5}, {1, 2, 4, 3, 5}, {1, 3, 2, 4, 5}, {1, 3, 4, 2, 5}, " - "{1, 4, 2, 3, 5}, {1, 4, 3, 2, 5}, {2, 1, 3, 4, 5}, {2, 1, 4, 3, 5}, " - "{2, 3, 1, 4, 5}, {2, 3, 4, 1, 5}, {2, 4, 1, 3, 5}, {2, 4, 3, 1, 5}, " - "{3, 1, 2, 4, 5}, {3, 1, 4, 2, 5}, {3, 2, 1, 4, 5}, {3, 2, 4, 1, 5}, " - "{3, 4, 1, 2, 5}, {3, 4, 2, 1, 5}, {4, 1, 2, 3, 5}, {4, 1, 3, 2, 5}, " - "{4, 2, 1, 3, 5}, {4, 2, 3, 1, 5}, {4, 3, 1, 2, 5}, {4, 3, 2, 1, 5}}", - "Automorphisms, Page 19", - ), ): check_evaluation(str_expr, str_expected, message) From 1a4724361ab46c7327c77c6036d3b14b871cc582 Mon Sep 17 00:00:00 2001 From: rocky Date: Thu, 17 Dec 2020 14:08:41 -0500 Subject: [PATCH 4/5] Progress to page 23 --- .../packages/DiscreteMath/CombinatoricaV0.9.m | 4 + test/test_combinatorica.py | 91 ++++++++++++++----- 2 files changed, 71 insertions(+), 24 deletions(-) diff --git a/mathics/packages/DiscreteMath/CombinatoricaV0.9.m b/mathics/packages/DiscreteMath/CombinatoricaV0.9.m index 78afb66bee..18663457e7 100644 --- a/mathics/packages/DiscreteMath/CombinatoricaV0.9.m +++ b/mathics/packages/DiscreteMath/CombinatoricaV0.9.m @@ -766,6 +766,7 @@ inverse ] +(* Section 1.2.3 The Equivalence Relation and Classesn, Page 18-19 *) EquivalenceRelationQ[r_?SquareMatrixQ] := ReflexiveQ[r] && SymmetricQ[r] && TransitiveQ[r] EquivalenceRelationQ[g_Graph] := EquivalenceRelationQ[ Edges[g] ] @@ -797,6 +798,7 @@ ] ] /; perms != {} +(* 1.2.4 The Cycle Structure of Permutations; Pages 20-21 *) ToCycles[p1_?PermutationQ] := Module[{p=p1,m,n,cycle,i}, Select[ @@ -825,6 +827,7 @@ p ] +(* 1.2.4 The Cycle Structure of Permutations, Hiding Cycles; Page 22 *) HideCycles[c_List] := Flatten[ Sort[ @@ -845,6 +848,7 @@ Append[cycles,Take[p,{start,end-1}]] ] +(* 1.2.4 The Cycle Structure of Permutations, Counting Cycles; Page 23 *) NumberOfPermutationsByCycles[n_Integer,m_Integer] := (-1)^(n-m) StirlingS1[n,m] StirlingFirst[n_Integer,m_Integer] := StirlingFirst1[n,m] diff --git a/test/test_combinatorica.py b/test/test_combinatorica.py index d823c3a5f4..8302a3df3b 100644 --- a/test/test_combinatorica.py +++ b/test/test_combinatorica.py @@ -37,13 +37,13 @@ def test_combinatorica_permutations_1_1(): ( "LexicographicPermutations[{a,b,c,d}]", "{{a, b, c, d}, {a, b, d, c}, {a, c, b, d}, " - "{a, c, d, b}, {a, d, b, c}, {a, d, c, b}, " - "{b, a, c, d}, {b, a, d, c}, {b, c, a, d}, " - "{b, c, d, a}, {b, d, a, c}, {b, d, c, a}, " - "{c, a, b, d}, {c, a, d, b}, {c, b, a, d}, " - "{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}}", + " {a, c, d, b}, {a, d, b, c}, {a, d, c, b}, " + " {b, a, c, d}, {b, a, d, c}, {b, c, a, d}, " + " {b, c, d, a}, {b, d, a, c}, {b, d, c, a}, " + " {c, a, b, d}, {c, a, d, b}, {c, b, a, d}, " + " {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, 1.1.1 Page 4", ), # NthPermutation does not work @@ -75,7 +75,7 @@ def test_combinatorica_permutations_1_1(): ( "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}}", + " {2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 1}}", "DisctinctPermutations of multiset Binomial[6,3] permutations, 1.1.5, Page 14", ), ("Multinomial[3,3]", "20", "The built-in function Multinomial, Page 14"), @@ -96,8 +96,10 @@ def test_combinatorica_permutations_1_1(): ), ( "Sort[ Subsets [Range[4]],(Apply[Plus, #1]<=Apply[Plus,#2])& ]", - "{{}, {1}, {2}, {3}, {1, 2}, {4}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, " - "{1, 2, 3}, {3, 4}, {1, 2, 4}, {1, 3, 4}, {2, 3, 4}, {1, 2, 3, 4}}", + "{{}, {1}, {2}, {3}, {1, 2}, {4}, " + " {1, 3}, {1, 4}, {2, 3}, {2, 4}, " + " {1, 2, 3}, {3, 4}, {1, 2, 4}, {1, 3, 4}, {2, 3, 4}, " + " {1, 2, 3, 4}}", "Sort to total order subsets, Page 15", ), ): @@ -110,11 +112,11 @@ def test_combinatorica_permutations_1_2(): ( "MultiplicationTable[Permutations[Range[3]], Permute ]", "{{1, 2, 3, 4, 5, 6}, " - "{2, 1, 5, 6, 3, 4}, " - "{3, 4, 1, 2, 6, 5}, " - "{4, 3, 6, 5, 1, 2}, " - "{5, 6, 2, 1, 4, 3}, " - "{6, 5, 4, 3, 2, 1}}", + " {2, 1, 5, 6, 3, 4}, " + " {3, 4, 1, 2, 6, 5}, " + " {4, 3, 6, 5, 1, 2}, " + " {5, 6, 2, 1, 4, 3}, " + " {6, 5, 4, 3, 2, 1}}", "Symmetric group S_n. S_n is not commutative. 1.2 Page 17" ), ( @@ -135,17 +137,63 @@ def test_combinatorica_permutations_1_2(): ( "relation = SamenessRelation[star]", "{{1, 1, 1, 1, 0}, " - "{1, 1, 1, 1, 0}, " - "{1, 1, 1, 1, 0}, " - "{1, 1, 1, 1, 0}, " - "{0, 0, 0, 0, 1}}", + " {1, 1, 1, 1, 0}, " + " {1, 1, 1, 1, 0}, " + " {1, 1, 1, 1, 0}, " + " {0, 0, 0, 0, 1}}", "Sameness, 1.2.3 Page 19", ), + ( + "EquivalenceClasses[relation]", + "{{1, 2, 3, 4}, {5}}", + "EquivalenceClasses, 1.2.3, Page 19" + ), # ( # "PermutationGroupQ[Range[4], {4, 2, 3, 1}]", # "True", # "PermutationGroupQ, 1.2.3 Page 20", # ), + ( + "ToCycles[Range[10]]", + "{{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}}", + "ToCycles, 1.2.4, Page 21" + ), + ( + "Select[ Permutations[Range[4]], (Length[ToCycles[#]] == 1)&]", + "{{2, 3, 4, 1}, {2, 4, 1, 3}, {3, 1, 4, 2}, " + " {3, 4, 2, 1}, {4, 1, 2, 3}, {4, 3, 1, 2}}", + "ToCycles, 1.2.4, Page 21" + ), + ( + "ToCycles[ Reverse[Range[10]] ]", + "{{10, 1}, {9, 2}, {8, 3}, {7, 4}, {6, 5}}", + "Reverse ToCycles, 1.2.4, Page 21" + ), + ( + "Permute[ Reverse[Range[10]], Reverse[Range[10]] ]", + "Range[10]", + "Pemute as involution, 1.2.4, Page 21" + ), + ( + "Apply[ And, List[p=RandomPermutation[8]; p===FromCycles[ToCycles[p]]] ]", + "True", + "Convert to-and-from cycle structure is identity, 1.2.4, Page 22" + ), + ( + "Apply[ And, List[p=RandomPermutation[8]; p===FromCycles[ToCycles[p]]] ]", + "True", + "Convert to-and-from cycle structure is identity, 1.2.4, Page 22" + ), + ( + "ToCycles[{6,2,1,5,4,3} ]", + "{{6, 3, 1}, {2}, {5, 4}}", + "Three permutations, one of each size, 1.2.4, Page 22" + ), + ( + "HideCycles[ToCycles[{6,2,1,5,4,3}]]", + "{4, 5, 2, 1, 6, 3}", + "Permutations is not what we started with, 1.2.4, Page 23" + ), ): check_evaluation(str_expr, str_expected, message) @@ -198,11 +246,6 @@ def test_combinatorica_rest(): "2", "BinarySearch - find where key is a list", ), - ( - "InversePermutation[{4,8,5,2,1,3,7,6}]", - "{5, 4, 6, 1, 3, 8, 7, 2}", - "InversePermutation: 7 is fixed point. Page 18", - ), # ( # "SetPartitions[3]", # "{{{1, 2, 3}}, {{1}, {2, 3}}, {{1, 2}, {3}}, {{1, 3}, {2}}, {{1}, {2}, {3}}}", From 0b7bcc4195a72be4134322289344f1eb06d782ff Mon Sep 17 00:00:00 2001 From: rocky Date: Thu, 17 Dec 2020 15:38:44 -0500 Subject: [PATCH 5/5] Extend /; testing --- test/test_control.py | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/test/test_control.py b/test/test_control.py index 929a9d5457..947457804f 100644 --- a/test/test_control.py +++ b/test/test_control.py @@ -8,7 +8,7 @@ import pytest -def test_control(): +def test_catch(): session.evaluate( """ (* Define a function that can "throw an exception": *) @@ -67,6 +67,38 @@ def test_control(): "a", "Catch picks up the first Throw that is evaluated (2)", ), + ): + check_evaluation(str_expr, str_expected, message) + +def test_condition(): + session.evaluate( + """ + (* Define a function that can "throw an exception": *) + + f[x_] := ppp[x]/; x>0 + """ + ) + for str_expr, str_expected, message in ( + ( + "f[5]", + "ppp[5]", + "/; with True condition", + ), + ( + "f[-6]", + "f[-6]", + "/; with False condition", + ), + ( + "{6, -7, 3, 2, -1, -2} /. x_ /; x < 0 -> w", + "{6, w, 3, 2, w, w}", + "Replace all exlements which satisfy the condition of being negative", + ), + ( + "{6, -7, 3, 2, -1, -2} /. x_ /; x < 0 -> w", + "{6, w, 3, 2, w, w}", + "Replace all elements which satisfy the condition of being negative", + ), ): check_evaluation(str_expr, str_expected, message)