10
$\begingroup$

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).

$\endgroup$
  • 3
    $\begingroup$ So, ReplacePart[ConstantArray[0, Length[lst]], Thread[# -> lst[[#]]]] & /@ Subsets[Range[Length[lst]], {2}] doesn't work for you? $\endgroup$ – J. M. is away Feb 16 '16 at 21:23
  • 2
    $\begingroup$ 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. $\endgroup$ – N.J.Evans Feb 16 '16 at 21:27
  • 4
    $\begingroup$ 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}]]]]. $\endgroup$ – J. M. is away Feb 16 '16 at 21:38
  • 2
    $\begingroup$ You guys know that answer's field is below? $\endgroup$ – Kuba Feb 16 '16 at 21:49
  • 2
    $\begingroup$ @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. $\endgroup$ – J. M. is away Feb 16 '16 at 21:53
11
$\begingroup$

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}}*)
$\endgroup$
  • 2
    $\begingroup$ Combinatorica`Permutations[{1, 1, 0, 0}] is not working here, in 10.2 -- can you think of a reason I'm forgetting? $\endgroup$ – Mr.Wizard Feb 16 '16 at 22:42
  • $\begingroup$ @Mr.Wizard Nope. Perhaps they renamed/ghosted some Combinatorica functions to prevent name clashing? $\endgroup$ – Dr. belisarius Feb 16 '16 at 22:54
  • $\begingroup$ Default Permutations[{1, 1, 0, 0}] works OK here too. $\endgroup$ – Mr.Wizard Feb 16 '16 at 22:58
  • $\begingroup$ @Mr.Wizard Ok, thanks. Answer updated $\endgroup$ – Dr. belisarius Feb 16 '16 at 23:05
  • $\begingroup$ This appeared to be most robust in different scenarious (in some general form that calculates the permutation lists). $\endgroup$ – garej Feb 17 '16 at 13:18
8
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ looks good, and smart :)) $\endgroup$ – garej Feb 16 '16 at 21:28
  • 2
    $\begingroup$ Somehow, Tuples[] looks to me like it would consume more memory than Subsets[]... $\endgroup$ – J. M. is away Feb 16 '16 at 21:30
  • 1
    $\begingroup$ @J.M. That's why I put a comment. $\endgroup$ – Kuba Feb 16 '16 at 21:46
  • $\begingroup$ @J.M. added something more efficient $\endgroup$ – Kuba Feb 16 '16 at 22:14
6
$\begingroup$
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}}

$\endgroup$
  • 2
    $\begingroup$ 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}]. $\endgroup$ – J. M. is away Feb 16 '16 at 22:20
3
$\begingroup$

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}]
$\endgroup$
  • $\begingroup$ I wouldn't have thought to use this method here. +1 for expanding my thinking. :-) $\endgroup$ – Mr.Wizard Feb 17 '16 at 13:25
  • $\begingroup$ @Mr.Wizard your thoughts always inspire me. You don't imagine how much I learn from you:-) $\endgroup$ – Algohi Feb 17 '16 at 16:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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