More Complex Predicates: allOddQ, allIdenticalQ, subsetQ

"Mr Wizard Todd", Manfred Plagmann, and Sophia Scheibe have done Mathematica users a nice favor by getting permission from McGraw-Hill to distribute licensed copies of David Wagner' s superb book, Power Programming in Mathematica. (Dropbox link: https://www.dropbox.com/s/j2dsyvptnxjd369/Wagner%20All%20Parts-RC.pdf)

A related post is How to See the Equivalence of Select and Cases.

Here are some nice examples of predicates from Wagner (re - written in my Prefix/Postfix dialect).Test a list to see if all of its entries are odd integers.

allOdd@aList_List:=Length@Select[aList,OddQ]==Length@aList

allOdd@{2,3,5,6}

False

allOdd@{3,5,7,9}

True

This predicate tests a List to see if its parts are identical. Count returns all Parts that are Equal to the First Part.

identicalListPartsQ@aList_List:=Count[aList, First@aList] == Length@aList

identicalListPartsQ@{a,b,c,4}

False

identicalListPartsQ@{a,a,a,a}

True

SameQ vs. Equal  and Testing for Lists

SubsetQ determines if its first argument is a subset of its second argument and returns True or False. Wagner's function did not include a List test and he notes on Equal vs.SameQ : "The use of === rather than == makes SubsetQ return False if either set1 or set2 is not a list. Try it with Equal."

I use the Head test: set1_List, which rejects a non-List argument before evaluation. And more importantly, SameQ should always be used to test non-numerical equivalence. In fact using Equal here can give screwy results in part because of its usage as the mathematical "equals" (=) in Mathematica's syntax for equations.

When using abbreviated operators, we should first determine their Precedence:

Precedence/@{Union,Equal,SameQ}

{300.,290.,290.}

Since Union is slightly stickier than SameQ, the Union will be performed before the SameQ test.

subsetQ[set1_,set2_]:=set1∪set2===set2

subsetQ[{a,b,c},{a,b,d}]

False

subsetQ[{a,b},{a,b,2}]

False

Union Sorts Its Result

Whoops! Wagner's function didn't work. Let's find out why:

subsetQ[{a,b},{a,b,2}]//Trace

{subsetQ[{a,b},{a,b,2}],{a,b}∪{a,b,2}==={a,b,2},{{a,b}∪{a,b,2},{2,a,b}},{2,a,b}==={a,b,2},False}

The fact that Union returns a sorted List fouls up the comparison. Let's try a fix with Sort:

Clear@subsetQ;subsetQ[set1_,set2_]:=set1∪set2===Sort@set2

And it works - you see in the last step Sort fixes the order.

subsetQ[{a,b},{a,b,2}]//Trace

{subsetQ[{a,b},{a,b,2}],{a,b}∪{a,b,2}===Sort[{a,b,2}],{{a,b}∪{a,b,2},{2,a,b}},{Sort[{a,b,2}],{2,a,b}},{2,a,b}==={2,a,b},True}

Greater (>) is a "non-Q" predicate so the last statement (lacking a return-suppressing semi-colon), returns True or False.

More on predicates: http://mathematica-guide.blogspot.com/2015/07/how-to-see-equivalence-of-select-and.html

How It Works: DeleteDuplicates

Delete Duplicates

While Union is commonly used to select all unique elements from a List, including a set of Lists, DeleteDuplicates is commonly used to select unique elements from a single List, which Union can do, too. Union sorts the result, while DeleteDuplicates leaves the result in its original order. Consequently, DeleteDuplicates is a faster function if you do not need the Sort. Both functions include an optional second argument to specify the function used to remove duplicates, which greatly increases their power and versatility. First, here is DeleteDuplicates' basic functionality.

DeleteDuplicates@{c,a,b,d,a,c,a,e,e,a,a,e}

{c,a,b,d,e}

Note that if you do feed DeleteDuplicates a set of Lists, you do need to enclose the Lists in curly brackets.

DeleteDuplicates[{c,a,b},{d,a,c},{a,e},{e,a},{a,e}]

DeleteDuplicates::argb: DeleteDuplicates called with 5 arguments; between 1 and 3 arguments are expected. >>

DeleteDuplicates[{{c,a,b},{d,a,c},{a,e},{e,a},{a,e}}]

{{c,a,b},{d,a,c},{a,e},{e,a}}


You can use DeleteDuplicates' second argument to increase its breadth by specifying how it will detect the duplicates. So in the example above, by default neither Union nor DeleteDuplicates treats Lists with the same elements as equivalent, as would be the case in set theory, while this can be done with their sameness test.

It is relatively straightforward to construct the second argument if you keep in mind that the default is DeleteDuplicates[expr, SameQ] and therefore extensions of the function can take the form DeleteDuplicates[expr, f@#~SameQ~f#2&], where the comparison function f can be as complex as you wish. Here we need Sort because:

{a,b}~SameQ~{b,a}

False

DeleteDuplicates[{{c,a,b},{d,a,c},{a,e},{e,a},{a,e}},Sort@#~SameQ~Sort@#2&]

{{c,a,b},{d,a,c},{a,e}}

Here is a second, neat example from the Doc Center. Extending the power of DeleteDuplicates, this function uses Equal instead of SameQ, possibly since Equal will yield True for Reals and non-Reals. I've modified the example to show that.

5==5.

True

5===5.

False

list1 = {{0,0,0,1,0},{1,0,1,0,1},{1.,1.,1.,0.,0.},{0,0,0,0,1},{1,1,1,0,1}};

DeleteDuplicates[list1,Total@#==Total@#2&]

{{0,0,0,1,0},{1,0,1,0,1},{1,1,1,0,1}}

Here is a potential issue that limits the power of DeleteDuplicates. Trace tells us that the second 4 gets removed before it can be compared to the 16.

squaresList=Table[{x,x^2},{x,2,4}]//Flatten

{2,4,3,9,4,16}

DeleteDuplicates[squaresList,#2==#^2&]//Trace
{{squaresList,{2,4,3,9,4,16}},DeleteDuplicates[{2,4,3,9,4,16},#2==#1^2&],{(#2==#1^2&)[2,4],4==2^2,{2^2,4},4==4,True},{(#2==#1^2&)[2,3],3==2^2,{2^2,4},3==4,False},{(#2==#1^2&)[2,9],9==2^2,{2^2,4},9==4,False},{(#2==#1^2&)[2,4],4==2^2,{2^2,4},4==4,True},{(#2==#1^2&)[2,16],16==2^2,{2^2,4},16==4,False},{(#2==#1^2&)[3,9],9==3^2,{3^2,9},9==9,True},{(#2==#1^2&)[3,4],4==3^2,{3^2,9},4==9,False},{(#2==#1^2&)[3,16],16==3^2,{3^2,9},16==9,False},{2,3,16}}

We're asking DeleteDuplicates to do something beyond deleting duplicates. We should use DeleteCases to do this job.

DeleteCases[squaresList,x_/;(Sqrt@x//IntegerQ)]

{2,3}

How It Works

Somewhere Roman Maeder gives a solution to deleting duplicates and implies that his solution is efficient. From memory here is the solution (with my more efficient syntax). We create a simple list of duplicate integers.

dupeList = Table[{i, i}, {i, 10}] // Flatten

{1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10}

We partition them into sets of two with offset 1 (meaning overlap of one on the original List).

dupeListPartitioned2Offset1 = Partition[dupeList, 2, 1]

{{1, 1}, {1, 2}, {2, 2}, {2, 3}, {3, 3}, {3, 4}, {4, 4}, {4, 5}, {5, 5}, {5, 6}, {6, 6}, {6, 7}, {7, 7}, {7, 8}, {8, 8}, {8, 9}, {9, 9}, {9, 10}, {10, 10}}

Now it's a simple matter to Select the sets where Part 1 is not the same as Part 2. Select always takes a predicate, sometimes of the form testQ, but here with an abbreviated operator, UnsameQ. Unequal would work for numerical entries, but UnsameQ will also work for symbols and Strings.

dupeListdupeSetsDeleted = Select[dupeListPartitioned2Offset1, #[[1]] =!= #[[2]] &]

{{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 7}, {7, 8}, {8, 9}, {9, 10}}

We're still left with duplicates. So we take the First entry of each set, and Append the Last entry of the Last set, which would have been left out. I remember thinking at this point that I would have spent time trying to not 'hack' this last part--somehow capture that last entry without another operation--but if it's good enough for Maeder, it's good enough for me. The lesson is to do what is expedient and move on to the next task.

Append[First /@ dupeListdupeSetsDeleted, Last@Last@dupeListdupeSetsDeleted]

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

DeleteDuplicates