# How can I find these patterns' signatures?

I think I can explain it best starting with an example. I have the following lists:

{19, 19, 19, 19, 23, 19, 23}
{37, 53, 53, 53, 53, 37, 53}
{73, 59, 59, 59, 73, 73, 73}
{ 2, 83, 83, 83, 79,  2, 79}
{79, 41, 41, 41, 19, 79, 19}


(Yes, they're all primes.) I want to find patterns of returning values. The values themselves are not important, the place where they occur is. The first number maps to "a", and so do all occurences of that number. If a new number is encountered it is mapped to "b", and so on. For the example I would get

{a, a, a, a, b, a, b}
{a, b, b, b, b, a, b}
{a, b, b, b, a, a, a}
{a, b, b, b, c, a, c}
{a, b, b, b, c, a, c}


and finally I want to get a tally of all the different patterns:

{{1}, {a, a, a, a, b, a, b}}
{{1}, {a, b, b, b, b, a, b}}
{{1}, {a, b, b, b, a, a, a}}
{{2}, {a, b, b, b, c, a, c}}


I can do this with procedural programming, but I would like to learn how this is done with functional programming.

-

 Tally[ArrayComponents /@ lists]
(* {{{1, 1, 1, 1, 2, 1, 2}, 1},
{{1, 2, 2, 2, 2, 1, 2}, 1},
{{1, 2, 2, 2, 1, 1, 1}, 1},
{{1, 2, 2, 2, 3, 1, 3}, 2}}*)


Update 1: For completeness, to get the results using letters

Tally[(ArrayComponents /@ lists) /. n_Integer :> FromCharacterCode[n + 96]]
(* {{{"a", "a", "a", "a", "b", "a", "b"}, 1},
{{"a", "b", "b", "b", "b", "a", "b"}, 1},
{{"a", "b", "b", "b", "a", "a", "a"}, 1},
{{"a", "b", "b", "b", "c", "a", "c"}, 2}}  *)


Update 2: Alternative ways to map to letters

 (* thanks: @Mr.Wizard *)
Tally @ Characters @ FromCharacterCode[(ArrayComponents /@ lists) + 96]


or

 Tally@Map[FromCharacterCode, 96 + ArrayComponents /@ lists, {-1}]

-
Excellent! I had not seen ArrayComponents before –  The Toad Dec 24 '12 at 1:30
@rm-rf that's because it doesn't exist. ;-p –  Mr.Wizard Dec 24 '12 at 1:37
I don't normally vote for answers I can't test but I cannot resist the elegance. +1 –  Mr.Wizard Dec 24 '12 at 1:39
@Mr.W & rm-rf: thanks for the votes. Mr.Wizard: it is "New in 8" and "Updated in Version 9". –  kglr Dec 24 '12 at 2:51
If targeting speed this should be good: Tally @ Characters @ FromCharacterCode[(ArrayComponents /@ lists) + 96] –  Mr.Wizard Dec 25 '12 at 8:27

Update 12/25/12

After a bit of struggle, I came up with this method. no Do is used.

(*data*)
Clear["Global*"]
lst = {{19, 19, 19, 19, 23, 19, 23}, {37, 53, 53, 53, 53, 37, 53},
{73, 59, 59, 59, 73, 73, 73}, {2, 83, 83, 83, 79, 2,79},
{79, 41, 41, 41, 19, 79, 19}};
p = {a, b, c, d, e, f, g};(*that is what we need,7 letters max*)(*engine*)

(*engine*)
u = Map[Flatten, Map[DeleteDuplicates, Gather /@ lst, {2}]]
z = Map[MapThread[Rule, #] &, Map[{#, Take[p, Length[#]]} &, u]]
MapThread[(#1 /. #2) &, {lst, z}]

(* {{a, a, a, a, b, a, b},
{a, b, b, b, b, a, b},
{a, b, b, b, a, a, a},
{a, b, b, b, c, a, c},
{a, b, b, b, c, a, c}}  *)


Updated based on MrWizard suggestions. I'll keep my original complicated answer below since that is what I wrote first. But credit for this updated answer goes to MrWizard, so please do not upvote me based on this new answer or I'll get upset.

(*data*)
lst = {{19, 19, 19, 19, 23, 19, 23}, {37, 53, 53, 53, 53, 37,
53}, {73, 59, 59, 59, 73, 73, 73}, {2, 83, 83, 83, 79, 2,
79}, {79, 41, 41, 41, 19, 79, 19}};
p = {a, b, c, d, e, f, g};(*that is what we need,7 letters*)

(*engine*)
r = Gather /@ lst  (*note: Gather is listable *)


is a Do ok? I think I can get rid of it if I try harder.

(*data*)
lst = {{19, 19, 19, 19, 23, 19, 23},
{37, 53, 53, 53, 53, 37, 53},
{73, 59, 59, 59, 73, 73, 73},
{2, 83, 83, 83, 79, 2, 79},
{79, 41, 41, 41, 19, 79, 19}};
p = {a, b, c, d, e, f, g};  (*that is what we need, 7 letters*)

(* engine *)
r = Gather[#, #1 == #2 &] & /@ lst;
z = Last@Reap@Do[
rule =Rule[#1[[1]], #2] & @@@Transpose[{  r[[i]] , p[[1 ;; Length[r[[i]]]]]}];
Sow[lst[[i]] /. rule],
{i, 1, Length[r]}]

Tally[#] & /@ z


gives

(*{{{a, a, a, a, b, a, b}, {a, b, b, b, b, a, b}, {a, b, b, b, a, a,a},
{a, b, b, b, c, a, c}, {a, b, b, b, c, a, c}}}

{{{{a, a, a, a, b, a, b}, 1}, {{a, b, b, b, b, a, b},1},
{{a, b, b, b, a, a, a}, 1}, {{a, b, b, b, c, a, c}, 2}}}
*)

-
Just about every method brings something to the table, so I hope you don't delete this. However, you do seem to have some baroque constructs here, for example I believe Gather[#, #1 == #2 &] & /@ lst may be replaced with Gather /@ lst. May I make such changes to your answer? –  Mr.Wizard Dec 23 '12 at 17:23
Here is something for you to consider: Tally @ MapThread[# /. MapThread[Rule, {First /@ #2, Take[p, Length@#2]}] &, {lst, r}] –  Mr.Wizard Dec 23 '12 at 17:46

rules[list_]:=With[{vals = DeleteDuplicates[list]}, Thread[vals -> Range@Length@vals]]

vals = {{19, 19, 19, 19, 23, 19, 23},
{37, 53, 53, 53, 53, 37, 53},
{73, 59, 59, 59, 73, 73, 73},
{2, 83, 83, 83, 79, 2, 79},
{79, 41, 41, 41, 19, 79, 19}};

Tally[#/.rules[#]&/@vals]


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

and if you want it in terms of symbols,

Tally[(# /. rules[#]) /. x_Integer :> Symbol@FromCharacterCode[x + 96] & /@ vals]


{{{a, a, a, a, b, a, b}, 1}, {{a, b, b, b, b, a, b}, 1}, {{a, b, b, b, a, a, a}, 1}, {{a, b, b, b, c, a, c}, 2}}

-

I agree with Mr.Wizard that using integers is cleaner than generating symbols or strings (he also shows you a way to use strings). However, I find the following construct cleaner than using Module and incrementing a counter:

lists = {{19, 19, 19, 19, 23, 19, 23},
{37, 53, 53, 53, 53, 37, 53},
{73, 59, 59, 59, 73, 73, 73},
{2, 83, 83, 83, 79, 2, 79},
{79, 41, 41, 41, 19, 79, 19}};

patterns = # /. MapIndexed[# -> First@#2 &, DeleteDuplicates@#] & /@ lists;
Tally[patterns]


You can also use Thread (appropriately) instead of MapIndexed to get the same effect.

-
hm.... I added the Thread method before you posted this, and I quickly changed it to MapIndexed (since I think this question targets elegance rather than pure speed) before I noticed your post. –  Mr.Wizard Dec 23 '12 at 16:10
And now I see JxB has joined us. :^) –  Mr.Wizard Dec 23 '12 at 16:10

I'm not sure if this suits your style intentions but it's natural to me.

I used numbers rather than letters because it makes for cleaner code but you can use FromCharacterCode[96 + i++] if letters are required.

tab =
{{19, 19, 19, 19, 23, 19, 23},
{37, 53, 53, 53, 53, 37, 53},
{73, 59, 59, 59, 73, 73, 73},
{2, 83, 83, 83, 79, 2, 79},
{79, 41, 41, 41, 19, 79, 19}};

index = Module[{i = 1, f}, f[x_] := f[x] = i++; f /@ #] &;

index /@ tab // Tally // Column

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


index2 = # /. MapIndexed[# -> #2[[1]] &, DeleteDuplicates @ #] &;

By the way, for the rule based method you should add Dispatch` if sublists are long, or especially if there are many unique elements. –  Mr.Wizard Dec 23 '12 at 16:51