Монотонизация (списание) без цикла For - PullRequest
Новая
       25

Монотонизация (списание) без цикла For

4 голосов
/ 22 июля 2010

Циклы For или While в коде Mathematica всегда заставляют меня чувствовать себя немного грязно, но я запутываю себя, пытаясь создать какой-то список, похожий на функциональный, и прибегаю к этому: 

(* # Given a list of {x,y} pairs, transform the data as follows: every time 
   # there's a decrease in y-value from one datapoint to the next, say {x1,Y} 
   # followed by {x2,y}, add Y to the value of every datapoint on or after x2. *)
monotonify[data_] := Module[{data0, i, offset = 0},
  data0 = data;
  For[i = 2, i <= Length[data], i++,
    If[data[[i-1,2]] > data[[i,2]], offset += data[[i-1,2]]];
    data0[[i]] += {0,offset}];
  data0]

(Думайте о значениях y как о показаниях одометра, когда иногда одометр сбрасывается случайно - очевидно, потому что значение уменьшается, а одометры не должны этого делать. Поэтому мы преобразуем показания, добавляя последнее известное значение перед каждым сбросом в все будущие ценности.)

Как бы вы написали monotonify в хорошем функциональном стиле?

(Тот факт, что я не рассматриваю вышеприведенный цикл For совершенно нормально , вероятно, является легкой формой ОКР.)

Ответы [ 5 ]

4 голосов
/ 22 июля 2010

ОК, теперь я исправил свой подход к работе со входами, как первоначально было запрошено.

Начните с набора образцов данных: 

dataset = {{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 0}, {g, 4}, 
{h,5}, {i, 6}, {j, 7}, {k, 4}, {l, 7}, {m, 8}, {n, 9}, {o, 0}, {p,2}, 
{q, 3}};

Возьми транспонирование: 

trDataset = Transpose[dataset];

следующая функция для работы только с Y-значениями: 

trDataset[[2]] = FoldList[Plus, dataset[[1, 2]], Map[Max[#, 0] &, Differences[dataset[[All, 2]]]]]

Отмена транспонирования: 

dataset = Transpose[trDataset]

и вывод теперь 

{{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 5}, {g, 9}, {h, 10}, {i, 
  11}, {j, 12}, {k, 12}, {l, 15}, {m, 16}, {n, 17}, {o, 17}, {p, 
  19}, {q, 20}}

Я еще не тестировал производительность этого решения.

РЕДАКТИРОВАТЬ: ОК, вот основа исправления, оставшуюся часть работы я оставлю вам @dreeves. Эта версия monotonify работает только со списком чисел, я не включил ее в свое предыдущее предложение по работе с вашими данными. 

monotonify[series_] := 
 Split[series, Less] //. {a___, x_List, y_List, z___} /; 
     Last[x] > First[y] -> {a, x, y + Last[x], z} // Flatten

РЕДАКТИРОВАТЬ 2: Другая функция, которая работает со списком чисел. Это намного быстрее, чем моя предыдущая попытка. 

monotonify[series_] := 
Accumulate[Flatten[Map[Flatten[{#[[1]], Differences[#]}] &, 
       Split[series, Less]]]]
3 голосов
/ 24 июля 2010

Вот еще одно решение: 

Module[{corr, lasts},
 lasts = data[[All, 2]]; 
 corr = Prepend[Accumulate[MapThread[If[#1 > #2, #1, 0] &, {Most[lasts], Rest[lasts]}]], 0];
 Transpose[{data[[All, 1]], lasts + corr}]]

Он вычисляет вектор коррекции, который затем добавляется к значениям y заданных точек данных.

2 голосов
/ 22 июля 2010

Я сделал это, используя в основном Split, Flatten и Accumulate.Я не уверен, что конечный результат легче понять, чем цикл For, но он должен быть красивым и быстрым, если он имеет значение. 

monotonize[list_] := 
  With[{splits = Split[list, LessEqual]},
   With[{diffs = Most[Last /@ splits] - Rest[First /@ splits]},
    Flatten[
      MapThread[Plus, {Accumulate[Prepend[diffs, 0]], splits}],
     1]]];

monotonizeSecond[list_] :=
  With[{firsts = First /@ list, lasts = Last /@ list},
   Transpose[{firsts, monotonize@lasts}]];

Я думаю, что обильное использование With делает егонемного яснее, чем решение, основанное больше на анонимных функциях.Кроме того, monotonize похоже на то, что может быть полезно в «неокрашенных» списках, поэтому я выделил это как отдельную функцию.

2 голосов
/ 22 июля 2010

Как только рукавица вышла из строя, я не мог не попробовать, но я думаю, что версия цикла For более проста: 

mon00[{prev_,offset_}, next_] := {next, offset + If[prev > next, prev, 0]}
monotonify0[list_] := list + Rest[FoldList[mon00, {-Infinity,0}, list]][[All,2]]
monotonify[data_] := Transpose@{#1, monotonify0[#2]}& @@ Transpose@data

Идея состоит в том, чтобы написать вспомогательную функцию, которая делает это только для простого списка значений y, а затем использовать идиому двойного транспонирования для работы только со вторым столбцом данных.

Удобный справочник для двойной транспонированной идиомы

Для преобразования определенного столбца в матрице, например, замены каждого значения x в столбце 2 матрицы с 4 столбцами на transformElement [x]: 

{#1, transformElement[#2], #3, #4}& @@@ matrix

Если вам нужно преобразовать столбец с помощью функции, которая принимает весь столбец как список, используйте следующую идиому: 

Transpose @ {#1, transformList[#2], #3, #4}& @@ Tranpose@matrix
1 голос
/ 23 июля 2010

Принципиально то, что делает это сложным, заключается в том, что большинство функциональных операторов в Mathematica работают с одним элементом списка одновременно.Это не единственная опция, однако эти функции могли быть настроены так, чтобы принимать два соседних элемента списка одновременно, эта гипотетическая функция сделала бы тривиальным получение желаемого результата.

Вместо преобразования функциимы можем легко преобразовать данные, используя Partition. 

Clear[monotonify];
monotonify[data_] := 
 Transpose[{data[[All, 1]], 
  Rest@FoldList[
    If[#2[[1]] < #2[[2]], #1 + #2[[2]] - #2[[1]], #1 + #2[[2]]] &, 0, 
    Partition[data[[All, 2]], 2, 1, {2, -1}, 0]]}]

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

Clear[monotonify, m00];
m00[acc_, {prev_, next_}] := 
 If[prev < next, acc + next - prev, acc + next]
monotonify[data_] := 
 Transpose[{data[[All, 1]], 
  Rest@FoldList[m00, 0, Partition[data[[All, 2]], 2, 1, {2, -1}, 0]]}]

редактировать: забыли некоторые {}

...