two list operations in mathematica - wolfram-mathematica

I have two list operations which I would like to ask for help. The way I implemented them is not very elegant, so I want to learn from you experts.
1) Suppose I have two lists, one is like {{0,2,4},{1,3,2},{2,0,4}} and the other is {{1,3,7},{2,4,6},{3,1,9}}. I want to either based on the value, or based on some criterion to filter through the first list, and then get the corresponding elements in the second. For example, based on value which is non-zero, I want to get {{3,7},{2,4,6},{3,9}}. Based on the condition greater than 2, I want to get {{7},{4},{9}}.
2) I have a list such as {{{1,2},{1,1}},{{1,3},{2,4}},{{1,2},{2,3}},{{1,4},{3,3}}}. I want to form {{{1,2},{{1,1},{2,3}}},{{1,3},{{2,4}}},{{1,4},{{3,3}}}. That is, I want to group those second lists if the first element is the same. How can I do this in a beautiful way?
Many thanks.

For the first part, you want Pick:
In[27]:= Pick[{{1,3,7},{2,4,6},{3,1,9}},{{0,2,4},{1,3,2},{2,0,4}},_?Positive]
Out[27]= {{3,7},{2,4,6},{3,9}}
In[28]:= Pick[{{1,3,7},{2,4,6},{3,1,9}},{{0,2,4},{1,3,2},{2,0,4}},_?(#>2&)]
Out[28]= {{7},{4},{9}}
For the second question, GatherBy gets you most of the way there:
In[29]:= x = GatherBy[{{{1, 2}, {1, 1}}, {{1, 3}, {2, 4}}, {{1, 2},
{2, 3}}, {{1, 4}, {3, 3}}}, First]
Out[29]= {{{{1, 2}, {1, 1}}, {{1, 2}, {2, 3}}}, {{{1, 3},
{2, 4}}}, {{{1, 4}, {3, 3}}}}
And then you can apply a rule to clean things up a bit:
In[30]:= x /. l:{{a_, _}..} :> {a, Last /# l}
Out[30]= {{{1, 2}, {{1, 1}, {2, 3}}}, {{1, 3}, {{2, 4}}},
{{1, 4}, {{3, 3}}}}

As Michael said, Pick is definitely the way to go for the first one.
For the second part, I'd like to offer an alternative that lets you do this in one line: SelectEquivalents. (I know, rather self promoting, but I use this function a lot.) To get the result your looking for, simply enter
In[1] := SelectEquivalents[ <list>, First, Last, {#1,#2}& ]
Out[1]:= {{{1, 2}, {{1, 1}, {2, 3}}}, {{1, 3}, {{2, 4}}}, {{1, 4}, {{3, 3}}}}
Internally, SelectEquivalents uses Reap and Sow, so First tags each element in <list>, Last transforms the element into the form we wish to use, and {#1, #2}& returns a list with elements of the form {Tag, {<items with that tag>}}. The advantage is that you get to specify everything in one step getting you what you want without subsequent transformations.

Related

binning an array to create sum domains array

In Mathematica - how do I bin an array to create a new array which consist from sum domains of the old array with a given size ???
Example:
thanks.
This is slightly simpler than #ChrisDegnen's solution. Given the same definition of array the expression
Map[Total, Map[Flatten, Partition[array, {2, 2}], {2}], {2}]
produces
{{4, 10}, {8, 10}}
If you prefer, this expression
Apply[Plus, Map[Flatten, Partition[array, {2, 2}], {2}], {2}]
uses Apply and Plus rather than Map and Total but is entirely equivalent.
This works for the example but a generalised version would need more work.
array =
{{1, 1, 1, 2},
{1, 1, 3, 4},
{2, 2, 2, 3},
{2, 2, 2, 3}};
Map[Total,
Map[Flatten,
Map[Transpose,
Map[Partition[#, 2] &, Partition[array, 2], 2],
2], {2}], {2}]
% // MatrixForm
4 10
8 10

Fast extraction of elements from nested lists

This is a basic question on list manipulation in Mathematica.
I have a large list where each element has the following schematic form: {List1, List2,Number}. For e.g.,
a = {{{1,2,3},{1,3,2},5},{{1,4,5},{1,0,2},10},{{4,5,3},{8,3,4},15}}}.
I want to make a new lists which only has some parts from each sublist. Eg., pick out the third element from each sublist to give {5,10,15} from the above. Or drop the third element to return {{{1,2,3},{1,3,2}},{{1,4,5},{1,0,2}},{{4,5,3},{8,3,4}}}.
I can do this by using the table command to construct new lists, e.g.,
Table[a[[i]][[3]],{i,1,Length[a]}
but I was wondering if there was a must faster way which would work on large lists.
In Mathematica version 5 and higher, you can use the keyword All in multiple ways to specify a list traversal.
For instance, instead of your Table, you can write
a[[All,3]]
Here Mathematica converts All into all acceptable indices for the first dimension then takes the 3rd one of the next dimension.
It is usually more efficient to do this than to make a loop with the Mathematica programming language. It is really fine for homogenous lists where the things you want to pick or scan through always exist.
Another efficient notation and shortcut is the ;; syntax:
a[[ All, 1 ;; 2]]
will scan the first level of a and take everything from the 1st to the 2st element of each sublist, exactly like your second case.
In fact All and ;; can be combined to any number of levels. ;; can even be used in a way similar to any iterator in Mathematica:
a[[ start;;end;;step ]]
will do the same things as
Table[ a[[i]], {i,start,end,step}]
and you can omit one of start, end or step, it is filled with its default of 1, Length[(of the implicit list)], and 1.
Another thing you might want to lookup in Mathematica's Help are ReplacePart and MapAt that allow programmatic replacement of structured expressions. The key thing to use this efficiently is that in ReplacePart you can use patterns to specify the coordinates of the things to be replaced, and you can define functions to apply to them.
Example with your data
ReplacePart[a, {_, 3} -> 0]
will replace every 3rd part of every sublist with 0.
ReplacePart[a, {i : _, 3} :> 2*a[[i, 3]]]
will double every 3rd part of every sublist.
As the authors suggest, the approaches based on Part need well-formed data, but Cases is built for robust separation of Lists:
Using your a,
a = {{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}};
Cases[a,{_List,_List,n_}:>n,Infinity]
{5, 10, 15}
The other pieces of a record can be extracted by similar forms.
Part-based approaches will gag on ill-formed data like:
badA = {{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}, {baddata}, {{1, 2, 3}, 4}};
badA[[All,3]]
{{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}, {baddata}, {{1, 2, 3},
4}}[[All, 3]]
,but Cases will skip over garbage, operating only on conforming data
Cases[badA, {_List, _List, s_} :> s, Infinity]
{5, 10, 15}
hth,
Fred Klingener
You can use Part (shorthand [[...]]) for this :
a[[All, 3]]
a[[All, {1, 2}]]

How to do Tally-like operation on list based on elements' total in Mathematica

For example, I have a list like:
{{1, 2, 3}, {6}, {4, 5}, {1, 6}, {2, 2, 3, 2}, {9}, {7}, {2, 5}}
And I want to get a tallied list based on the total of the lists' elements.
In this case, I want the output to be:
{{6, {{1, 2, 3}, {6}}, {7, {{2, 5}, {1, 6}, {7}}}, {9, {{4, 5}, {2, 2, 3, 2}, {9}}}}}
How to do this conveniently in Mathematica?
Thanks a lot.
Here's my attempt - a little simpler than Yoda's
lst = {{1, 2, 3}, {6}, {4, 5}, {1, 6}, {2, 2, 3, 2}, {9}, {7}, {2, 5}};
{Total#First##, #} & /# GatherBy[lst, Total]
If you don't want repeated elements, then you could use
{Total#First##, Union[#]} & /# GatherBy[lst, Total]
Or if you really wanted a tally-like operation
{Total#First##, Tally[#]} & /# GatherBy[lst, Total]
While I would probably do this just as #Simon did, let us not forget that Reap and Sow can be used as well:
Reap[Sow[#, Total[#]] & /# lst, _, List][[2]]
where lst is the original list. This will be somewhat less efficient than the GatherBy- based code, but also pretty fast. One can speed up the above code about 1.5 times by rewriting it as
Reap[Sow ### Transpose[{lst, Total[lst, {2}]}], _, List][[2]]
in which case it becomes about 1.5 times slower than the code based on GatherBy. Note that the speed difference between the two methods is not very dramatic here, because the list is ragged and therefore not packed, and GatherBy does not have here the speed advantage it normally enjoys for packed arrays.
Don't overlook Tr. This is shorter and faster:
{Tr##, {##}} & ### GatherBy[lst, Tr]

Using Mathematica Gather/Collect properly

How do I use Mathematica's Gather/Collect/Transpose functions to convert:
{ { {1, foo1}, {2, foo2}, {3, foo3} }, { {1, bar1}, {2, bar2}, {3, bar3} } }
to
{ {1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3} }
EDIT: Thanks! I was hoping there was a simple way, but I guess not!
Here is your list:
tst = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, bar3}}}
Here is one way:
In[84]:=
Flatten/#Transpose[{#[[All,1,1]],#[[All,All,2]]}]&#
GatherBy[Flatten[tst,1],First]
Out[84]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}
EDIT
Here is a completely different version, just for fun:
In[106]:=
With[{flat = Flatten[tst,1]},
With[{rules = Dispatch[Rule###flat]},
Map[{#}~Join~ReplaceList[#,rules]&,DeleteDuplicates[flat[[All,1]]]]]]
Out[106]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}
EDIT 2
And here is yet another way, using linked lists and inner function to accumulate the results:
In[113]:=
Module[{f},f[x_]:={x};
Apply[(f[#1] = {f[#1],#2})&,tst,{2}];
Flatten/#Most[DownValues[f]][[All,2]]]
Out[113]= {{1,foo1,bar1},{2,foo2,bar2},{3,foo3,bar3}}
EDIT 3
Ok, for those who consider all of the above too complicated, here is a really simple rule - based solution:
In[149]:=
GatherBy[Flatten[tst, 1], First] /. els : {{n_, _} ..} :> {n}~Join~els[[All, 2]]
Out[149]= {{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}
Perhaps easier:
tst = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, bar3}}};
GatherBy[Flatten[tst, 1], First] /. {{k_, n_}, {k_, m_}} -> {k, n, m}
(*
-> {{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}
*)
MapThread
If the "foo" and "bar" sublists are guaranteed to be aligned with one another (as they are in the example) and if you will consider using functions other than Gather/Collect/Transpose, then MapThread will suffice:
data={{{1,foo1},{2,foo2},{3,foo3}},{{1,bar1},{2,bar2},{3,bar3}}};
MapThread[{#1[[1]], #1[[2]], #2[[2]]}&, data]
result:
{{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}
Pattern Matching
If the lists are not aligned, you could also use straight pattern matching and replacement (although I wouldn't recommend this approach for large lists):
data //.
{{h1___, {x_, foo__}, t1___}, {h2___, {x_, bar_}, t2___}} :>
{{h1, {x, foo, bar}, t1}, {h2, t2}} // First
Sow/Reap
A more efficient approach for unaligned lists uses Sow and Reap:
Reap[Cases[data, {x_, y_} :> Sow[y, x], {2}], _, Prepend[#2, #1] &][[2]]
Also just for fun ...
DeleteDuplicates /# Flatten /# GatherBy[Flatten[list, 1], First]
where
list = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3,
bar3}}}
Edit.
Some more fun ...
Gather[#][[All, 1]] & /# Flatten /# GatherBy[#, First] & #
Flatten[list, 1]
Here is how I would do it using the version of SelectEquivalents I posted in What is in your Mathematica tool bag?
l = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, bar3}}};
SelectEquivalents[
l
,
MapLevel->2
,
TagElement->(#[[1]]&)
,
TransformElement->(#[[2]]&)
,
TransformResults->(Join[{#1},#2]&)
]
This method is quite generic. I used to use functions such as GatherBy before for treating huge lists I generate in Monte-Carlo simulations. Now with SelectEquivalents implementations for such operations are much more intuitive. Plus it is based on the combination Reap and Sow which is very fast in Mathematica.
Until the question is updated to be more clear and specific, I will assume what I want to, and suggest this:
UnsortedUnion ### #~Flatten~{2} &
See: UnsortedUnion
Maybe a bit overcomplicated, but:
lst = {{{1, foo1}, {2, foo2}, {3, foo3}}, {{1, bar1}, {2, bar2}, {3, bar3}}}
Map[
Flatten,
{Scan[Sow[#[[1]]] &,
Flatten[lst, 1]] // Reap // Last // Last // DeleteDuplicates,
Scan[Sow[#[[2]], #[[1]]] &,
Flatten[lst, 1]] // Reap // Last} // Transpose
]
(*
{{1, foo1, bar1}, {2, foo2, bar2}, {3, foo3, bar3}}
*)
Here's how this works:
Scan[Sow[#[[1]]] &,
Flatten[lst, 1]] // Reap // Last // Last // DeleteDuplicates
returns the unique first elements of each of your list items, in the order they were sown (since DeleteDuplicates never reorders elements). Then,
Scan[Sow[#[[2]], #[[1]]] &,
Flatten[lst, 1]] // Reap // Last
exploits the fact that Reap returns expressions sown with difference tags in different lists. So then put them together, and transpose.
This has the disadvantage that we scan twice.
EDIT:
This
Map[
Flatten,
{DeleteDuplicates##[[1]],
Rest[#]} &#Last#Reap[
Scan[(Sow[#[[1]]]; Sow[#[[2]], #[[1]]];) &,
Flatten[lst, 1]]] // Transpose
]
is (very) slightly faster, but is even less readable...

MapThread for any combination of variables

I have a set of regular (mod 5) matrices N2 and I would like to get the group generated by these matrices in Mathematica:
My approach was to use a function f doing the matrix multiplication and g for mod 5 and then I wanted to use MapThread
M= Function[{x,y},x.y];
g = Function[z, Mod[z, 5]]
g /# MapThread[M, {N2,N2}]
The problem is that MapThread is inserting only pairs of elements that are at the same position in the lists. I would like to insert any pair of elements in N. To get the group generated by the matrices in N I would just repeat this and update N2 every time.
E.g. let N2 ={A,B}
g /# MapThread[M, {N2,N2}]
would return {B^2,A^2}, while I want it to return any product of matrices in N2, i.e. {A^2,AB,BA,B^2}.
I'm not sure whether I understand your question, but if your intention is to get all combinations of the two matrices A,B you could use Tuples combined with Apply (which you may use in its functional form with square brackets or as many here do in initially cryptic prefix operator form ### = Apply at level 1):
In[24]:= Dot ### Tuples[{A, B}, 2]
Out[24]= {A.A, A.B, B.A, B.B}
In this case you need Outer:
In[27]:= n = RandomInteger[{1, 5}, {3, 2, 2}];
In[28]:= Outer[mFunc, n, n, 1]
Out[28]= {{mFunc[{{3, 5}, {2, 4}}, {{3, 5}, {2, 4}}],
mFunc[{{3, 5}, {2, 4}}, {{3, 4}, {4, 3}}],
mFunc[{{3, 5}, {2, 4}}, {{4, 4}, {5, 1}}]}, {mFunc[{{3, 4}, {4,
3}}, {{3, 5}, {2, 4}}],
mFunc[{{3, 4}, {4, 3}}, {{3, 4}, {4, 3}}],
mFunc[{{3, 4}, {4, 3}}, {{4, 4}, {5, 1}}]}, {mFunc[{{4, 4}, {5,
1}}, {{3, 5}, {2, 4}}],
mFunc[{{4, 4}, {5, 1}}, {{3, 4}, {4, 3}}],
mFunc[{{4, 4}, {5, 1}}, {{4, 4}, {5, 1}}]}}
In[29]:= n
Out[29]= {{{3, 5}, {2, 4}}, {{3, 4}, {4, 3}}, {{4, 4}, {5, 1}}}

Resources