2
$\begingroup$

I have a list $\ell$ of ordered subsets of $1,\dots,n$ with a maximum length, e.g. for $n = 4$ with maximum length 3 this list is of the form

{{}, {1}, {2}, {3}, {4}, {1,2}, {1,3}, {1,4}, {2,3}, {2,4}, {3,4}, {1,2,3}, {1,2,4}, {1,3,4}, {2,3,4}}

Given a number $m \leq n$ and a subset $s \subseteq \{1,\dots,n\}$ I want to efficiently replace the elements of this list $\ell$, based on the following conditions:

  • if neither $m$ nor one of the numbers in $s$ is in the element replace the element by 5
  • if $m$ is in the element but not one of the numbers in $s$ replace by 4
  • if one or more of the numbers in $s$ but not $m$ is in the element replace by 3
  • if both $m$ and one or more of the numbers in $s$ is in the element replace by 2

For the example given above and $m = 3, s = \{1,2\}$ this would result in a list:

{5, 3, 3, 4, 5, 3, 2, 3, 2, 3, 4, 2, 3, 2, 2}

My code below works and gives the right output, but I was wondering if someone might know a faster to do this? Any hint/help is welcome!

Input:

powerset = Subsets[Range[4], 3];
number1 = 3;
numbers2 = {1, 2};

Code:

vector = {MemberQ[#, number1], Length[Intersection[#, numbers2]]} & /@ powerset; 
rules = {{False, 0} -> 5, {True, 0} -> 4, {False, _} -> 3, {True, _} -> 2}; 
vector =  Fold[Replace[#1, #2, {1}] &, vector, rules]

Note: on the given example my code is not that slow, but it slows down when the input given is e.g.

powerset = Subsets[Range[200], 3];

and I want it to work faster for these larger instances.

$\endgroup$
2
  • 1
    $\begingroup$ What are the expected parameter ranges here (that is, how large of $n$ and cardinality of $s$ do you need/want to handle)? And I'm curious what this is for - is it just some exercise, or are you looking for some combinatorial result (and might this be an x-y problem in disguise)? $\endgroup$ – ciao Aug 7 '20 at 21:59
  • $\begingroup$ It is not just an exercise, I am implementing a model that uses the weights of edges in a network. The edges are numbered $1,\dots,n$ and the weight of an edge is determined by a background process. The list $\ell$ contains the states of the background process, $m$ is the edge number for which the weight is determined and $s$ is the set of edges that affect the weight of $m$. These are often the attached edges, so $s$ is expected to be small (size not larger than 6 I would say). $\endgroup$ – delivery101 Aug 8 '20 at 12:51
5
$\begingroup$

This is a quick-n-dirty, but it's ~6X faster on large tests.

doit[n_, ml_, m_, s_] := Module[{ss, lss, r, z, none, nos},
   ss = ReplacePart[ConstantArray[1, n], 
     Thread[Append[s, m] -> Prime[Range[Length[s] + 1]]]];
   ss = Subsets[ss, ml];
   lss = Length@ss;
   r = Range@lss;
   ss = PadRight[ss, {lss, Length@Last@ss}, 1];
   z = ConstantArray[2, lss];
   z[[none = Pick[r, ss, ConstantArray[1, ml]]]] = 5;
   r = Complement[r, none];
   ss[[r]] = Times @@@ ss[[r]];
   z[[nos = Pick[r, ss[[r]], Prime[Length[s] + 1]]]] = 4;
   r = Complement[r, nos];
   z[[Pick[r, Divisible[ss[[r]], Prime[Length[s] + 1]], False]]] = 3;
   z];

Usage:

doit[n,ml,m,s]

where n,ml,m,s are your $n$, $maximum$ $length$, $m$ and $s$

E.g.,for an n of 500, maximum subset size of 3, m of 3 and s of {1, 2, 10, 20, 40, 50} :

doit[500,3,3,{1, 2, 10, 20, 40, 50}]

I have some other ideas, will update when/if time permits.

This is roughly comparable in speed, much shorter & simpler:

doit3[n_, ml_, m_, s_] :=
 Subtract[5, 
  BitOr @@@ 
   Subsets[ReplacePart[ConstantArray[0, n], 
     Thread[Append[s, m] -> Append[ConstantArray[2, Length@s], 1]]], 
    ml]];

Now, if we are working with static $n$ and $maxlen$ for some set of queries, we can benefit from some precomputation.

pgen[n_, ml_] := 
  PositionIndex@Flatten@PadLeft[Subsets[Range@n, ml]] // 
   Table[Quotient[#[x], ml, 1] + 1, {x, n}] &;

query[pgenout_, n_, ml_, m_, s_] := 
  Module[{ss = Union @@ pgenout[[s]], ms = pgenout[[m]], 
    res = ConstantArray[5, Tr[Binomial[n, Range[0, ml]]]]},
   
   res[[Complement[ms, ss]]] = 4;
   res[[Complement[ss, ms]]] = 3;
   res[[Intersection[ss, ms]]] = 2;
   res];

for the previous example, this is used by first precomupting some data:

pout=pgen[500,3];

followed by any number of queries with differing $m$ and $s$:

result=query[pout,3,3,{1, 2, 10, 20, 40, 50}];

By $n$ of 700 this is nearly three orders of magnitude faster than the OP code:

enter image description here

$\endgroup$
1
  • $\begingroup$ Wow this is amazing, thank you so much! I especially like the use of BitOr, had never seen it before but it is so nice and fast! $\endgroup$ – delivery101 Aug 15 '20 at 12:39

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.