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$
2
  • $\begingroup$ What about if there are no zeroes? $\endgroup$
    – ciao
    Mar 3, 2015 at 22:21
  • $\begingroup$ In that case the list should be acceptable. $\endgroup$
    – rogerl
    Mar 3, 2015 at 22:22

6 Answers 6

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$
12
  • $\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, 2015 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, 2015 at 22:34
  • $\begingroup$ So do you understand why one returns False and the other True? $\endgroup$
    – rogerl
    Mar 3, 2015 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, 2015 at 22:49
  • $\begingroup$ Okay, you got me. :-) $\endgroup$
    – Mr.Wizard
    Mar 3, 2015 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$
4
  • $\begingroup$ Also (see edit above) I think this fails in the case where there are no zeros. $\endgroup$
    – rogerl
    Mar 3, 2015 at 22:27
  • $\begingroup$ @rogerl Oops! Okay, let me see what I can do. $\endgroup$
    – Mr.Wizard
    Mar 3, 2015 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, 2015 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, 2015 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
  • 1
    $\begingroup$ Nice +1. I should really read questions more carefully :) $\endgroup$
    – Kuba
    Mar 3, 2015 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$
2
  • $\begingroup$ Why don't you like MMA? ;P $\endgroup$
    – Kuba
    Mar 9, 2015 at 14:48
  • $\begingroup$ @Kuba just want to make a fair comparison :). $\endgroup$ Mar 9, 2015 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$
3
  • $\begingroup$ still 7.5 times slower than my pattern and fifty times slower than Kuba's test5. :-/ $\endgroup$
    – Mr.Wizard
    Mar 3, 2015 at 22:57
  • $\begingroup$ @Mr.Wizard Let's see what I can do :) $\endgroup$ Mar 3, 2015 at 22:58
  • $\begingroup$ Start compiling ;-) $\endgroup$
    – Mr.Wizard
    Mar 3, 2015 at 22:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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