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...
Related
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
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]
I am still not good working with lists in Mathematica the functional way. Here is a small problem that I'd like to ask what is a good functional way to solve.
I have say the following list made up of points. Hence each element is coordinates (x,y) of one point.
a = {{1, 2}, {3, 4}, {5, 6}}
I'd like to traverse this list, and every time I find a point whose y-coordinate is say > 3.5, I want to generate a complex conjugate point of it. At the end, I want to return a list of the points generated. So, in the above example, there are 2 points which will meet this condition. Hence the final list will have 5 points in it, the 3 original ones, and 2 complex conjugtes ones.
I tried this:
If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, #] & /# a
but I get this
{{1, 2}, {{3, 4}, {3, -4}}, {{5, 6}, {5, -6}}}
You see the extra {} in the middle, around the points where I had to add a complex conjugate point. I'd like the result to be like this:
{{1, 2}, {3, 4}, {3, -4}, {5, 6}, {5, -6}}
I tried inserting Flatten, but did not work, So, I find myself sometimes going back to my old procedural way, and using things like Table and Do loop like this:
a = {{1, 2}, {3, 4}, {5, 6}}
result = {};
Do[
If[a[[i, 2]] > 3.5,
{
AppendTo[result, a[[i]]]; AppendTo[result, {a[[i, 1]], -a[[i, 2]]}]
},
AppendTo[result, a[[i]]]
],
{i, 1, Length[a]}
]
Which gives me what I want, but not functional solution, and I do not like it.
What would be the best functional way to solve such a list operation?
update 1
Using the same data above, let assume I want to make a calculation per each point as I traverse the list, and use this calculation in building the list. Let assume I want to find the Norm of the point (position vector), and use that to build a list, whose each element will now be {norm, point}. And follow the same logic as above. Hence, the only difference is that I am making an extra calculation at each step.
This is what I did using the solution provided:
a = {{1, 2}, {3, 4}, {5, 6}}
If[#[[2]] > 3.5,
Unevaluated#Sequence[ {Norm[#], #}, {Norm[#], {#[[1]], -#[[2]]}}],
{Norm[#], #}
] & /# a
Which gives what I want:
{ {Sqrt[5],{1,2}}, {5,{3,4}}, {5,{3,-4}}, {Sqrt[61],{5,6}}, {Sqrt[61],{5,-6}} }
The only issue I have with this, is that I am duplicating the call to Norm[#] for the same point in 3 places. Is there a way to do this without this duplication of computation?
This is how I currently do the above, again, using my old procedural way:
a = {{1, 2}, {3, 4}, {5, 6}}
result = {};
Do[
o = Norm[a[[i]]];
If[a[[i, 2]] > 3.5,
{
AppendTo[result, {o, a[[i]]}]; AppendTo[result, {o, {a[[i, 1]], -a[[i, 2]]}}]
},
AppendTo[result, {o, a[[i]]}]
],
{i, 1, Length[a]}
]
And I get the same result as the functional way, but in the above, since I used a temporary variable, I am doing the calculation one time per point.
Is this a place for things like sow and reap? I really never understood well these 2 functions. If not, how would you do this in functional way?
thanks
One way is to use Sequence.
Just a minor modification to your solution:
If[#1[[2]] > 3.5, Unevaluated#Sequence[#1, {#1[[1]], -#1[[2]]}], #1] & /# a
However, a plain ReplaceAll might be simpler:
a /. {x_, y_} /; y > 3.5 :> Sequence[{x, y}, {x, -y}]
This type of usage is the precise reason Rule and RuleDelayed have attribute SequenceHold.
Answer to update 1
I'd do it in two steps:
b = a /. {x_, y_} /; y > 3.5 :> Sequence[{x, y}, {x, -y}]
{Norm[#], #}& /# b
In a real calculation there's a chance you'd want to use the norm separately, so a Norm /# b might do
While Mathematica can simulate functional programming paradigms quite well, you might consider using Mathematica's native paradigm -- pattern matching:
a = {{1,2},{3,4},{5,6}}
b = a /. p:{x_, y_ /; y > 3.5} :> Sequence[p, {x, -y}]
You can then further transform the result to include the Norms:
c = Cases[b, p_ :> {Norm#p, p}]
There is no doubt that using Sequence to generate a very large list is not as efficient as, say, pre-allocating an array of the correct size and then updating it using element assignments. However, I usually prefer clarity of expression over such micro-optimization unless said optimization is measured to be crucial to my application.
Flatten takens a second argument that specifies the depth to which to flatten. Thus, you could also do the following.
a = {{1, 2}, {3, 4}, {5, 6}};
Flatten[If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, {#}] & /# a, 1]
The most serious problem with your Do loop is the use of AppendTo. This will be very slow if result grows long. The standard way to deal with lists that grow as the result of a procedure like this is to use Reap and Sow. In this example, you can do something like so.
new = Reap[
Do[If[el[[2]] > 3.5, Sow[{el[[1]], -el[[2]]}]],
{el, a}]][[2, 1]];
Join[a, new]
To answer your edit, use With (or Module) if you're going to use something expensive more than once.
Here's my version of the problem in your edit:
a = {{1, 2}, {3, 4}, {5, 6}};
Table[With[{n = Norm[x]},
Unevaluated#Sequence[{n, x},
If[x[[2]] > 3.5, {n, {1, -1} x}, Unevaluated#Sequence[]]]],
{x, a}]
The structure of the above could be modified for use in a Map or ReplaceAll version, but I think that Table is clearer in this case. The unevaluated sequences are a little annoying. You could instead use some undefined function f then replace f with Sequence at the end.
Mark's Sow/Reap code does not return the elements in the order requested. This does:
a = {{1, 2}, {3, 4}, {5, 6}};
Reap[
If[Sow[#][[2]] > 3.5, Sow[# {1, -1}]] & /# a;
][[2, 1]]
You may use join with Apply(##):
Join ## ((If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, {#}]) & /# a)
I have a list of pairs of values in mathematica, for example List= {{3,1},{5,4}}.
How do I change the first element (3 & 5) if the second element does not reach a threshold. For example, if the second parts are below 2 then i wish the first parts to go to zero. so that list then = {{0,1},{5,4}}. Some of these lists are extremely long so manually doing it is not an option, unfortunately.
Conceptually, the general way is to use Map. In your case, the code would be
In[13]:= lst = {{3, 1}, {5, 4}}
Out[13]= {{3, 1}, {5, 4}}
In[14]:= thr = 2
Out[14]= 2
In[15]:= Map[{If[#[[2]] < thr, 0, #[[1]]], #[[2]]} &, lst]
Out[15]= {{0, 1}, {5, 4}}
The # symbol here stands for the function argument. You can read more on pure functions here. Double square brackets stand for the Part extraction. You can make it a bit more concise by using Apply on level 1, which is abbreviated by ###:
In[27]:= {If[#2 < thr, 0, #], #2} & ### lst
Out[27]= {{0, 1}, {5, 4}}
Note however that the first method is several times faster for large numerical lists. An even faster, but somewhat more obscure method is this:
In[29]:= Transpose[{#[[All, 1]]*UnitStep[#[[All, 2]] - thr], #[[All, 2]]}] &[lst]
Out[29]= {{0, 1}, {5, 4}}
It is faster because it uses very optimized vectorized operations which apply to all sub-lists at once. Finally, if you want the ultimate performance, this procedural compiled to C version will be another factor of 2 faster:
fn = Compile[{{lst, _Integer, 2}, {threshold, _Real}},
Module[{copy = lst, i = 1},
For[i = 1, i <= Length[lst], i++,
If[copy[[i, 2]] < threshold, copy[[i, 1]] = 0]];
copy], CompilationTarget -> "C", RuntimeOptions -> "Speed"]
You use it as
In[32]:= fn[lst, 2]
Out[32]= {{0, 1}, {5, 4}}
For this last one, you need a C compiler installed on your machine.
Another alternative: Apply (###, Apply at level 1) and Boole (turns logical values in 1's and 0's):
lst = {{3, 1}, {5, 4}};
{#1 Boole[#2 >= 2], #2} & ### lst
An alternative approach might be to use substitution rules, and attach a condition (/;)
lst = {{3, 1}, {5, 4}};
lst /. {x_, y_ /; y < 2} -> {0, y}
output:
{{0, 1}, {5, 4}}
Assuming that your matrix is 2x2 and by second elemnt you mean the second row:
This should work:
If[A[[2, 1]] < 2 || A[[2, 2]] < 2, A[[2,1]] = 0 ]; A
You may have to change the variables, since your questions is kind of confusing. But that's the idea ;-)
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.