4
$\begingroup$

I have one problem write a function to maximize the positive number of tuples of a given list which satisfy the condition that there exists no number (except zero) two or more times in one tuples.

For example, a list like e1={{{0,0},{0,1}},{{0,0}},{{1,2},{3,4}}}. All tuples which satisfy the condition are

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

The positive number of these three tuples are 2,2,3 and hence the maximum positive number in this example is 3.

Since my list is very long, I want to make my current code faster. Thank you very much.

My current code is:

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, m}, 
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];

mm = Max[Array[Count[Positive /@ Flatten[Tallnew[[#]]], True] &, 
Length[Tallnew]]];

A longer list example:

{{{0,0}},{{0,0}},{{0,0},{3,2}},{{0,0},{4,2}},{{0,0}},{{0,0},{6,4}},{{0,0},{7,2}},{{0,0},{8,3}},{{0,0}},{{0,0}},{{0,0}},{{0,0}},{{0,0}},{{0,0}},{{0,0},{15,3},{15,14}},{{0,0},{16,2}},{{0,0}},{{0,0},{18,2},{18,3},{18,5},{18,8},{18,14},{18,15}},{{0,0}},{{0,0},{20,4},{20,16}},{{0,0}},{{0,0},{22,1},{22,3},{22,7},{22,9},{22,14},{22,16},{22,17}},{{0,0},{23,18}},{{0,0}},{{0,0},{25,2},{25,6},{25,20},{25,22}},{{0,0}},{{0,0},{27,4},{27,7},{27,16},{27,18},{27,25}},{{0,0}},{{0,0},{29,3},{29,18}},{{0,0},{30,3},{30,18}},{{0,0},{31,7},{31,25}},{{0,0},{32,22}},{{0,0}},{{0,0},{34,22}},{{0,0}},{{0,0},{36,28}},{{0,0}},{{0,0},{38,18}},{{0,0},{39,3},{39,18}},{{0,0},{40,1},{40,2},{40,6},{40,9},{40,13},{40,14},{40,16},{40,18},{40,19},{40,21},{40,22},{40,27},{40,29},{40,34},{40,38},{40,39}},{{0,0}},{{0,0},{42,18}},{{0,0},{43,22}},{{0,0},{44,40}},{{0,0}},{{0,0},{46,4},{46,16},{46,18},{46,25},{46,40}},{{0,0},{47,22}},{{0,0},{48,40}},{{0,0},{49,22}},{{0,0}}}

Improve this question
$\endgroup$
5
  • $\begingroup$ Could you add code to generate a realistic example list. Your e1 is a great example for describing the problem but too small for testing speed. $\endgroup$
    – Simon Woods
    Nov 21 '16 at 15:20
  • $\begingroup$ Yes, I can. I have put a longer list in question part. $\endgroup$
    – user44565
    Nov 21 '16 at 15:30
  • $\begingroup$ @Feyre -Actually, I try to use my current code to calculate a longer list than e1 and it spend a very long time and cannot get an answer. $\endgroup$
    – user44565
    Nov 21 '16 at 16:08
  • $\begingroup$ In the long example every sublist begins with {0,0}, is that always the case? $\endgroup$
    – Simon Woods
    Nov 21 '16 at 18:25
  • $\begingroup$ Yes, every sublist in e1 begins with {0,0}. $\endgroup$
    – user44565
    Nov 21 '16 at 18:31
2
$\begingroup$

I think this works properly, it is faster than your code but still pretty slow. 

purge[{a_, b_}, list_] := DeleteCases[Select[FreeQ[a | b]] /@ list, {}]

f[{first_, rest___}] := Max[{(Length[#] + f@purge[#, {rest}]) & /@ first, f[{rest}]}]
f[{}] = 0;

f[SortBy[e1 //. {} | 0 -> Nothing, Length]]
(* 20 *)
Improve this answer
$\endgroup$
6
  • $\begingroup$ I got one problem is that if one tuple is {{0,0},{0,0},{0,0}} the result will become f[SortBy[Nothing,Length]] $\endgroup$
    – user44565
    Nov 21 '16 at 20:38
  • $\begingroup$ I think this function works really well but the only problem is the tuple {{0,0},{0,0},{0,0}} and the information Nonatomic expression expected at position 1 in SortBy[Nothing,Length] shows on screen. I tried to change the value of Nothing, but the result does not correct. I would be very appreciated if you can help me to solve this problem. Thank you very much. $\endgroup$
    – user44565
    Nov 22 '16 at 10:19
  • $\begingroup$ What's the input list e1 that gives that error? $\endgroup$
    – Simon Woods
    Nov 22 '16 at 10:39
  • $\begingroup$ @Simon-Because e1 is randomly selected. If e1={{{0,0}},{{0,0}},{{0,0}}}, then the reslut should equal to zero. $\endgroup$
    – user44565
    Nov 22 '16 at 16:06
  • $\begingroup$ @user44565, the list only reduces to Nothing if every element is {0,0} so the simplest fix is to something like If[Max[e1] == 0, 0, f[...]] $\endgroup$
    – Simon Woods
    Nov 22 '16 at 21:05

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.