27
\$\begingroup\$

Background

Define a run in a list as a maximal contiguous subsequence of identical values. For example, the list

0 0 0 1 1 0 3 3 3 2 2

has five runs of lengths 3, 2, 1, 3, 2 respectively. (Think of run-length encoding.)

Then define a cut operation as removing one item from each run of a list. Applied to the list above, the result will be 0 0 1 3 3 2.

Finally, the cut resistance of a list is the number of cut operations needed to reduce it to an empty list. The cut resistance of the list above is 3:

0 0 0 1 1 0 3 3 3 2 2
0 0 1 3 3 2
0 3
(empty)

Note that the cut resistance can be higher than the maximal run length, since multiple runs may fuse in the way:

1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 1 0
0 1 0 0 0
0 0
0
(empty)

Related OEIS sequence: A319416 (cut resistance of n written in binary)

Task

Given a (possibly empty) list of nonnegative integers, compute its cut resistance.

Standard rules apply. The shortest code in bytes wins.

Test cases

0 0 0 1 1 0 3 3 3 2 2 => 3
1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 1 0 => 4
1 2 3 4 5 99 100 101 => 1
4 4 4 4 4 4 3 3 3 3 2 2 1 2 2 3 3 3 3 4 4 4 4 4 4 => 7
(empty) => 0
\$\endgroup\$

25 Answers 25

6
\$\begingroup\$

Python 2, 55 bytes

f=lambda l:l>[]and-~f([x for x in l[1:]if x==l.pop(0)])

Try it online!

False for 0.

57 bytes

f=lambda l:l>[]and-~f([a for a,b in zip(l,l[1:])if a==b])

Try it online!

\$\endgroup\$
6
\$\begingroup\$

J, 20 bytes

1-~&#(#~2=/\_&,)^:a:

Try it online!

Using the 0 0 0 1 1 0 3 3 3 2 2 example:

  1. (......_&,) Prepend infinity _:

    _ 0 0 0 1 1 0 3 3 3 2 2
    
  2. (..2=/....) Are consecutive pairs equal? Returns 0-1 list of same length as input:

    _ 0 0 0 1 1 0 3 3 3 2 2  <-- Before
     0 1 1 0 1 0 0 1 1 0 1   <-- After
    
  3. (#~.......) Apply the above mask as a filter to the input. This drops the first member of every group:

    0 0 1 3 3 2
    
  4. ^:a: Repeat until we reach a fixed point, returning all intermediate results (0-padded on the right):

    0 0 0 1 1 0 3 3 3 2 2
    0 0 1 3 3 2 0 0 0 0 0
    0 3 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0
    
  5. 1-~&# Subtract 1 from 1-~ the above result, after applying the "length of" verb to both lists &#. Since the length of 1 is 1, it remains unchanged, while the result above becomes 4:

    4 - 1
    3
    
\$\endgroup\$
6
\$\begingroup\$

K (ngn/k), 13 bytes

Same as Jonah's, scan of x at where equal each-prior.

#1_{x@&=':x}\

Using 0 0 0 1 1 0 3 3 3 2 2 as example:

=': means equal each prior

  =': 0 0 0 1 1 0 3 3 3 2 2  
      0 1 1 0 1 0 0 1 1 0 1  / zeros in the result correspond to the first item of the run

then indexing into the argument with this mask effectively drops the first item of each run. the indices are:

 &=': 0 0 0 1 1 0 3 3 3 2 2 / where equal each-prior?
1 2 4 7 8 10

 0 0 0 1 1 0 3 3 3 2 2@1 2 4 7 8 10 / indexing 
0 0 1 3 3 2 

we can turn this into a function and repeat until the result stops changing

 {x@&=':x}\0 0 0 1 1 0 3 3 3 2 2
(0 0 0 1 1 0 3 3 3 2 2
 0 0 1 3 3 2
 0 3
 !0)

drop 1 and take the length

 #1_{x@&=':x}\0 0 0 1 1 0 3 3 3 2 2
3

Try it online!

\$\endgroup\$
  • 1
    \$\begingroup\$ Nice. I’d like to see a breakdown to understand the correspondence. \$\endgroup\$ – Jonah May 28 '20 at 4:07
  • \$\begingroup\$ Nice, I thought I was doing well with my 16 bytes. I wouldn't have worked that out on my own - it feels counterintuitive to only take the matches! \$\endgroup\$ – streetster May 28 '20 at 11:05
  • \$\begingroup\$ Thanks for the explanation. So the {...} defines the function and the `` means "repeat it until it stops changing'? \$\endgroup\$ – Jonah May 28 '20 at 13:51
  • 3
    \$\begingroup\$ Yes, and it saves intermediate results. f/ in K is equivalent to f^:_ in J and f\ in K is equivalent to f^:a: in J \$\endgroup\$ – Traws May 28 '20 at 14:10
5
\$\begingroup\$

05AB1E, 8 bytes

.Γ〨˜}g

Try it online or verify all test cases.

Explanation:

.Γ        # Continue until the result no longer changes,
          # collecting all intermediate results in a list
  γ       #  Split the list into chunks of equal adjacent elements
   ۬     #  Remove the last value of each chunk
     ˜    #  Flatten the list of lists
      }g  # After the cumulative fixed-point loop, pop and push the length
          # (which is output implicitly as result)
\$\endgroup\$
4
\$\begingroup\$

Haskell, 41 bytes

f[]=0
f(h:t)=1+f[x|(x,y)<-zip(h:t)t,x==y]

Try it online!

f a=1+f[x|(x,y)<-zip a$tail a,x==y] is the same length.

\$\endgroup\$
4
\$\begingroup\$

Pyth, 10 bytes

tl.uqF#C,t

Try it online!

There's a bug in the parser related to this use of qF#, because if I append three variables at the end (e.g. NNQ), it crashes the parser. This is because qF should be treated as having arity 1, but it's being treated as having arity 2. However, it works fine as is, because the rest of the program is implicit, so the parser completes before anything goes wrong.

Explanation:

tl.uqF#C,t
  .u          Repeatedly apply the following function until the result stops changing:
         t    Remove the first element of the input (tail)
        ,     Pair with the input
       C      Transpose, resulting in all 2 element sublists.
      #       Filter on
    qF        the two elements being equal.
 l            Length
t             Subtract 1 for the empty list.

Note that the intermediate lists look like:

[1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0]
[[0, 0], [1, 1], [0, 0], [0, 0], [0, 0]]
[[[0, 0], [0, 0]], [[0, 0], [0, 0]]]
[[[[0, 0], [0, 0]], [[0, 0], [0, 0]]]]
[]

Try it online!

This occurs because the program doesn't both to select one element from each pair of numbers. Instead, the pair itself is used as the element of the list in the next iteration. This saves 2 bytes.

\$\endgroup\$
3
\$\begingroup\$

Wolfram Language (Mathematica), 38 bytes

If[#!={},#0[Join@@Rest/@Split@#]+1,0]&

Try it online!

\$\endgroup\$
3
\$\begingroup\$

Perl 5 -p, 32 bytes

$\++while s/\b(\d+ )(\1*)/$2/g}{

Try it online!

Requires a trailing space on the input. (Though I did put some code in the header to add it if it isn't already there so that testing is easier.)

\$\endgroup\$
  • 1
    \$\begingroup\$ It doesn't print 0 on an empty list though. (Last test case) \$\endgroup\$ – Abigail May 28 '20 at 12:04
3
\$\begingroup\$

JavaScript (Node.js), 38 bytes

f=s=>s+s?f(s.filter(t=>s===(s=t)))+1:0

Try it online!

JavaScript (Node.js), 42 bytes

f=s=>s+s?f(s.filter(t=>s[++i]==t,i=0))+1:0

Try it online!

\$\endgroup\$
3
\$\begingroup\$

Prolog, 115 bytes

a([_],[]).  
b(_,[],E,E).    
b(A,[B|C],D,E):-A=B,b(A,C,[B|D],E);b(B,C,D,E).   
c(A,B):-A=[],B=0;A=[P|L],b(P,L,[],C),!,c(C,D),B is D+1.

Clear version:

% Cut operation.
% Cut operation.
% Previous A, Head B, Tail C, List D, List E.
b(_, [], E, E).
b(A, [B|C], D, E) :-
    A = B,
    b(A, C, [B|D], E)
;   b(B, C, D, E).

% Count cut.
% List A, Number of cut B.
c(A, B) :-
    A = [],
    B = 0
;   A = [P|L],
    b(P, L, [], C),!,
    c(C, D),
    B is D + 1.
\$\endgroup\$
3
\$\begingroup\$

Husk, 7 bytes

←V¬¡Ψf=

Try it online!

Explanation

It's not often that I get to use the higher order modifier function Ψ, but here it's very convenient.

←V¬¡Ψf=   Implicit input: a list.
   ¡      Iterate (producing an infinite list)
     f    filtering by condition:
    Ψ     the next element
      =   is equal to this one.
          The last element is always discarded.
 V        1-based index of first result that is
  ¬       falsy (for lists, this means empty).
←         Decrement.
\$\endgroup\$
3
+150
\$\begingroup\$

APL (dzaima/APL), 18 bytes

≢1↓{⍵⊇⍨⍸2=/¯1,⍵}⍡≡

{⍵⊇⍨⍸2=/¯1,⍵} - dfn that finds the next stage

⍡≡ iterate until reaching a fixpoint

≢2↓ drop the first two elements, then take the length

-2 bytes thanks to Marshall

-1 byte thanks to Bubbler

Try it online!

\$\endgroup\$
  • 1
    \$\begingroup\$ 18 bytes by avoiding {} on the right side of . \$\endgroup\$ – Bubbler Oct 4 '20 at 23:21
2
\$\begingroup\$

T-SQL, 125 bytes

I am using table as input

DECLARE @ INT=1u:SET
@-=1DELETE x FROM(SELECT*,lag(a,1,-1)over(order by i)b
FROM t)x
WHERE a<>b
IF @@rowcount>0GOTO u
PRINT-@

The posted code is using a permanent table as input. Try it online is using a table variable spending 1 additional byte

\$\endgroup\$
2
\$\begingroup\$

R, 56 55 bytes

f=function(x)`if`(sum(x|1),1+f(x[-cumsum(rle(x)$l)]),0)

Try it online!

Edit: recursive function is 1 byte shorter, and returns 0 for empty input

(original, non-recursive version returned FALSE for empty input)

\$\endgroup\$
2
\$\begingroup\$

Brain-Flak, 68 bytes

([]){{}({}()<>)<>([])}<>({()<{(({}<>)<>[({})]){{}<>{}(<>)}{}}<>>}{})

Try it online!

([]){{}({}()<>)<>([])}<>  # add 1 to everything so I don't have to handle 0

({()<                     # until stack is "empty", counting iterations:
  {                       # for each number
    (
      ({}<>)              # copy to other stack
    <>[({})])             # and compare to next number (or zero if at end)
    {{}<>{}(<>)}{}        # if not equal, remove newly added number
  }<>                     # switch stacks for next iteration
>}{})                     # output number of iterations
\$\endgroup\$
2
\$\begingroup\$

C (gcc), 108 104 101 bytes

*o,*O,r;e(int*s){for(r=1;~*s;r++)for(o=s;~*o;*O=-1){for(;*o==*++o;);for(O=--o;~*O;)*O++=O[1];}s=~-r;}

Try it online!

\$\endgroup\$
  • \$\begingroup\$ @ceilingcat Thank you. \$\endgroup\$ – Jonathan Frech May 28 '20 at 22:21
  • \$\begingroup\$ All your tests return 0 - is that a bug in the answer or your test code? \$\endgroup\$ – Noodle9 May 29 '20 at 8:27
  • \$\begingroup\$ @Noodle9 It was a bug in testing; basically, the input gets modified and I called it twice. Thanks for noting. \$\endgroup\$ – Jonathan Frech May 29 '20 at 19:00
  • \$\begingroup\$ No probs, that why it's best to store the returned value of a test and print/verify that stored result. \$\endgroup\$ – Noodle9 May 29 '20 at 19:57
  • \$\begingroup\$ @ceilingcat Thank you. \$\endgroup\$ – Jonathan Frech Nov 9 '20 at 9:31
1
\$\begingroup\$

Python 2, 63 bytes

Takes in a string \$ s \$, a space-separated string of the numbers. It returns False for the empty case.

f=lambda s:s>''and-~f(re.sub(r'(\d+ )(\1*)',r'\2',s))
import re

Try it online!


Python 2, 65 bytes

Same as above, but returns 0 for the empty case, in case returning false is disallowed.

f=lambda s:len(s)and-~f(re.sub(r'(\d+ )(\1*)',r'\2',s))
import re

Try it online!

\$\endgroup\$
1
\$\begingroup\$

Retina 0.8.2, 27 25 bytes

-2 bytes thanks to @Neil

1`\b
=
}`(\d+ )(\1*)
$2
=

Try it online!

Similar to @Xcali's Perl solution, and similarly requires a trailing space in the input.

1`\b
=

Replace the first word-boundary with a = character. The first time this is executed, it will match the start of the input. On subsequent runs, it will match the empty space between a = and the first number in the list

(\d+ )(\1*)
$2

Replace sequences of repeated integers with everything but the first integer.

}`

Execute the preceding two stages in a loop until the input stops changing

=

Count the number of ='s

\$\endgroup\$
  • \$\begingroup\$ 25 bytes. \$\endgroup\$ – Neil May 28 '20 at 10:02
  • \$\begingroup\$ @Neil Thanks :) I didn't even know that shorthand existed \$\endgroup\$ – math junkie May 28 '20 at 14:34
1
\$\begingroup\$

Jelly,  9  8 bytes

-1 by golfing a 9-byter suggested by clapp

EƝTịµƬL’

Try it online!

\$\endgroup\$
  • \$\begingroup\$ alternative 9-byte port of the K answer: =2\TịµƬL’ \$\endgroup\$ – clapp May 28 '20 at 17:21
  • 1
    \$\begingroup\$ @clapp - thanks, that makes a save of 1 byte possible \$\endgroup\$ – Jonathan Allan May 28 '20 at 18:30
  • \$\begingroup\$ I knew there had to be something shorter than 2\, nice \$\endgroup\$ – clapp May 29 '20 at 11:17
1
\$\begingroup\$

C (gcc), 118 \$\cdots\$ 94 92 bytes

Saved 2 5 7 bytes thanks to ceilingcat!!!

*t;k;c;f(l,n)int*l;{for(k=0;n;++k)for(t=l,c=-1;t-l<n;)c-*t?c=*t,wmemcpy(t,t+1,n--):++t;c=k;}

Try it online!

Commented code

*t;k;c;f(l,n)int*l;{
  for(k=0;                  /* initialise cut operation counter */
    n;                      /* loop until there're no numbers left 
                                     in array */
    ++k)                    /* increment cut operation counter after
                                     every loop */
     for(t=l,               /* save the pointer to the start of 
                                     the array */
       c=-1;                /* initialise c to something that won't
                                     match first number */
       t-l<n;)              /* loop until our temp pointer is past 
                                     the end of the array */
        c-*t?               /* should we do a cut operation? */
         c=*t,              /* save our cuurent number so we do a cut
                                     operation at next different number */
         wmemcpy(t,t+1,n--) /* shift array down one element
                                     and reduce number of elements by 1 */
         :++t;              /* if we're not doing a cut operation
                                     bump pointer */
  c=k;                      /* return k */
}
\$\endgroup\$
0
\$\begingroup\$

Factor, 109 bytes

: f ( s -- n ) 0 swap [ dup empty? ]
[ [ = ] monotonic-split [ 1 tail ] map concat
[ 1 + ] dip ] until drop ;

Try it online!

\$\endgroup\$
0
\$\begingroup\$

Charcoal, 22 bytes

Wθ«≔Φθ∧λ⁻κ§θ⊖λθ⊞υω»ILυ

Try it online! Link is to verbose version of code. Explanation:

Wθ«

Repeat until the input list is empty.

≔Φθ∧λ⁻κ§θ⊖λθ

Filter out the first term and any terms equal to their predecessor, i.e. the first of every run.

⊞υω

Keep track of the number of iterations.

»ILυ

Output the number of iterations.

\$\endgroup\$
0
\$\begingroup\$

Japt, 9 bytes

Ê©ÒßUòÎcÅ

Try it

Ê©ÒßUòÎcÅ     :Implicit input of array U
Ê             :Length
 ©            :Logical AND with
  Ò           :Negate the bitwise NOT of
   ß          :Recursive call with argument
    Uò        :  Partition U between elements where
      Î       :    The sign of their difference is truthy (not 0)
       c      :  Flatten after
        Å     :    Slicing off the first element of each partition
\$\endgroup\$
0
\$\begingroup\$

Clojure, 72 bytes

#(count(take-while seq(iterate(fn[c](mapcat rest(partition-by + c)))%)))

Damn these function names are long :D

\$\endgroup\$
0
\$\begingroup\$

Husk, 8 7 bytes

←LU¡mhg

Try it online!

A different method, which is slightly longer now the same length.

Explanation

←LU¡mhg
      g group runs of consecutive equal elements
   ¡    apply function infinitely, collecting it's results
    mh  drop the last element from each run
  U     cut at fixed point
←L      Get length, decrement.      
\$\endgroup\$

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.