4
$\begingroup$

My problem is that computer has no sufficient memory to calculate tuples of my list. A simple example can be given as follows:

e1={{{0,0}},{{0,0},{2,1}},{{0,0},{3,1},{3,2}},{{0,0},{4,1},{4,2},{4,3}},{{0,0}}};

What I want to do is to pick all tuples of e1 satisfying the condition that each tuple does not contain two or more duplicated number except 0. For example, one tuple

{{0,0},{2,1},{0,0},{4,1},{0,0}}

will not be picked because we have two 1.

My current code processes such problem into two steps:

  1. Pick all possibilities of tuples of list. (Got the problem with insufficient memory because of the large tuples 25^25, 50^50, or 100^100)

  2. Delete all tuples which do not satisfy our condition.

Since I got stuck at first step, I am thinking about to combine these two steps together to solve insufficient memory problem.

My code:

Tall = Tuples[e1];
Tallnew = {};
For[i = 1, i < Length[Tall] + 1, i++,
  b = DeleteDuplicates@Cases[Subsets[Flatten[Tall[[i]]], {2}], {c_, c_}][[;; , 1]];
  If[b === {} || b == {0}, AppendTo[Tallnew, Tall[[i]]]]
 ]

I would be very appreciated that If you would like to give some suggestions. Thank you very much.

$\endgroup$
  • $\begingroup$ I'm not sure if e1 could be just flattened or if you need the present nested structure, and then why? I mean, is there a difference between working with your e1 or with {{0, 0}, {0, 0}, {2, 1}, {0, 0}, {3, 1}, {3, 2}, {0, 0}, {4, 1}, {4, 2}, {4, 3}, {0, 0}}? $\endgroup$ – anderstood Nov 15 '16 at 22:41
  • $\begingroup$ Yes, it is different since e1 cannot be flattened. I want to pick one element from each sublist in e1 and this is why I use Tuples[e1] to find all possibilities of such process. And, then I need to delete any possibility which does not satisfy our condition (in question). $\endgroup$ – user44565 Nov 15 '16 at 23:00
  • $\begingroup$ Should {{0,0},{2,1},{0,0},{4,1},{0,0},{1,5}} be kept (if it could be formed from e1)? In other word, is the condition that number should not appear exactly twice, or twice or more? $\endgroup$ – anderstood Nov 15 '16 at 23:18
  • $\begingroup$ The condition is that no number (except zero) should appear twice or more. I think your logic is right. One thing needs to pay attention is that we allow number 0 to appear twice or more. So we have solutions from the example. One of the solution can be {{0,0},{0,0},{3,1},{4,2},{0,0}}. $\endgroup$ – user44565 Nov 15 '16 at 23:20
2
$\begingroup$

Here's a recursive function that hopefully achieves what you want. It uses no Tuples or Subsets so it shouldn't be too bad on the memory. I hope your valid tuples are extremely uncommon, because even $25^{25}$ is a ridiculously huge number.

ClearAll@findTuples;
findTuples[e_] := findTuples[e, {}];
findTuples[e_ /; Length[e] == 1, v_] := List /@ First@e;
findTuples[e_, verboten_] := Module[{r, v},
   Flatten[Function[f,
      v = Cases[Union[verboten, Flatten@f], Except[0]];
      r = Fold[DeleteCases[#1, {_?IntegerQ ..., #2, _?IntegerQ ...}, 
          Infinity] &, Rest@e, v];
      Prepend[#, f] & /@ findTuples[r, v]
      ] /@ First@e, 1]
   ];

The idea is to maintain a list of forbidden numbers, and use those to filter the list as we go. At each step we pick each member of the first element in turn, use that to filter the rest of the list, then prepend to valid tuples of the filtered rest. If we have reached the end of the list, just give those back in a list.

findTuples[e1] // Column

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


Here's a slightly faster version.

ClearAll@findTuples;
findTuples[e_] := findTuples[e, {}];
findTuples[e_ /; Length[e] == 1, v_] := List /@ First@e;
findTuples[e_, verboten_] :=
  If[Min[Length /@ e] > 0,
   Module[{r, v, o, s, i},
    o = Ordering[e, All, Length[#1] < Length[#2] &];
    i = InversePermutation@o;
    s = e[[o]];
    #[[i]] & /@ Flatten[Function[f,
        v = Cases[Flatten@f, Except[0]];
        r = Fold[DeleteCases[#1, {#2, _} | {_, #2}, {2}] &, Rest@s, v];
        Prepend[#, f] & /@ findTuples[r, Union[verboten, v]]
        ] /@ First@s, 1]
    ],
   {}];

If there are zero choices somewhere in the rest, it skips that whole branch. As suggested by @anderstood, it sorts by Length at each step, and then unsorts the results at the end. The filtering of forbidden elements has been improved: assuming we are always dealing with pairs of integers, and only filtering on the new forbidden numbers.

BUT it's still going to get slow as the combinations increase. If OP wants to provide sample data, or how it is generated, then maybe it could be tailored to that. I believe you have no hope to filter $100^{100}$ combinations.

$\endgroup$
  • $\begingroup$ Would it be better to sort the list e1 by Length of sublists? For example, if SortBy[e1,Length] has {{{1,0}},{{1,3}},{{... it will stop directly because there's no solutions. It does not have to go through all e1 if e1={{{1,0},...,{{1,3}}. $\endgroup$ – anderstood Nov 16 '16 at 2:54
  • $\begingroup$ I check your code with larger lists (numSublist = 10; maxSublistLength = 6; maxInteger = 20; e1 = RandomInteger[maxInteger, {#, 2}] & /@ RandomInteger[{1, maxSublistLength}, numSublist]). It returned the same output as the OP's code, but about 200 times faster. And probably more and more as the length of list (= e1) increases. Very nice, I wanted to implement the recursion with forbidden elements but was far from managing... Btw, maybe you want to change verboten to forbidden :). And also don't hesitate if you want to comment a bit more on what instructions do... $\endgroup$ – anderstood Nov 16 '16 at 3:04
  • $\begingroup$ @anderstood I haven't really put much thought into optimising for speed, just trying to get the idea out there. There are many pre-checks one could do on the input. Some of the code could be improved, e.g. the Fold[DeleteCases[... stuff seems rather clunky. Prepend is generally better replaced with a Sow and Reap, but I'm not quite sure how in this case. Verboten is a perfectly cromulent English word (albeit stolen). $\endgroup$ – wxffles Nov 16 '16 at 3:23
  • $\begingroup$ Yes, I know. 25^25 is huge but I think most tuples need to be deleted. Because e1 has some characteristics, for example, in 25^25 cases, all number in sublist are integers and vary from 0 to 25. And speed is also important because I will do this 500 times with different e1. $\endgroup$ – user44565 Nov 16 '16 at 10:01
  • $\begingroup$ I have checked the case with numSublist = 20; maxSublistLength = 10; maxInteger = 20 and it works. However, when I try to increase numSublist = 30; maxSublistLength = 20; maxInteger = 30, it will spend a very long time to work out about half an hour. I am thinking is there any alternative way to reduce the time. $\endgroup$ – user44565 Nov 16 '16 at 18:58
0
$\begingroup$

My current code for this question is divided into two steps:

Step 1, pick any tuples satisfy the condition that there are no two or more duplicated number except 0.

ClearAll@findTuples;
findTuples[e_] := findTuples[e, {}];
findTuples[e_ /; Length[e] == 1, v_] := List /@ First@e;
findTuples[e_, verboten_] := 
If[Min[Length /@ e] > 0, 
Module[{r, v, o, s, i}, 
o = Ordering[e, All, Length[#1] < Length[#2] &];
i = InversePermutation@o;
s = e[[o]];
#[[i]] & /@ Flatten[Function[f, v = Cases[Flatten@f, Except[0]];
    r = Fold[DeleteCases[#1, {#2, _} | {_, #2}, {2}] &, Rest@s, v];
    Prepend[#, f] & /@ findTuples[r, Union[verboten, v]]] /@ 
   First@s, 1]], {}];

Tallnew = findTuples[e1];

Step 2, calculate the number of remaining tuples and find the max one. Note, the number of a tuple here is the total number of positive integer (>0) in the tuple.

ClearAll[f];
f = Compile[{{vector, _Real, 1}, {bound, _Real}}, 
Module[{t = 0, i = 1, len = Length[vector]}, 
For[i = 1, i <= len, i++, t += Boole[vector[[i]] > bound]]; t], 
CompilationTarget -> "C", "RuntimeOptions" -> "Speed"];

Mnumber = Max[Reap[Do[Sow[f[Flatten[Tallnew[[n]]], 0]], {n, Length[Tallnew]}]][[2]]];

The problem is when I input sublist=30, the computer will spend a very long time to calculate. Now, I am thinking put these two steps into one function. But I am struggling to write the new function. My logic is first to check the first condition in step 1, if it is satisfied, calculate its number (we do not need to store this tuple). If the number is larger than which of any previous tuples, store the number. Otherwise, continue to next tuple.

$\endgroup$

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.