Любой эффективный простой способ найти максимальный список среди N списков с одинаковой длиной, используя Mathematica?

Question

Этот вопрос является продолжением предыдущей нити, чтобы сравнить два списка одинаковой длины:

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

Учитывая два списка A={a1,a2,a3,...an} и B={b1,b2,b3,...bn}, я бы сказал A>=B тогда и только тогда, когда все ai>=bi. Теперь у нас есть k списки H={{a11,a12,a13,...a1n}, {a21,a22,a23,...a2n},...,{ak1,ak2,ak3,...akn}}, и мы хотим найти максимальный, если они есть.

Вот мой код:

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

Любой трюк лучше сделать это?

EDIT:

Я хочу, чтобы определить это как функция, как:

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

Но вопрос код выше перекрестными двух линий, любое исправление для этого? Вот код работает, но не так красиво

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]}]]

Answer 1

Модификация подхода Mr.Wizard работает несколько раз быстрее.

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

Мы тестировали оба метода с

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

и мы получаем

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

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

и

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

В целом, чтобы выбрать метод, мы должны сначала знать, с какими данными мы должны справиться. (длина списков, их количество, типы чисел). Хотя у нас есть большое количество коротких списков целых чисел maxListFast работает даже в 10 раз лучше (в случае 500000 списков длины 10), чем maxList. Однако для списков реальных чисел это всего лишь 3-4 раза быстрее, и чем больше и длиннее список, тем больше он замедляется, например. :

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

Out[19]= 2.040516  

однако если вставить "наибольший элемент":

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 

тайминги крупным планом.

Answer 2

Некоторые данные: Кстати, это на самом деле не нужно маркировать отдельные подсписки. Я сделал это для удобства.

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

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

---

maxList определяет подсписок является ли самым большим списком, т.е. ли каждый из его элементов больше, чем соответствующие элементы во всех других подсписках. Сначала мы предполагаем, что подсписком является максимальный список. Если это допущение нарушено (обратите внимание на использование Negative, а не NonNegative) Возвращается False. BTW, список будет сравниваться с самим собой; это проще, чем удаление его с lists; и это не влияет на результат.

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

---

Теперь давайте проверим один из перечисленных выше подсписков является ли 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} 

Подсписок d является maxList.

Если maxList не был, результатом был бы пустой список.

Answer 3

Мне кажется, что это должно работать:

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

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

{{5, 6, 7}} 

---

Я не думаю о стоимости использования Intersection и Artes показывает, что MemberQ гораздо лучше выбор. (Прошу проголосовать за его ответ, как и я). Я хотел бы написать функцию без использования Module себя:

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

Почти эквивалент хотя и не вполне, как быстрый способ заключается в следующем:

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

Результат в виде {{a, b, c}} или {}, а не {a, b, c} или {}.