10

I have an arbitrary list of unique elements:

lst = {a, b, c, d}

Documentation allows finding subsets with same number of elements, say 2:

Subsets[lst, {2}]
(* {{a, b}, {a, c}, {a, d}, {b, c}, {b, d}, {c, d}} *)

What I need is to add some placeholder, i.e. 0, to each subset.

{{a, b, 0, 0}, {a, 0, c, 0}, {a, 0, 0, d}, {0, b, c, 0}, {0, b, 0, d}, {0, 0, c, d}}

Replacements work slow (even freeze) for large lists and many subsets.

lst /. # & /@ (Thread[# -> 0] & /@ Complement[list, #] & /@ Subsets[lst, {2}])

I'd like to have a better way.

(Application - intertemporal choice problems with discrete time).

garej
  • 4,865
  • 2
  • 19
  • 42
  • 3
    So, ReplacePart[ConstantArray[0, Length[lst]], Thread[# -> lst[[#]]]] & /@ Subsets[Range[Length[lst]], {2}] doesn't work for you? – J. M.'s missing motivation Feb 16 '16 at 21:23
  • 2
    Another option Normal@SparseArray[ MapThread[First@Position[lst, #] -> # &, Transpose@{#}] , Length@lst ] & /@ Subsets[lst, {2}], pretty similar to J.M.'s solution, but you can keep it in sparse form to save some memory for large lists. i.e. remove Normal if you want. – N.J.Evans Feb 16 '16 at 21:27
  • 4
    Another way to do @N.J.'s idea: SparseArray[Flatten[MapIndexed[Map[Function[k, Append[#2, k] -> lst[[k]]], #1] &, Subsets[Range[Length[lst]], {2}]]]]. – J. M.'s missing motivation Feb 16 '16 at 21:38
  • 2
    You guys know that answer's field is below? – Kuba Feb 16 '16 at 21:49
  • 2
    @Kuba, I wanted the OP to test the damn things first before committing to an answer. "Replacements work slow (even freeze) for large lists" made me ask if the replacement-based method I gave would also be inappropriate. – J. M.'s missing motivation Feb 16 '16 at 21:53
  • 1
    Related: (5036), (62888), (82801). More distantly related, but since you (garej) seem to like reading my code you might find this entertaining: (47285) – Mr.Wizard Feb 16 '16 at 23:05

4 Answers4

11

Depending on your Mma version:

{a, b, c, d} # & /@ Permutations[{1, 1, 0, 0}]

Or

<< Combinatorica`

{a, b, c, d} # & /@ Combinatorica`Permutations[{1, 1, 0, 0}]
(*{{a, b, 0, 0}, {a, 0, c, 0}, {a, 0, 0, d}, {0, b, c, 0}, {0, b, 0, d}, {0, 0, c, d}}*)
Dr. belisarius
  • 115,881
  • 13
  • 203
  • 453
8

Not the smartest, but working:

GroupBy[
  Tuples@Thread[{lst, 0}],
  Count[0]
  ][2] (*here 2 is length @ lst - 2*)

{{a, b, 0, 0}, {a, 0, c, 0}, {a, 0, 0, d}, {0, b, c, 0}, {0, b, 0, d}, {0, 0, c, d}}

or

Function[lst,
 ReplacePart[0 lst, #] & /@ MapThread[
     Rule, Subsets[#, {2}] & /@ {Range@Length@lst, lst}, 2
 ]
]

The second method is 2000x times and MaxMemoryUsed is around 150KB in comparison to 500MB of the first one.

Kuba
  • 136,707
  • 13
  • 279
  • 740
6
Normal@({a, b, c, d} SparseArray[ # -> 1 & /@ #, 4]) & /@ 
 Subsets[Range[4], {2}]

{{a, b, 0, 0}, {a, 0, c, 0}, {a, 0, 0, d}, {0, b, c, 0}, {0, b, 0, d}, {0, 0, c, d}}

george2079
  • 38,913
  • 1
  • 43
  • 110
  • 2
    Normal @ ({a, b, c, d} SparseArray[Thread[# -> 1], 4]) & /@ Subsets[Range[4], {2}] is equivalent. Another possibility is Normal @ SparseArray[Thread[# -> {a, b, c, d}[[#]]], 4] & /@ Subsets[Range[4], {2}]. – J. M.'s missing motivation Feb 16 '16 at 22:20
3

Taking the idea from Mr.Wizard answer

rules = Join[Thread[# -> #], {_ -> 0}] & /@ Subsets[lst, {2}];
Replace[lst, #, 1] & /@ rules

Or

Lookup[Thread[#->#],lst,0]&/@Subsets[lst,{2}]
Community
  • 1
Basheer Algohi
  • 19,917
  • 1
  • 31
  • 78