MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Tally

  • To: mathgroup at smc.vnet.net
  • Subject: [mg87061] Re: Tally
  • From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
  • Date: Sun, 30 Mar 2008 01:18:41 -0500 (EST)
  • References: <fsa5eq$adg$1@smc.vnet.net>

Armen Kocharyan wrote:

> I'm trying the following:
>
>
> *Dlist = {{{0,1},{0,1}},{{1,0},{1,0}},{{1,0},{0,1}},{{0,1},{1,0}}};*
>
> *Tally[Dlist,(#1=== #2) \[Or] *
>
> *            (#1[[1]][[1]]=== #2[[1]][[2]] \[And] *
>
> *             #1[[1]][[2]]=== #2[[1]][[1]] \[And] *
>
> *             #1[[2]][[1]]=== #2[[2]][[2]] \[And] *
>
> *             #1[[2]][[2]]=== #2[[2]][[1]] )&]*
>
>
>
> The output is:
>
> *{{{{0,1},{0,1}},1},{{{1,0},{1,0}},1},{{{1,0},{0,1}},2}}*
>
> instead of
>
> *{{{{0,1},{0,1}},2},{{{1,0},{0,1}},2}}*
>
>
>
> If I remove the last member from DList
>
> *Dlist = {{{0,1},{0,1}},{{1,0},{1,0}},{{1,0},{0,1}}};*
>
> then I got a correct answer
>
> *{{{{0,1},{0,1}},2},{{{1,0},{0,1}},1}}.*

Here is solution to this issue, by writing our own Tally function.  Note
that code of the function myTally is only one possibility among many and
that there has been no attempt to optimize it for speed (though it takes
about half a second to process 100,000 pairs of pairs).

We assume that the matrix entries are only 0 or 1 (_Integer). The idea
is, therefore, to look at en entry of the form {{a, b}, {c, d}} (where
a, b, c, and d are in {0, 1}) as if it were, having flatten the matrix,
a binary representation of a decimal number.

For instance, say we have the entry {{0, 1}, {0, 1)}. We look at it as
if it were 0101 (binary), i.e. 5 in decimal.

Also, we check the "reverse" representation of the entry (that is {{b,
a}, {d, c}}) and take the minimum value of both representation as the
canonical form for this equivalent entries.

In our example, the "reverse" entry of {{0, 1}, {0, 1)} is {{1, 0}, {1,
0)}, that is 1010 in binary or 10 in decimal.

So both entries {{0, 1}, {0, 1)} and {{1, 0}, {1, 0)} are going to be
encoded as "5" in the code below.

When the whole list is processed, Tally is applied, and finally we
decode the decimal entries into their pair of pairs equivalent.

Well, I hope this makes sense!

Here is the code for myTally, followed by some tests.

In[1]:= myTally[lst_List] :=
 Module[{l1, l2, l3, l4},
  l1 = FromDigits[#, 2] & /@ Flatten /@ lst;
  l2 = FromDigits[#, 2] & /@ Flatten /@ Map[Reverse, lst, {2}];
  l3 = Min /@ Transpose[{l1, l2}]; l1 =.; l2 =.;
  l4 = {PadLeft[IntegerDigits[First@#, 2], 4], Last@#} & /@ Tally@l3;
  l3 =.;
  {Partition[First@#, 2], Last@#} & /@ l4
  ]

In[2]:= Dlist = {{{0, 1}, {0, 1}}, {{1, 0}, {1, 0}}, {{1, 0}, {0,
     1}}, {{0, 1}, {1, 0}}};
myTally[Dlist]

Out[3]= {{{{0, 1}, {0, 1}}, 2}, {{{0, 1}, {1, 0}}, 2}}

In[4]:= Dlist = RandomInteger[{0, 1}, {10, 2, 2}]
myTally[Dlist]

Out[4]= {{{0, 0}, {1, 1}}, {{0, 1}, {1, 0}}, {{0, 1}, {0, 0}}, {{0,
   0}, {0, 0}}, {{0, 1}, {1, 1}}, {{1, 0}, {0, 1}}, {{1, 1}, {1,
   1}}, {{1, 0}, {1, 0}}, {{0, 0}, {1, 0}}, {{1, 0}, {1, 1}}}

Out[5]= {{{{0, 0}, {1, 1}}, 1}, {{{0, 1}, {1, 0}},
  2}, {{{0, 1}, {0, 0}}, 1}, {{{0, 0}, {0, 0}}, 1}, {{{0, 1}, {1, 1}},
   2}, {{{1, 1}, {1, 1}}, 1}, {{{0, 1}, {0, 1}},
  1}, {{{0, 0}, {0, 1}}, 1}}

In[6]:= Dlist = RandomInteger[{0, 1}, {10^5, 2, 2}];
myTally[Dlist] // Timing

Out[7]= {0.633001, {{{{1, 1}, {0, 0}}, 6366}, {{{0, 0}, {0, 1}},
   12467}, {{{1, 1}, {0, 1}}, 12633}, {{{0, 1}, {0, 1}},
   12484}, {{{0, 1}, {0, 0}}, 12377}, {{{0, 1}, {1, 0}},
   12402}, {{{0, 0}, {1, 1}}, 6278}, {{{0, 1}, {1, 1}},
   12473}, {{{0, 0}, {0, 0}}, 6303}, {{{1, 1}, {1, 1}}, 6217}}}


You can find below a step by step evaluation of the code with some
extras that should help to understand what is going on.


In[8]:= Dlist = {{{0, 1}, {0, 1}}, {{1, 0}, {1, 0}}, {{1, 0}, {0,
     1}}, {{0, 1}, {1, 0}}};

In[9]:= Flatten /@ Dlist

Out[9]= {{0, 1, 0, 1}, {1, 0, 1, 0}, {1, 0, 0, 1}, {0, 1, 1, 0}}

In[10]:= l1 = FromDigits[#, 2] & /@ Flatten /@ Dlist

Out[10]= {5, 10, 9, 6}

In[11]:= Map[Reverse, Dlist, {2}]

Out[11]= {{{1, 0}, {1, 0}}, {{0, 1}, {0, 1}}, {{0, 1}, {1, 0}}, {{1,
   0}, {0, 1}}}

In[12]:= Flatten /@ Map[Reverse, Dlist, {2}]

Out[12]= {{1, 0, 1, 0}, {0, 1, 0, 1}, {0, 1, 1, 0}, {1, 0, 0, 1}}

In[13]:= l2 =
 FromDigits[#, 2] & /@ Flatten /@ Map[Reverse, Dlist, {2}]

Out[13]= {10, 5, 6, 9}

In[14]:= Transpose[{l1, l2}]

Out[14]= {{5, 10}, {10, 5}, {9, 6}, {6, 9}}

In[15]:= l3 = Min /@ Transpose[{l1, l2}]

Out[15]= {5, 5, 6, 6}

In[16]:= Tally@l3

Out[16]= {{5, 2}, {6, 2}}

In[17]:= {IntegerDigits[First@#, 2], Last@#} & /@ Tally@l3

Out[17]= {{{1, 0, 1}, 2}, {{1, 1, 0}, 2}}

In[18]:= l4 = {PadLeft[IntegerDigits[First@#, 2], 4], Last@#} & /@
  Tally@l3

Out[18]= {{{0, 1, 0, 1}, 2}, {{0, 1, 1, 0}, 2}}

In[19]:= {Partition[First@#, 2], Last@#} & /@ l4

Out[19]= {{{{0, 1}, {0, 1}}, 2}, {{{0, 1}, {1, 0}}, 2}}


Best regards,
--
Jean-Marc


  • Prev by Date: Re: Dynamic and J/Link
  • Next by Date: Re: Re: Re: Mathematica notebooks the best method
  • Previous by thread: Re: Tally
  • Next by thread: Colorfunction based upon flux direction