6
$\begingroup$

I have a collection of (short) lists of nonnegative integers. For each, I would like a predicate that decides if all of the zeros in the list appear at the end. For example, {1,0,1,0} would fail since there is a 1 after the first zero, while {2,3,17,0,0} would pass. I can think of a number of ways (for example, find the positions of the zeros and check that they are consecutive and that the last element is zero), but none that are particularly elegant or pleasing.

Edit: The list may have no zeros in which case it should be accepted.

$\endgroup$
  • $\begingroup$ What about if there are no zeroes? $\endgroup$ – ciao Mar 3 '15 at 22:21
  • $\begingroup$ In that case the list should be acceptable. $\endgroup$ – rogerl Mar 3 '15 at 22:22
7
$\begingroup$

Finally:

test5 = OrderedQ @ Reverse @ Unitize @ # &

slow stuff:

test = MatchQ[#, {Except[0] .., (0) ...}] &

new one, this is "only" two orders of magnitude slower than Mr.Wizard's :)

test3 = Length[Split[#, Count[{##}, 0] != 1 &]] <= 2 &

getting closer, only twice as long:

test4 = Length @ Split @ Unitize @ # <= 2 &
$\endgroup$
  • $\begingroup$ I tried for a while to build the appropriate pattern, but just couldn't get it right. Thanks. Can you educate me --- this is clearly useful, but why doesn't something like {x__/;x!=0,y__/;y==0} work? $\endgroup$ – rogerl Mar 3 '15 at 22:23
  • $\begingroup$ Try MatchQ[{1, 1, 0, 0}, {x__ /; x != 0, y__ /; y == 0}] versus MatchQ[{2,3,17, 0, 0}, {x__ /; x != 0, y__ /; y == 0}]. What's up with that? That's why I assumed that pattern didn't work. $\endgroup$ – rogerl Mar 3 '15 at 22:34
  • $\begingroup$ So do you understand why one returns False and the other True? $\endgroup$ – rogerl Mar 3 '15 at 22:36
  • 2
    $\begingroup$ @rogerl and Kuba, you must consider that x in x__ is bound to a sequence of values. Observe: Replace[{1, 1, 0, 0}, {x__, y__ /; y == 0} :> HoldForm[x != 0]] which returns 1 != 1 != 0. Does this explain your confusion? $\endgroup$ – Mr.Wizard Mar 3 '15 at 22:49
  • $\begingroup$ Okay, you got me. :-) $\endgroup$ – Mr.Wizard Mar 3 '15 at 22:55
6
$\begingroup$

The first pattern that came to mind:

p1 = {___, 0, Except[0], ___};

! MatchQ[{2, 3, 17}, p1]
! MatchQ[{2, 3, 17, 0, 0}, p1]
! MatchQ[{1, 0, 1, 0, 1}, p1]
True

True

False

I am exploring other avenues now.


It seems that this pattern is vastly more efficient that Kuba's superficially similar one. As a simple example:

pK = {Except[0] .., (0) ...};

SeedRandom[0]

x = RandomInteger[999, 20000];

! MatchQ[x, p1] // Timing // First

MatchQ[x, pK]   // Timing // First
0.000219649

2.542816
$\endgroup$
  • $\begingroup$ Also (see edit above) I think this fails in the case where there are no zeros. $\endgroup$ – rogerl Mar 3 '15 at 22:27
  • $\begingroup$ @rogerl Oops! Okay, let me see what I can do. $\endgroup$ – Mr.Wizard Mar 3 '15 at 22:31
  • $\begingroup$ @rogerl I think this already works correctly? Could you give me an example where it does not work as desired? $\endgroup$ – Mr.Wizard Mar 3 '15 at 22:37
  • $\begingroup$ Sorry, you are correct; I was forgetting about the inversion of the test. Do you have any comments on the discussion we are having in the other answer? $\endgroup$ – rogerl Mar 3 '15 at 22:42
5
$\begingroup$

For big collections of lists, this should be quick:

fx = With[{s = SparseArray[PadRight@#]["AdjacencyLists"]}, 
    SameQ @@@ Transpose[{Length /@ s, Last /@ Replace[s, {} -> {0}, 1]}]] &;

Update: Even more so:

fx2 = OrderedQ /@ Unitize[#[[All, -1 ;; 1 ;; -1]]] &;

Compare (old netbook timings... seems to clobber other answers so far...):

(* 100000 lists each of 20 ele *)
test = RandomInteger[{0, 100}, {100000, 20}];

Column[{
  fx2r = fx2[test]; // Timing // First,
  ww = fx[test]; // Timing // First,
  xx = ! MatchQ[#, p1] & /@ test; // Timing // First,
  test5 = OrderedQ@Reverse@Unitize@# & /@ test; // Timing // First,
  f1r = f1 /@ test; // Timing // First,
  f2r = f2 /@ test; // Timing // First,
  ww == xx == test5 == f1r == f2r == fx2r}]

(*
0.390002
0.936006
5.054432
1.638011
8.190053
8.704856
True
*)
$\endgroup$
  • 1
    $\begingroup$ Nice +1. I should really read questions more carefully :) $\endgroup$ – Kuba Mar 3 '15 at 23:50
2
$\begingroup$
ClearAll[f1,f2]
f1 = With[{u = Unitize@#}, FreeQ[u[[;; Tr@u]], 0]] &;

f1 /@ {{1, 2, 3}, {0, 1, 2, 3, 0}, {1, 2, 3, 0, 0, 0}, {0, 0, 1, 2, 3}}
(* {True, False, True, False} *)

f2 = With[{u = Unitize@#}, Times @@ N @ u[[;; Tr@u]] != 0] &;

f2 /@ {{1, 2, 3}, {0, 1, 2, 3, 0}, {1, 2, 3, 0, 0, 0}, {0, 0, 1, 2, 3}}
(* {True, False, True, False} *)
$\endgroup$
2
$\begingroup$

Here are two bulky yet fast compiled functions. The two functions are essentially the same, but the second one is slightly adapted to rashers test case for timing comparisons. In my previous version they were even longer, but it turns out they are faster this way.

cfu =
 Compile[
  {{ints, _Integer, 1}}
  ,
  Block[
   {len, zFlag, res}
   ,
   res = True;
   len = Length@ints;
   zFlag = False;
   Do[
    If[
      ints[[i]] == 0
      ,
      zFlag = True;
      ,
      If[
       zFlag
       ,
       res = False;
       Break[]
       ]
      ];
    ,
    {i, 1, len}
    ];
   res
   ]
  ,
  CompilationTarget -> "C"
  ]

cfu2 =
 Compile[
  {{int2s, _Integer, 2}}
  ,
  Block[
   {len, bigLen, zFlag, res, ints}
   ,
   bigLen = Length@int2s;
   Table[
    ints = int2s[[jj]];
    res = 1;
    len = Length@ints;
    zFlag = False;
    res = True;
    len = Length@ints;
    zFlag = False;
    Do[
     If[
       ints[[i]] == 0
       ,
       zFlag = True;
       ,
       If[
        zFlag
        ,
        res = False;
        Break[]
        ]
       ];
     ,
     {i, 1, len}
     ];
    res
    ,
    {jj, 1, bigLen}
    ]
   ]
  ,
  CompilationTarget -> "C"
  ]

We then have

Column[{fx2r = fx2[test]; // Timing // First, 
  ww = fx[test]; // Timing // First, 
  xx = ! MatchQ[#, p1] & /@ test; // Timing // First, 
  test5 = OrderedQ@Reverse@Unitize@# & /@ test; // Timing // First, 
  f1r = f1 /@ test; // Timing // First, 
  f2r = f2 /@ test; // Timing // 
   First, (jRes = cfu /@ test) // Timing // 
   First, (jRes2 = (# != 0) & /@ cfu2@test) // Timing // First, 
  ww == xx == test5 == f1r == f2r == fx2r == jRes == jRes2}
 ]
0.112896
0.212937
0.656224
0.256140
0.812663
1.000797
0.105754
0.059129
True

Note: The timing can be made slightly faster by manually compiling (# != 0) &.

$\endgroup$
  • $\begingroup$ Why don't you like MMA? ;P $\endgroup$ – Kuba Mar 9 '15 at 14:48
  • $\begingroup$ @Kuba just want to make a fair comparison :). $\endgroup$ – Jacob Akkerboom Mar 9 '15 at 15:52
1
$\begingroup$
f[x_] := Plus @@ (Join[x, {0, 0}] /. {___, 0, r__} :> {r}) == 0

f /@ {{0, 1, 2, 3, 0}, {1, 2, 3, 0, 0, 0}, {0, 0, 1, 2, 3}}
(* {False, True, False} *)

SeedRandom[0]
x = RandomInteger[999, 20000];
f@x // Timing // First
(* 0. *)
$\endgroup$
  • $\begingroup$ still 7.5 times slower than my pattern and fifty times slower than Kuba's test5. :-/ $\endgroup$ – Mr.Wizard Mar 3 '15 at 22:57
  • $\begingroup$ @Mr.Wizard Let's see what I can do :) $\endgroup$ – Dr. belisarius Mar 3 '15 at 22:58
  • $\begingroup$ Start compiling ;-) $\endgroup$ – Mr.Wizard Mar 3 '15 at 22:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.