Determine if all the zeros in a list occur at the end

Question

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.

Answer 1

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 &

Answer 2

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

Answer 3

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
*)

Answer 4

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} *)

Answer 5

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) &.

Answer 6

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. *)