Any efficient easy way to find the maximum list among N lists with the same length using Mathematica?

问题

This question is a continuation of a previous thread to compare two lists with the same length:

Is there any efficient easy way to compare two lists with the same length with Mathematica?

Given two lists A={a1,a2,a3,...an} and B={b1,b2,b3,...bn}, I would say A>=B if and only if all ai>=bi. Now we have k lists H={{a11,a12,a13,...a1n}, {a21,a22,a23,...a2n},...,{ak1,ak2,ak3,...akn}}, and want to find the maximum one if exist.

Here's my code:

Do[If[NonNegative[Min[H[[i]] - h]], h = H[[i]], ## &[]], {i, h = H[[1]]; 1, Length[H]}];h

Any better trick to do this?

EDIT:

I want to define this as a function like:

maxList[H_]:=Do[If[NonNegative[Min[H[[i]] - h]], h = H[[i]], ## &[]], {i, h = H[[1]]; 1, Length[H]}];h

But the question is the code above cross two lines, any fix for this? Here is some code working but not that beautiful

maxList[H_] := Module[{h = H[[1]]}, Do[If[NonNegative[Min[H[[i]] - h]], h = H[[i]], ## &[]], {i, Length[H]}]; h]

maxList[H_]:=Last[Table[If[NonNegative[Min[H[[i]] - h]], h = H[[i]], ## &[]], {i, h = H[[1]]; 1, Length[H]}]]

回答1:

A modification of Mr.Wizard's approach works a few times faster.

maxListFast[list_List] := Module[{l}, 
                                 l = Max /@ Transpose@list; 
                                 If[MemberQ[list, l], l, {}]]

We test the both methods with

test  = RandomInteger[100, {500000, 10}];
test1 = Insert[test, Table[100, {10}], RandomInteger[{1, 500000}]];

and we get

In[5]:= maxList[test] // Timing
        maxListFast[test] // Timing

        Out[5]= {2.761, {}}
        Out[6]= {0.265, {}}

and

In[7]:= maxList[test1] // Timing
        maxListFast[test1] // Timing

Out[7]= {1.217, {{100, 100, 100, 100, 100, 100, 100, 100, 100, 100}}}
Out[8]= {0.14, {100, 100, 100, 100, 100, 100, 100, 100, 100, 100}}

EDIT

In general, to choose a method, we should know first what kind of data we are to deal with. (lenght of lists, their number, types of numbers ). While we have a large number of short lists of integers maxListFast works even 10 times better (in case of 500000 lists of length 10) than maxList. However for lists of real numbers it is only 3-4 times faster, and the more and the longer list we have the more it slows down, e.g. :

         A = RandomReal[1000, {3000, 3000}];
         First@AbsoluteTiming[maxListFast@A;]/ First@AbsoluteTiming[maxList@A;]

Out[19]= 2.040516

however if we insert "the greatest element" :

In[21]:= IA = Insert[A, Table[1000, {3000}], RandomInteger[{1, 3000}]];
In[22]:= First@AbsoluteTiming[maxListFast@IA;]/ First@AbsoluteTiming[maxList@IA;]

Out[22]= 0.9781931

timings close up.

回答2:

It seems to me that this should work:

maxList = # \[Intersection] {Max /@ Transpose@#} &;

maxList[ {{4, 5, 6}, {1, 4, 3}, {4, 3, 5}, {5, 6, 7}} ]

{{5, 6, 7}}

I did not think about the cost of using Intersection, and Artes shows that MemberQ is a much better choice. (Please vote for his answer as I did). I would write the function without using Module myself:

maxList[a_] := If[MemberQ[a, #], #, {}] &[Max /@ Transpose@a]

A nearly equivalent though not quite as fast method is this:

maxList = Cases[#, Max /@ Transpose@# , 1, 1] &;

The result is in the form {{a, b, c}} or {} rather than {a, b, c} or {}.

回答3:

Some Data: Btw, it's not actually necessary to label the individual sublists. I did so for easy reference.

a = {4, 5, 6}; b = {1, 4, 3}; c = {4, 3, 5}; d = {5, 6, 7};

lists = {a, b, c, d};

maxList determines whether a sublist is a greatest list, i.e. whether each of its elements is greater than the respective elements in all other sublists. We initially assume that a sublist is a maximal list. If that assumption is violated (note the use of Negative rather than NonNegative) False is returned. BTW, a list will be compared to itself; that's easier than removing it from lists; and it doesn't affect the result.

maxList[list_] :=
   Module[{result = True, n = 1},
   While[n < Length[lists] + 1, 
   If[Negative[Min[list - lists[[n]]]], result = False; Break[]];  n++]; result]

Now let's check whether one of the above sublists is a maxList:

greatestList = {};
n = 1; While[n < Length[lists] + 1, 
If[maxList[lists[[n]]], greatestList = lists[[n]]; Break[]]; n++];
Print["The greatest list (if one exists): ", greatestList]

(* output *)
The greatest list (if one exists): {5,6,7}

Sublist d is a maxList.

If there were no maxList, the result would have been the empty list.

来源：https://stackoverflow.com/questions/8889583/any-efficient-easy-way-to-find-the-maximum-list-among-n-lists-with-the-same-leng

标签

arrays

list

wolfram-mathematica

mathematica-8