Как заменить каждый 0 на предыдущий элемент в списке идиоматическим способом в Mathematica? - PullRequest
9 голосов
/ 30 декабря 2011

Это небольшая забавная проблема, и я хотел уточнить у экспертов, есть ли лучший функциональный / Mathematica способ ее решения, чем тот, который я сделал.Я не слишком доволен своим решением, так как я использую в нем большое IF THEN ELSE, но не смог найти команду Mathematica, которую можно было бы легко использовать (например, Select, Cases, Sow/Reap, Map.и т. д.)

Вот проблема, учитывая список значений (чисел или символов), но для простоты, давайте пока предположим список чисел.Список может содержать нули, и цель состоит в том, чтобы заменить каждый ноль элементом, видимым перед ним.

В конце, список не должен содержать нулей .

Вот пример, учитывая

a = {1, 0, 0, -1, 0, 0, 5, 0};

результат должен быть

a = {1, 1, 1, -1, -1, -1, 5, 5}

Конечно, это должно быть сделано наиболее эффективным способом.

Это то, что ямог придумать

Scan[(a[[#]] = If[a[[#]] == 0, a[[#-1]], a[[#]]]) &, Range[2, Length[a]]];

Я хотел посмотреть, смогу ли я использовать Sow / Reap для этого, но не знал как.

вопрос: это можно решить вболее функциональный / математический способ?Чем короче, тем лучше:)

обновление 1 Спасибо всем за ответ, у всех очень хорошие уроки.Это результат теста скорости на V 8.04 с использованием Windows 7, 4 ГБ Ram, Intel 930 @ 2,8 ГГц:

Я тестировал методы, приведенные для n от 100,000 до 4 million.Метод ReplaceRepeated не подходит для больших списков.

update 2

Удален более ранний результат, который был показан выше в update1 из-за моей ошибки при копировании одного изтесты.

Обновленные результаты приведены ниже.Леонид метод самый быстрый.Поздравляем Леонида.Очень быстрый метод.

enter image description here

Программа тестирования следующая:

(*version 2.0 *)
runTests[sizeOfList_?(IntegerQ[#] && Positive[#] &)] := 
 Module[{tests, lst, result, nasser, daniel, heike, leonid, andrei, 
   sjoerd, i, names},

  nasser[lst_List] := Module[{a = lst},
    Scan[(a[[#]] = If[a[[#]] == 0, a[[# - 1]], a[[#]]]) &, 
     Range[2, Length[a]]]
    ];

  daniel[lst_List] := Module[{replaceWithPrior},
    replaceWithPrior[ll_, n_: 0] := 
     Module[{prev}, Map[If[# == 0, prev, prev = #] &, ll]
      ];
    replaceWithPrior[lst]
    ];

  heike[lst_List] := Flatten[Accumulate /@ Split[lst, (#2 == 0) &]];

  andrei[lst_List] := Module[{x, y, z},
    ReplaceRepeated[lst, {x___, y_, 0, z___} :> {x, y, y, z}, 
     MaxIterations -> Infinity]
    ];

  leonid[lst_List] := 
   FoldList[If[#2 == 0, #1, #2] &, First@#, Rest@#] & @lst;

  sjoerd[lst_List] := 
   FixedPoint[(1 - Unitize[#]) RotateRight[#] + # &, lst];

  lst = RandomChoice[Join[ConstantArray[0, 10], Range[-1, 5]], 
    sizeOfList];
  tests = {nasser, daniel, heike, leonid, sjoerd};
  names = {"Nasser","Daniel", "Heike", "Leonid", "Sjoerd"};

  result = Table[0, {Length[tests]}, {2}];

  Do[
   result[[i, 1]] = names[[i]];

   Block[{j, r = Table[0, {5}]},
    Do[
     r[[j]] = First@Timing[tests[[i]][lst]], {j, 1, 5}
     ];
    result[[i, 2]] = Mean[r]
    ],

   {i, 1, Length[tests]}
   ];

  result
  ]

Для запуска тестов на длину 1000 команда:

Grid[runTests[1000], Frame -> All]

Спасибо всем за ответы.

Ответы [ 4 ]

12 голосов
/ 31 декабря 2011

Намного (на порядок) быстрее, чем другие решения:

FoldList[If[#2 == 0, #1, #2] &, First@#, Rest@#] &

Ускорение происходит из-за Fold автокомпиляции.Не будет таким драматичным для неупакованных массивов.Тесты:

In[594]:= 
a=b=c=RandomChoice[Join[ConstantArray[0,10],Range[-1,5]],150000];
(b=Flatten[Accumulate/@Split[b,(#2==0)&]]);//Timing
Scan[(a[[#]]=If[a[[#]]==0,a[[#-1]],a[[#]]])&,Range[2,Length[a]]]//Timing
(c=FoldList[If[#2==0,#1,#2]&,First@#,Rest@#]&@c);//Timing

SameQ[a,b,c]

Out[595]= {0.187,Null}
Out[596]= {0.625,Null}
Out[597]= {0.016,Null}
Out[598]= True
8 голосов
/ 31 декабря 2011
FixedPoint[(1 - Unitize[#]) RotateRight[#] + # &, d]

примерно в 10 и 2 раза быстрее решений Хайке, но медленнее, чем решения Леонида.

8 голосов
/ 30 декабря 2011

На моей машине это в 4 раза быстрее:

a = Flatten[Accumulate /@ Split[a, (#2 == 0) &]]

Время, которое я получаю

a = b = RandomChoice[Join[ConstantArray[0, 10], Range[-1, 5]], 10000];

(b = Flatten[Accumulate /@ Split[b, (#2 == 0) &]]); // Timing

Scan[(a[[#]] = If[a[[#]] == 0, a[[# - 1]], a[[#]]]) &, 
  Range[2, Length[a]]] // Timing

SameQ[a, b]

(* {0.015815, Null} *)
(* {0.061929, Null} *)
(* True *)
6 голосов
/ 30 декабря 2011

Ваш вопрос выглядит в точности как задание для функции ReplaceRepeated . По сути, он применяет тот же набор правил к выражению до тех пор, пока не будут применены другие правила. В вашем случае выражение является списком, и правило заключается в замене 0 своим предшественником всякий раз, когда он появляется в списке. Итак, вот решение:

a = {1, 0, 0, -1, 0, 0, 5, 0};
a //. {x___, y_, 0, z___} -> {x, y, y, z};

Шаблон для правила здесь следующий:

  • x___ - любой символ, ноль или более повторений, начало списка
  • y_ - ровно один элемент до нуля
  • 0 - сам ноль, этот элемент будет заменен на y позже
  • z___ - любой символ, ноль или более повторений, конец списка
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...