Rule & Pattern Programming Example: Run-Length Encoding

In Sal Mangano's excellent Mathematica Cookbook, he says this is one of his favorite functions due to its concise use of rule-based pattern-matching programming.

runLengthEncode@l_List:=Map[{#,1}&,l]//.{head___,{x_,n_},{x_,m_},tail___}:>{head,{x,n+m},tail}

runLengthEncode@{1,1,2,2,2,1,3,3,3,3}

{{1,2},{2,3},{1,1},{3,4}}

How does this concise rule & pattern program work? The "Map" clause puts a template for the run-length encoding format, {symbol, run-length}, at every expression in the List, then the ReplaceRepeated "//." clause works its magic by repeatedly detecting duplicate consecutive symbols and incrementing their run-length counter until no consecutive duplicate is detected, at which point it moves to the next symbol.

How can we see this? A critical step is where the {symbol, run-length} initial template is set up for each symbol in the List , which is simply this fundamental operation of Function (here in its abbreviated form):

{#,1}&@n

{n,1}

Trace is helpful but can be tedious to parse. One way to reveal one-liner mechanisms is to use a symbolic input. A second way, just as with longer programs, is to break them apart and step through them. You just have to figure out how to divide up the key steps. Here is the first key step for this one, mapping the initial template at each symbol:

Map[{#,1}&,{1,1,2,2,2,1,3,3,3,3}]

{{1,1},{1,1},{2,1},{2,1},{2,1},{1,1},{3,1},{3,1},{3,1},{3,1}}

And the second key step is the consolidation of the counts:

%//.{head___,{x_,n_},{x_,m_},tail___}:>{head,{x,n+m},tail}

{{1,2},{2,3},{1,1},{3,4}}

And here is the Trace.

runLengthEncode@{1,1,2,2,2,1,3,3,3,3}//Trace

{runLengthEncode[{1,1,2,2,2,1,3,3,3,3}],({#1,1}&)/@{1,1,2,2,2,1,3,3,3,3}//. {head___,{Removed[x]:_,n_},{Removed[x]:_,m_},tail___}:>{head,{Removed[x],n+m},tail},{({#1,1}&)/@{1,1,2,2,2,1,3,3,3,3},{({#1,1}&)[1],({#1,1}&)[1],({#1,1}&)[2],({#1,1}&)[2],({#1,1}&)[2],({#1,1}&)[1],({#1,1}&)[3],({#1,1}&)[3],({#1,1}&)[3],({#1,1}&)[3]},{({#1,1}&)[1],{1,1}},{({#1,1}&)[1],{1,1}},{({#1,1}&)[2],{2,1}},{({#1,1}&)[2],{2,1}},{({#1,1}&)[2],{2,1}},{({#1,1}&)[1],{1,1}},{({#1,1}&)[3],{3,1}},{({#1,1}&)[3],{3,1}},{({#1,1}&)[3],{3,1}},{({#1,1}&)[3],{3,1}},{{1,1},{1,1},{2,1},{2,1},{2,1},{1,1},{3,1},{3,1},{3,1},{3,1}}},{{head___,{Removed[x]:_,n_},{Removed[x]:_,m_},tail___}:>{head,{Removed[x],n+m},tail},{head___,{Removed[x]:_,n_},{Removed[x]:_,m_},tail___}:>{head,{Removed[x],n+m},tail}},{{1,1},{1,1},{2,1},{2,1},{2,1},{1,1},{3,1},{3,1},{3,1},{3,1}}//. {head___,{Removed[x]:_,n_},{Removed[x]:_,m_},tail___}:>{head,{Removed[x],n+m},tail},{{1,2},{2,3},{1,1},{3,4}}}

File Operations: Add the Total Byte Size of Files in Folders

File Operations: Add the Total Byte Size of Files in Folders

Mostly from the Carnegie-Mellon Pronouncing Dictionary (link available here: http://www.speech.cs.cmu.edu/cgi-bin/cmudict), I have created 138,418 files that I wanted to group into 3 folders of equal size. The files are in sub-folders according to the first letter of their filename, and a first pass at dividing them equally by dividing the Length of the original List by 3 split the last two Lists in the middle of files beginning with "p". I want to verify that the 3 sub-folders contain files of equal size or even them out. This involves some file operations and Select.

In[312]:= fileNames=FileNames["*.zip",{"C:\\Users\\kwcarlso\\Documents\\Kris\\Megapedia-Local\\Reference-English\\Target Files\\Reference-English"}]

Here and below I've abbreviated the output with "{filename, ..., filename}".

Out[312]= {C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\a.zip, ... ,C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\z.zip}

How to best tally the file byte size in each sub-folder? I considered using GatherBy to group the FileNames into the same groups as the sub-folders, and that probably would have worked, but would have been complicated to use three predicates, each with a range of letters in it. Discretion is always the better part of valor in programming, even to the point of just adding up the byte sizes by hand if this task were a one-off and to let me get on to the next task.

I decided to apply the principle of "divide-and-conquer" and use Select to group each set of files individually, then add byte sizes for each result. The predicate in Select is a set-theoretic operation, which indicated using a set-theoretic function, MemberQ. An original design principle of Mathematica's pre-cursor, Symbolic Manipulation Program (SMP), was to transparently map to all common mathematical functions and syntax, and it is simplest to do just that if possible. I use the infix functional style for MemberQ because it seems a bit more readable than functional bracketed style (but that's a trivial personal preference).

My first attempt failed since I forgot that CharacterRange is case-sensitive. I changed "A" and "F" to "a" and "f" and it worked perfectly. We need the final #& since the Select test works by simply applying the predicate to each element of the first argument List that you provide it.

In[316]:= fileNamesAF=Select[fileNames,CharacterRange["a","f"]~MemberQ~First@Characters@FileNameTake@#&]

Out[316]= {C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\a.zip, ..., C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\f.zip}

In[317]:= fileNamesGP=Select[fileNames,CharacterRange["g","p"]~MemberQ~First@Characters@FileNameTake@#&]

Out[317]= {C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\g.zip, ..., C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\p.zip}

In[318]:= fileNamesQZ=Select[fileNames,CharacterRange["q","z"]~MemberQ~First@Characters@FileNameTake@#&]
Out[318]= {C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\q.zip, ..., C:\Users\kwcarlso\Documents\Kris\Megapedia-Local\Reference-English\Target Files\Reference-English\z.zip}

At this point all we need to do is Map FileByteCount onto the filename in each folder, which means at Level 2 only (note the brackets around 2).

In[319]:= Map[FileByteCount,{fileNamesAF,fileNamesGP,fileNamesQZ},{2}]

Out[319]= {{11154319,14865868,17087067,12155371,7279606,8313716},{8802167,9846927,5719874,2458146,6091626,8605940,14729204,4588698,4529191,13363263},{795821,11363572,22685379,9138068,3902314,3644541,6431739,119495,1027761,1314296}}

Replacing List with Plus to add the numbers in each List is a common operation. When referring to Output I often use the line number instead of % since I can then change the function and re-Evaluate without modifiying it (to %%, %3, or then using the line number).

In[321]:= Plus@@#&/@%319

Out[321]= {70855947,78735036,60422986}

The result told me that moving the files beginning with "P" from the middle set into the last set would even those last two groups out.

Example of a File of Functions to Pre-Load at Startup

Here is a portion of my file of functions that I load on startup so they're available in every session. See also Load Functions at Startup Using Initialization Files.

Functions to Pre-Load

String Processing

Cleaners

trimWhiteSpace::usage="trimWhiteSpace is a simple stringtrim function that does a better job than StringTrim since it removes all WhiteSpaceCharacters from beginning, end or middle of Strings. It is Listable and is intended to Map over all fields in all records where all fields are Strings, no matter if they are wrapped in Lists at any level."

Clear@trimWhiteSpace;

SetAttributes[trimWhiteSpace,Listable];

trimWhiteSpace@stringFile_:=StringReplace[stringFile,WhitespaceCharacter->""];

cleanseText::usage="cleanseText is a moderately thorough stringtrim function. The regular expression removes whitespace characters from the beginning and end of the string, including non-breaking spaces. StringReplace removes apostrophes and commas. It is Listable and intended to automatically Map over all fields in all records where all fields are Strings, no matter if they are wrapped in Lists at any level. These rules should be expanded to include more data cleansing functions as needed."

Clear@cleanseText;

SetAttributes[cleanseText,Listable];

cleanseText@text_String:=StringReplace[text,RegularExpression["^(\\s)*|(\\s)*$"]->""]//StringReplace[#,{"'"->"",WhitespaceCharacter->" ","("|")"->""}]&;

Web Page Functions

Make a URL from a String

makeURL::usage="makeURL takes a String to use as the prefix of the URL, cleans it up (removes whitespace and non-breaking spaces (which are often invisible), puts the String in lower case, replaces single spaces with hyphens and finally appends '.html'. Example: 'My Home Page' -> my-home-page.html".

Clear@makeURL;

SetAttributes[makeURL,Listable];

makeURL@urlName_String:=ToLowerCase@cleanseText@urlName//StringReplace[#,Whitespace->"-"]&//StringReplace[#,"---"->"-"]&//FileNameJoin[{#<>".html"}]&;

ApplyAll Applies a Function to all Subexpressions at Level One

ApplyAll

Instead of applying a function f to an entire expression, i.e. replacing the Head of the expression with f, use ApplyAll like Map to apply the function to each subexpression at level 1 of the expression. Apply defaults to Level 0 (the Head) and ApplyAll is just a convenient shorthand for Apply[ f, expr, 1].

Here is a typical example of ApplyAll. You have a List of number pairs and you want to perform some arithmetical operation such as add, multiply, divide, raise one to the power of the other, etc. (To remember the syntax of RandomReal I think of its arguments sequentially in English: "give me random reals between 1 and 20, 10 of them with length 2" (i.e. a 10 x 2 array).)

pairs=RandomReal[{0,1},{20,2}]

{{0.00994214,0.0701189},{0.024718,0.24013},{0.434799,0.996965},{0.323499,0.444366},{0.799502,0.843786},{0.964146,0.254526},{0.438815,0.943254},{0.228569,0.00348145},{0.247675,0.773157},{0.879202,0.615889},{0.898872,0.232664},{0.381568,0.75334},{0.464207,0.659948},{0.843115,0.179364},{0.287139,0.636774},{0.922514,0.193705},{0.969753,0.273868},{0.012059,0.247027},{0.560162,0.962637},{0.0593815,0.331142}}

Map doesn't work. It essentially disappears because it has no effect on a List:

Plus[List[a,b]]

{a,b}

Plus/@pairs

{{0.00994214,0.0701189},{0.024718,0.24013},{0.434799,0.996965},{0.323499,0.444366},{0.799502,0.843786},{0.964146,0.254526},{0.438815,0.943254},{0.228569,0.00348145},{0.247675,0.773157},{0.879202,0.615889},{0.898872,0.232664},{0.381568,0.75334},{0.464207,0.659948},{0.843115,0.179364},{0.287139,0.636774},{0.922514,0.193705},{0.969753,0.273868},{0.012059,0.247027},{0.560162,0.962637},{0.0593815,0.331142}}

But ApplyAll works perfectly; we always use its abbreviated version:

Plus@@@pairs

{0.080061,0.264848,1.43176,0.767865,1.64329,1.21867,1.38207,0.23205,1.02083,1.49509,1.13154,1.13491,1.12416,1.02248,0.923913,1.11622,1.24362,0.259086,1.5228,0.390524}

Times@@@pairs

{0.000697132,0.00593553,0.43348,0.143752,0.674608,0.2454,0.413914,0.000795751,0.191491,0.541491,0.209135,0.287451,0.306352,0.151224,0.182842,0.178696,0.265585,0.00297889,0.539232,0.0196637}

Here is a another example of ApplyAll. I want to make a toy directed graph so I can explore the new graph functions that have superseded the Combinatorica package as of Version 8.

randomEdges=RandomInteger[{1,20},{10,2}]

{{16,5},{17,17},{10,10},{15,2},{9,8},{20,9},{19,7},{20,15},{8,20},{11,3}}

Now I want to convert the pairs of numbers into a directed graph with DirectedEdge. My first try fails, again because each subexpression is a List.

toyGraph=DirectedEdge/@randomEdges

{DirectedEdge[{16,5}],DirectedEdge[{17,17}],DirectedEdge[{10,10}],DirectedEdge[{15,2}],DirectedEdge[{9,8}],DirectedEdge[{20,9}],DirectedEdge[{19,7}],DirectedEdge[{20,15}],DirectedEdge[{8,20}],DirectedEdge[{11,3}]}

What I need is ApplyAll.

toyGraph=DirectedEdge@@@randomEdges

It is equivalent to Apply[ DirectedEdge, randomEdges, 1].

Apply[DirectedEdge,randomEdges,1]

How It Works: First, Last, Rest, Map, Apply, Nest, Fold

I adapted these functions from exercises in David Wagner's superb book, Power Programming in Mathematica, now out of print, recommended by MathGroup.

The first four are examples of an axiom of primitive and general recursive functions, projection (see Gray, p. 411), but also of selectors, functions used in a data structure to access data in a controlled way without altering the data itself (see Maeder).

myFirst@head_[first_,last___] := first

myLast@head_[most___,last_] := last

myMost@{most___, last_} := {most}
myMost@head_[most___,last_] := {most}

myRest@head_[first_,rest___] := {rest}

Here is how Apply works:

myApply[f_, head_@anything___] := f@anything
myApply[f_, anything_] := f@anything

Recursive Definitions for Map, Nest, Fold

Note the piecewise definitions and use of recursion for Map, Nest, and Fold, which work so elegantly. Before seeing Wagner's solutions I thought these functions must use a procedural-type of iteration and list decomposition.

myMap[f_,{a_,b___}]:= Join[{f@a},myMap[f,{b}] ]
myMap[f_,{}]:={}  (* base case *)

myNest[f_,x_,n_Integer?Positive]:= myNest[f,f@x,n-1]
myNest[f_,x_,0]:= x  (* base case *)

myFold[f_,x_,{a_,b___}]:= myFold[f,f[x,a],{b}]
myFold[f_,x_,{}]:= x  (* base case *)

Recursive, Rule-Based Definitions for Map, Nest, Fold

Here are Map, Nest, and Fold using a "pure" rule-based approach, meaning using only rules and patterns. Wagner notes that it turns out that Map is the most difficult of them to implement this way.

Clear[myNest,myFold,myMap];

myNest[f_,x_,n_Integer]:= {x,n}//.{{a_,0}:>a,{a_,b_}:>{f@a,b-1}}

myFold[f_,x_,s_List]:= {x,s}//.{{a_,{}}:>a,{a_,{b_,c___}}:>{f[a,b],{c}}}

myMap[f_,s_List]:= Module[{r},{s,{}}//.{{{},r_}:>r, {{a_,b___},r_}:>{{b},Append[r,f@a]}}]