Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Is there way to construct oneliner as pure function(s), so that I enter mylist only on one place - on the end of line. And that function return the same result as last line bellow but paired with mylist. So the result should look like this:

{{1, {8}}, {2, {2, 4, 6}}, {4, {1}}, {5, {5}}, {7, {3, 7}}}
mylist = {4, 2, 7, 2, 5, 2, 7, 1};    
alldiffelem = Sort@DeleteDuplicates@mylist    
(* {1, 2, 4, 5, 7} *)
(Flatten@Position[mylist, #]) & /@ alldiffelem    
(* {{8}, {2, 4, 6}, {1}, {5}, {3, 7}} *)
share|improve this question
    
Do you specifically want a "one-liner" constructed from anonymous functions? I can do that, but I think my present two-definition form is more clear. –  Mr.Wizard May 2 at 11:55
add comment

5 Answers 5

Here is an approach using Sow and Reap:

Last@Reap[MapThread[Sow, {Range[Length[mylist]], mylist}], _, List]

yielding

{{4, {1}}, {2, {2, 4, 6}}, {7, {3, 7}}, {5, {5}}, {1, {8}}}

if you wish to sort:

SortBy[Last@Reap[MapThread[Sow, {Range[Length[mylist]],mylist}], _, List], First]

yielding:

{{1, {8}}, {2, {2, 4, 6}}, {4, {1}}, {5, {5}}, {7, {3, 7}}}
share|improve this answer
1  
Nice. Reap and Sow seem more intuitive tools for this sort of task. Would be interested in timings on large lists. This is a bit more concise: Last@Reap[MapIndexed[Sow[First[#2], #1] &, mylist], _, {#1, #2} &] –  Mike Honeychurch May 2 at 11:35
1  
An alternative to the SortBy method that appears to be twice as fast is: Last @ Reap[MapThread[Sow, {Range @ Length @ mylist, mylist}], Union @ mylist, List] –  Mr.Wizard May 2 at 12:05
add comment

This is almost a duplicate of Ordering function with recognition of duplicates. It is related to Efficiently finding the positions of a large list of targets in another, even larger list but since you apparently want all unique elements I believe it is closer to the first.

Using myOrdering from the first referenced question:

myOrdering[a_List] := GatherBy[Ordering @ a, a[[#]] &]

fn[a_List] := {Union @ a, myOrdering @ a}\[Transpose]

fn @ mylist
{{1, {8}}, {2, {2, 4, 6}}, {4, {1}}, {5, {5}}, {7, {3, 7}}}

Timings

Responding to Mike Honeychurch's implicit request for timings, here is my function (in its current version) versus both ubpdqn and his Sow/Reap method, performed in version 7.

mylist = RandomInteger[2*^5, 5*^5];

fn @ mylist // Timing // First
Last@Reap[MapThread[Sow, {Range[Length[mylist]], mylist}], _, List] // Timing // First
Last@Reap[MapIndexed[Sow[First[#2], #1] &, mylist], _, List]        // Timing // First
0.514

3.776

4.259

Note that both Sow/Reap methods are the un-sorted variation; adding a sort would incur an additional overhead.

share|improve this answer
    
this is neat...these methods always seem much faster than sowing and reaping but I just like playing with Reap and Sow –  ubpdqn May 2 at 11:25
    
@ubpdqn I like Sow and Reap too. +1 on your answer. By the way I just fixed my code which was broken due to confusing myself re: sorting. –  Mr.Wizard May 2 at 11:34
add comment

Competitive with fastest so far in general, and often considerably faster (e.g., when duplication of elements is higher, as in RandomInteger[5000, 1000000] about 3 to 4X faster):

Module[{o, d = DeleteDuplicates@mylist, r = Range@Length@mylist},
 o = Ordering@d; 
 Transpose[{d, GatherBy[r, mylist[[#]] &]}][[o]]]

As a pure function:

With[{d = DeleteDuplicates@#, l = #, r = Range@Length@#},
      Transpose[{d, GatherBy[r, l[[#]] &]}][[Ordering@d]]] &[mylist]
share|improve this answer
add comment

Using SparseArray and changing the setting of TreatRepeatedEntries suboption (of SparseArrayOptions in SystemOptions:

System`SetSystemOptions["SparseArrayOptions"->{"TreatRepeatedEntries"->(ToString[{##}]&)}];
xx = SparseArray[mylist -> Range[Length[mylist]]]["NonzeroValues"] // ToExpression;
System`SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> First}];
yy = SparseArray[mylist -> mylist]["NonzeroValues"];
Transpose[{yy, xx}]
(* {{4, 1}, {2, {2, 4, 6}}, {7, {3, 7}}, {5, 5}, {1, 8}}  *)

(See O. Rubenko's answer Fast 2D binning for this undocumented suboption. See also Optimizing 2D binning code)

Note: this approach works in the current form for "target lists of positive integers of limited range" (e.g., on my machine, it works for a list of length 50,000, but 100 000 does not) . (thanks: @rasher).

share|improve this answer
    
    
Thank you @Alexey; added the links. –  kguler May 3 at 7:46
    
You should note this is only usable in this form with target lists of positive integers of limited range. –  rasher May 3 at 7:54
    
@rasher, thanks; just updated with the suggested note. –  kguler May 3 at 8:49
add comment

mylist only on one place - on the end of line

Sort@(Function[{x, y}, 
  Thread[List[y, Flatten@Position[x, #] & /@ y]]] @@ {#,DeleteDuplicates@#}) &@mylist

{{1, {8}}, {2, {2, 4, 6}}, {4, {1}}, {5, {5}}, {7, {3, 7}}}

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.