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.

Suppose I have the following list:

list = {a, b, c, d}

I want to generate this result:

{{f[a, a], f[a, b], f[a, c], f[a, d]}, {f[b, b], f[b, c],
  f[b, d]}, {f[c, c], f[c, d]}, {f[d, d]}}

What could be the shortest way?

The list elements can be anything and not necessarily sorted.

share|improve this question
    
Very nice question, but I assume (because of your previous contributions) that you already have an answer (maybe not the shortest). If not, please excuse :) –  eldo Jul 31 at 19:14
    
@eldo yes I have an answer but as you said it is not short. –  Algohi Jul 31 at 19:43
    
+1. I like this question. –  RunnyKine Jul 31 at 19:58
3  
Please see my updated answer. I argue against your choice of answer. –  Mr.Wizard Aug 1 at 16:13
1  
@eldo (1) halirutan's method is not the shortest, yet the question clearly asks for the shortest way. "Moving the goalposts" is generally discouraged here. (2) You will note that I removed my "duplicate" comment and replaced it with a related link. (3) Even as a moderator I am free to voice my opinion, which is all I have done. This is not the first time that I have argued for or against a particular choice. For example (7687) was really an extended comment arguing the superiority of kguler's answer. –  Mr.Wizard Aug 1 at 23:50

12 Answers 12

up vote 12 down vote accepted

How about a simple table?

Table[f @@ list[[{i, j}]], {i, 4}, {j, i, 4}]

If you want to use this for a general list, you should use Length[list] in the table iterators or maybe:

With[{n = Length[list]},
 Table[f @@ list[[{i, j}]], {i, n}, {j, i, n}]
]
share|improve this answer
1  
Long live Fortran? –  alancalvitti Jul 31 at 19:44
2  
@haliturutan About to upvote, but couldn't you replace the static 4 with Length@list ??? –  eldo Jul 31 at 19:53
1  
Your table is prettier than mine. –  Timothy Wofford Jul 31 at 19:56
    
+1 nice and simple. –  Algohi Jul 31 at 22:06
    
@eldo Hehe, haliturutan sounds a bit like Truthahn in German :-) I edited the answer. –  halirutan Aug 1 at 6:07

Solutions


Pick[
 Outer[f, list, list],
 UpperTriangularize@ConstantArray[True, {#, #} &@Length@list]
 ]

Using the new Composition shorthand:

Thread@*f @@@ MapIndexed[{#, list[[First@#2 ;;]]} &, list]

Timings


Testing with

list = Range[1000];

the first method takes 0.363 seconds to complete and the second takes 0.120 to complete. As a comparison, halirutan's Table method took 1.183 to complete. RunnyKine's is the fastest I have tested of the others, taking just 0.336 to complete. All times were measured with AbsoluteTiming.

share|improve this answer
2  
@Uh, I like the use of the new Composition operator! Also, I would have gone with MapIndexed too but maybe combined it with Outer(but I don't have Mathematica to test right now) –  sebhofer Jul 31 at 23:03
    
6 significant digits for the timing results? Is this warranted (even if there is no variation in timing between several runs)? –  Peter Mortensen Jul 31 at 23:17
    
@PeterMortensen Thanks for pointing this out; I was mindlessly copying what AbsoluteTiming told me, and didn't think about it. I looked through some other posts and they used three decimal numbers, so I updated and did the same. –  Pickett Jul 31 at 23:25
1  
Nice use of @* -- reasonably short and notably faster than my code. +1 :-) –  Mr.Wizard Aug 1 at 16:19

I don't believe anyone has posted exactly this formulation:

MapIndexed[#[[#2[[1]] ;;]] &, Outer[f, #, #]] &

Not terribly efficient but the question asked for shortest, not fastest.


Argument

Although not optimal my method is both more efficient and shorter than the presently Accepted one.
The question clearly asked for the shortest way. You should not alter your standard after the fact.

Update: also including Pickett's code

Please consider:

f1 = With[{n = Length[#]}, Table[f @@ #[[{i, j}]], {i, n}, {j, i, n}]] &; 

f2 = MapIndexed[#[[#2[[1]] ;;]] &, Outer[f, #, #]] &;

f3[x_] := Thread@*f @@@ MapIndexed[{#, x[[First@#2 ;;]]} &, x];

Needs["GeneralUtilities`"]

BenchmarkPlot[{f1, f2, f3}, RandomInteger[999, #] &, 2^Range[12]]

enter image description here

share|improve this answer

A few obfuscations via Listable:

Block[{f, op},
 SetAttributes[f, Listable];
 op[x_] := {f[x, x]};
 op[x_, y__] := Sequence[f[x, {x, y}], op[y]];
 {op @@ list}
 ]


Block[{f},
 SetAttributes[f, Listable];
 f @@@ Table[{list[[i]], list[[i ;;]]}, {i, 4}]
 ]


Module[{op1, op2},
 op1 = Function[{x, l}, f[x, l], Listable];
 op2 = {op1[#, {##}], Sequence @@ If[{##2} =!= {}, op2[##2], {}]} &;
 op2 @@ list
 ]

Update

The second method above is actually pretty good. The others aren't bad, but they are limited by $RecursionLimit. This one is slightly faster:

f4 = Block[{f},
    SetAttributes[f, Listable];
    f[First[#], #] & /@ NestList[Rest, #, Length[#] - 1]
    ] &;

Timings

Adding to Mr.Wizard's comparison:

f1 = With[{n = Length[#]}, 
    Table[f @@ #[[{i, j}]], {i, n}, {j, i, n}]] &;

f2 = MapIndexed[#[[#2[[1]] ;;]] &, Outer[f, #, #]] &;

f3[x_] := Thread@*f @@@ MapIndexed[{#, x[[First@#2 ;;]]} &, x];

f4 = Block[{f},
    SetAttributes[f, Listable];
    f[First[#], #] & /@ NestList[Rest, #, Length[#] - 1]
    ] &;

Needs["GeneralUtilities`"]

BenchmarkPlot[{f1, f2, f3, f4}, RandomInteger[999, #] &, 2^Range[12]]

Mathematica graphics

share|improve this answer

This is not the shortest, but faster than all except Pickett's (almost just as fast)

f4 = Thread@f[#[[1]], #] & /@ Partition[#, Length@#, 1, {1, 1}, {}] &

OR

 dP = Developer`PartitionMap;

Then:

f5 = dP[Thread@f[#[[1]], #] &, #, Length@#, 1, {1, 1}, {}] &

Timings:

Needs["GeneralUtilities`"]

f1 = With[{n = Length[#]}, Table[f @@ #[[{i, j}]], {i, n}, {j, i, n}]] &; 

f2 = MapIndexed[#[[#2[[1]] ;;]] &, Outer[f, #, #]] &;

f3[x_] := Thread@*f @@@ MapIndexed[{#, x[[First@#2 ;;]]} &, x];

BenchmarkPlot[{f1, f2, f3, f4, f5}, RandomInteger[999, #] &, 2^Range[12

Mathematica graphics

share|improve this answer

There is probably something neater but the following works:

l = {a, b, c, d};
s = SplitBy[Tuples[l, {2}], First];
list = Take[s[[#]], #2] & @@@ Thread@{Range@Length@l, Range[-Length@l, -1]}
Map[f[Sequence @@ #] &, list, {-2}]
{{f[a, a], f[a, b], f[a, c], f[a, d]}, {f[b, b], f[b, c], f[b, d]}, 
 {f[c, c], f[c, d]}, {f[d, d]}}
share|improve this answer

Here is a straightforward implementation...

Table[Table[f[list[[i]], list[[j]]], {j, i, Length@list}], {i, Length@list}]

Here is my flattened table: If list is a sorted list of unique elements

list = {a, b, c, d}
g[a_, b_] := f @@ Sort@{a, b};
Union@Flatten@Outer[g, list, list]
share|improve this answer
    
My table is flat... –  Timothy Wofford Jul 31 at 19:24
    
no the list is not sorted. it is random –  Algohi Jul 31 at 19:38
Thread[f[First@#, #]] & /@ 
 NestList[Drop[#, 1] &, list, Length[list] - 1]

The above is a refinement of less efficient 1st attempt:

First@Outer[f, #, #] & /@ 
 NestList[Drop[#, 1] &, list, Length[list] - 1]
share|improve this answer

A few more just for fun:

ReplaceList[list, {___, a__} :> Thread @ f[#& @ a, {a}]]

Thread @* f ~MapThread~ {list, NestList[Rest, list, 3]}

Pick[Outer[f, list, list], # <= #2 & ~Array~ {4, 4}]
share|improve this answer
Outer[f, list, list] /. 
 f[x_, y_] /; 
   First@First@Position[list, x] >  First@First@Position[list, y] :> 
  Sequence[] 

What's annoying here is projecting #[[1,1]]&. How to make {{1}} <= {{2}} evaluate True?

share|improve this answer

Building up an Association

len=Length@list;
asso=<||>;
(asso[#]=list[[-#]])&/@Range@len;

and then

Array[Function[x,Array[f[x,#]&,x,{x,1}]],len,{len,1}]/.asso
share|improve this answer

Throwing my hat to the ring

Clear[splitList]
splitList[f_, list_List] := 
 SplitBy[DeleteDuplicates[Sort /@ Tuples[Sort[Hold[f] @@ list], 2]], First] // ReleaseHold

splitList[f, {a, b, c, d}]
(* {{f[a, a], f[a, b], f[a, c], f[a, d]}, {f[b, b], f[b, c], 
  f[b, d]}, {f[c, c], f[c, d]}, {f[d, d]}} *)

splitList[Plus, {a, b, c, d}]
(* {{2 a, a + b, a + c, a + d}, {2 b, b + c, b + d}, {2 c, c + d}, {2 d}} *)
share|improve this answer
    
@RunnyKine I fixed my answer based on your suggestion. Try splitList[f, {a, b, c, 6, d, 5, b}] and let me know what you think. –  seismatica Aug 1 at 18:24

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.