Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to replace each 0 with the preceding element in a list in an idiomatic way in Mathematica?

This is a fun little problem, and I wanted to check with the experts here if there is a better functional/Mathematica way to approach solving it than what I did. I am not too happy with my solution since I use big IF THEN ELSE in it, but could not find a Mathematica command to use easily to do it (such as Select, Cases, Sow/Reap, Map.. etc...)

Here is the problem, given a list values (numbers or symbols), but for simplicity, lets assume a list of numbers for now. The list can contain zeros and the goal is replace the each zero with the element seen before it.

At the end, the list should contain no zeros in it.

Here is an example, given

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

the result should be

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

It should ofcourse be done in the most efficient way.

This is what I could come up with

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

I wanted to see if I can use Sow/Reap on this, but did not know how.

question: can this be solved in a more functional/Mathematica way? The shorter the better ofcourse :)

update 1 Thanks everyone for the answer, all are very good to learn from. This is the result of speed test, on V 8.04, using windows 7, 4 GB Ram, intel 930 @2.8 Ghz:

I've tested the methods given for n from 100,000 to 4 million. The ReplaceRepeated method does not do well for large lists.

update 2

Removed earlier result that was shown above in update1 due to my error in copying one of the tests.

The updated results are below. Leonid method is the fastest. Congratulation Leonid. A very fast method.

enter image description here

The test program is the following:

(*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
  ]

To run the tests for length 1000 the command is:

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

Thanks everyone for the answers.

like image 451
Nasser Avatar asked Dec 30 '11 18:12

Nasser


2 Answers

Much (order of magnitude) faster than other solutions still:

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

The speedup is due to Fold autocompiling. Will not be so dramatic for non-packed arrays. Benchmarks:

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
like image 180
Leonid Shifrin Avatar answered Nov 22 '22 06:11

Leonid Shifrin


This seems to be a factor 4 faster on my machine:

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

The timings I get are

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 *)
like image 40
Heike Avatar answered Nov 22 '22 05:11

Heike