1
$\begingroup$

PREFACE:
This question is about a proper algorithm and its implementation. I will explain the problem as detailed as possible and will give my current algorithm as well as two more possible solutions which are far better suited for this task. Unfortunately I have no idea on how to implement either of the latter ones. Therefore any help in that direction is appreciated.

INPUT:
1) The input are k lists $L_i$. Every of this k lists contains a sublists.
E.g.: $k=2$, $a=3$ $$L_1=\{l_{11},l_{12},l_{13}\} \\ L_2=\{l_{21},l_{22},l_{23}\}$$
1.a) Every sublist $l_{ij}$ contains $m_{ij}$ sublists $b_{ij,k=1\dots,m_{i,j}}$ of length $j$.
1.b) The first element in every sub-sub-list $b_{ijk}$ of list $L_i$ is equal. ALL other elements of ALL lists are unequal.
Example: $k=2$, $a=3$ (explicit)
$$ L_1=\{\{\{1\}\},\{\{1,2\},\{1,3\}\},\{\{1,4,5\},\{1,6,7\},\{1,8,9\}\}\} \\ \ \ \ L_2=\{\{\{10\}\},\{\{10,11\},\{10,12\},,\{10,13\}\},\{\{10,14,15\}\}\}$$

TASK:
Find all sets of length k containing elements of the lists $L_i$ which have the following properties:
I.) No doubled elements: No set contains more than one element from every list $L_i$.
E.g.: Possible sets created from $L_1$ and $L_2$ given above:
$$ \{\{1\},\{10,12\}\}: \ \textit{ok} \\ \ \ \quad \{\{1\},\{1,6,7\}\}: \ \textit{not ok}$$
II.) The total number of elements in the union of each of this sets is $\leq a+k$.
E.g.: $k=2$, $a=3$ $$ \ \ \quad \{\{1\},\{10,12\}\}\to ||\{1\}\cup \{10,12\}||<5: \ \textit{ok} \\ \{\{1,6,7\},\{10,14,15\}\}\to ||\{1\}\cup \{10,12\}||>5: \ \textit{not ok} $$

Current algorithm:
Currently I create all possible subsets of length $k$ from the lists $L_i$ and apply the conditions afterwards. That is ``okayish'' for small $k$ and $a$ but problematic for larger values, due to the (unnecessary) combinatorics.

(*minimal example *)
k = 2; 
a = 3; 
L1 = {{{1}}, {{1, 2}, {1, 3}}, {{1, 4, 5}, {1, 6, 7}, {1, 8, 9}}}; 
L2 = {{{10}}, {{10, 11}, {10, 12}}, {{10, 14, 15}}}; 
(* create all subsets and apply conditions afterwards <-> combinatorics :( *)
Lall = Flatten[Union[L1, L2], 1]; 
Lall = Subsets[Lall, {k}]; 
linter = Length[Lall]  (* intermediate length blows up due to combinatorics *)
(* No doubled elements -> delete them *)  
Do[If[Length[Union @@ Lall[[i]]] < 
     Sum[Length[Lall[[i,j]]], {j, 1, k}], Lall[[i]] = {}; ], {i, 1, Length[Lall]}]
Lall = Lall /. {} -> Nothing; 
linter2 = Length[Lall] (* second intermediate length: way shorter (corresponds to ``Problem 1.a)'' *)
(* total number of elements in the union of every subset has to be <a+k *)
Do[If[Length[Flatten[Lall[[i]]]] > a + k, Lall[[i]] = {}; ], {i, 1, Length[Lall]}]  
Lall = Lall /. {} -> Nothing; 
lresult = Length[Lall] 

PROBLEM: The unnecessary combinatorial overhead.
1.a) Here any help is appreciated.
I would save a lot of the overhead if I take a similar approach but restrict the creation of the subsets ( see linter to linter2 in the code) by creating them according to:

subsets = {}; 
Do[subsets = Append[subsets, Subsets[Join[L1[[l]], Flatten[L2, 1]], {k}]], {l, 1, Length[L1]}]
subsets = Flatten[subsets, 1] 

and applying condition II.) afterwards. Unfortunately it is not clear to me, how that approach can be implemented for an arbitrary number of lists k.

1.b) Elegant but probably overly hard to implement.
The complete problem could be solved without overhead by recognizing that the proper way of building the subsets is given by all permutations of the integer partitions $j\leq a+k$ of length $k$. Then one gets for the example:

s = {}; 
Do[s = Append[s, IntegerPartitions[l, {k}]], {l, k, a + k}]
s = Flatten[Permutations /@ Flatten[s, 1], 1]  

Which yields:

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

and therefore exactly the indices $i,j$ of $l_{1,i}$ and $l_{2,j}$ from which all possible subsets fulfill condition I.) and II.). But I guess implementing that is far from trivial and I have no idea on how to attempt it for general k.

To everybody who made it until here: Many thanks, Armin!

$\endgroup$
  • $\begingroup$ If I understood your task correctly, you could use Tuples[Union @@@ {L1, L2}] to go directly to "linter2" (up to sorting). $\endgroup$ – jkuczm Nov 25 '17 at 21:05
1
$\begingroup$

Using Permutations of IntegerPartitions seems like a good approach. You need to remember to limit set of integers, available to be used in partitions, to Range@a, by passing it as third argument of IntegerPartitions. Then convert resulting lists to proper positions of $l_{i,j}$ sub-lists, in list of $L$s, Extract them, and take all combinations of sub-sub-lists using Tuples.

Above can be accomplished by something like following function:

arminSublists // ClearAll
arminSublists@Ls:{{__List}..} /; ArrayDepth@Ls >= 2 := Module[{k, a, kRange, aRange, j},
    k = Length@Ls;
    a = Length@First@Ls;
    kRange = Range@k;
    aRange = Range@a // Developer`FromPackedArray;

    (* Get k-partitions of integers from k to k + a: *)
    Table[IntegerPartitions[j, {k}, aRange], {j, k, k + a}] // Apply@Join //
        (* Convert partitions to compositions: *)
        Map@Permutations // Apply@Join //
        (* Get positions, in input, of (Subscript[l, 1,j1], Subscript[l, 2,j2], ..., Subscript[l, k,jk]) sub-lists with compatible elements: *)
        Map[Transpose@{kRange, #}&] //
        (* Extract compatible sub-lists and get all combinations of their elements (sub-sub-lists): *)
        Map[Tuples@Extract[Ls, #]&] // Apply@Join
]

Using it for lists from OP we get:

arminSublists@{L1, L2}
% // Length
(* {{{1}, {10}}, {{1, 2}, {10}}, {{1, 3}, {10}}, {{1}, {10, 11}}, {{1}, {10, 12}},
    {{1, 4, 5}, {10}}, {{1, 6, 7}, {10}}, {{1, 8, 9}, {10}}, {{1}, {10, 14, 15}},
    {{1, 2}, {10, 11}}, {{1, 2}, {10, 12}}, {{1, 3}, {10, 11}}, {{1, 3}, {10, 12}},
    {{1, 4, 5}, {10, 11}}, {{1, 4, 5}, {10, 12}}, {{1, 6, 7}, {10, 11}},
    {{1, 6, 7}, {10, 12}}, {{1, 8, 9}, {10, 11}}, {{1, 8, 9}, {10, 12}},
    {{1, 2}, {10, 14, 15}}, {{1, 3}, {10, 14, 15}}} *)
(* 21 *)

Which, up to sorting, is the same as final Lall from OP:

Sort[Sort /@ arminSublists@{L1, L2}] === Sort[Sort /@ Lall]
(* True *)
$\endgroup$
  • $\begingroup$ Wow! Thanks so much! Took me quite a while to understand how it works (meaning the exact details). Why do I need *DeveloperFromPackedArray* in aRange = Range@a // DeveloperFromPackedArray; ? $\endgroup$ – Armin Nov 26 '17 at 13:14
  • $\begingroup$ @Armin You don't need it per se, but IntegerPartitions unpacks its third argument. Using Developer`FromPackedArray we unpack Range@a once and pass already unpacked version to all IntegerPartitions calls. Otherwise it would have to unpack it a+1 times, but that's probably completely negligible compared to other operations. $\endgroup$ – jkuczm Nov 26 '17 at 13:31
  • $\begingroup$ Thanks! I was not aware how IntegerPartitions works internally. $\endgroup$ – Armin Nov 26 '17 at 13:34
  • $\begingroup$ Could you help me with one last question. I noticed that you declared the iterator of the Table[] as a local variable for Module[{...,j}, ...]. Should that be done in general for other iterators as well? E.g. Do[..,{i,1,5}]-Loop in Module[{...,i}, Do[...,{i,1,5}]]? $\endgroup$ – Armin Nov 27 '17 at 16:38
  • $\begingroup$ @Armin Table uses dynamic scoping, if we want iterator variable to be lexically scoped we need lexical scoping construct like Module. See WReach's answer to "Do Table iteration variables need to be localized using Module?" question. In this particular case IntegerPartitions[j, {k}, aRange] can't evaluate to any expression containing j symbols except the one given explicitly, so here j could be removed from list of Module variables without any consequences. $\endgroup$ – jkuczm Nov 29 '17 at 14:47

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.