25
\$\begingroup\$

Given a list of positive digits, return that list with consecutive elements grouped together. For example:

[1, 2, 3, 5, 6, 5, 4, 4, 1] -> [[1, 2, 3], [5, 6, 5, 4], [4], [1]]

Essentially, all adjacent elements whose absolute difference is 1 should be grouped together.

The input array will only ever contain positive digits (123456789) and it's length will always fit within your language's integer limit. You may take input in any reasonable format, including as a string or a single integer (so the example would be \$123565441\$). The input will never be empty and will always contain at least 1 element

You may output in any reasonable format that clearly shows the separate groups. There must be clear, non-digit delimiters between the groups. There doesn't have to be clear delimiters between the elements of the groups. If there are, the delimiters between groups and the elements of groups should be distinct (basically, you can't just print the input saying that both are separated by , or whatever).

One example output is shown above. Another could be outputting each group on a separate line, as single strings of digits such as

123
5654
4
1

The input is not guaranteed to be sorted. The order of the outputs, or the elements in the outputs, does not have to match the order of the inputs, so long as the groups and elements are correct.

This is so the shortest code in bytes wins.

Test cases

[1] -> [1]
[1, 2] -> [[1, 2]]
[1, 3] -> [[1], [3]]
[2, 1] -> [[2, 1]]
[2, 4, 1, 2, 7, 6, 5, 1] -> [[2], [4], [1, 2], [7, 6, 5], [1]]
[4, 1, 8, 1, 3, 5, 3, 7, 1] -> [[4], [1], [8], [1], [3], [5], [3], [7], [1]]
[1, 2, 3, 4, 5, 6, 7, 9, 8] -> [[1, 2, 3, 4, 5, 6, 7], [9, 8]]
[1, 2, 3, 5, 6, 5, 4, 4, 1] -> [[1, 2, 3], [5, 6, 5, 4], [4], [1]]
[6, 1, 4, 4, 1, 2, 1, 4, 3, 2, 9, 2, 7, 5, 7, 3, 1, 7, 6, 5] -> [[6], [1], [4], [4], [1, 2, 1], [4, 3, 2], [9], [2], [7], [5], [7], [3], [1], [7, 6, 5]]
[6, 1, 4, 4, 1, 2, 3, 4, 3, 2, 9, 2, 7, 5, 7, 3, 1, 7, 6, 5] -> [[6], [1], [4], [4], [1, 2, 3, 4, 3, 2], [9], [2], [7], [5], [7], [3], [1], [7, 6, 5]]
\$\endgroup\$
7
  • 4
    \$\begingroup\$ Brownie points for beating or matching my 4 byte Jelly answer \$\endgroup\$ – caird coinheringaahing Apr 18 at 22:49
  • \$\begingroup\$ "There must be clear, non-digit delimiters between the groups". So 0 as delimiters are disallowed? \$\endgroup\$ – tsh Apr 19 at 7:48
  • \$\begingroup\$ @tsh As 0 will never be in the input, you can use it as a delimiter \$\endgroup\$ – caird coinheringaahing Apr 19 at 7:49
  • \$\begingroup\$ Do the delimiters have to be consistent, or can they be different for different inputs? \$\endgroup\$ – pxeger Apr 19 at 17:34
  • \$\begingroup\$ @pxeger The delimiters should be consistent across inputs \$\endgroup\$ – caird coinheringaahing Apr 19 at 17:35

31 Answers 31

9
\$\begingroup\$

APL (Dyalog Extended), 13 bytes

⊢⊂⍨1,1≠∘|2-/⊢
⊢⊂⍨1,1≠∘|2-/⊢
         2-/⊢  pairwise differences
     1≠∘|      1 not equal to absolute value
⊢⊂⍨1,          prepend 1 and partition

Try it online!

\$\endgroup\$
2
  • \$\begingroup\$ This time we found the exact same solution :) (not surprising for this problem). \$\endgroup\$ – Jonah Apr 18 at 23:24
  • \$\begingroup\$ Yep, definitely the obvious way to do it \$\endgroup\$ – rak1507 Apr 18 at 23:26
9
\$\begingroup\$

convey, 36 bytes

Outputs the groups separated by newlines.

{"">>v>v}
1~?`]>^,`
 >-|=.!`
   _1 _

Try it online!

Copies " each element, delays it by one step 1~, so it matches up at - with the next element. The first element gets discarded with ?`]. Take the absolute value of the difference |_, is it different from 1 1=.? Then take either 0 or 1 _ values, which will be interpreted as newline by the output.

Meanwhile the original outputs trots along the upper line, so its output is aligned with the newlines.

example run

\$\endgroup\$
9
\$\begingroup\$

J, 17 bytes

<;.1~1,1~:&|2-/\]

Try it online!

Thanks to rak for pointing out that repeated elements should start a new group

  • 2-/\] Take successive deltas
  • 1~:&| Is the absolute value not equal to 1?
  • 1, Append one (since first element always starts a new group)
  • <;.1~ Group by that mask (ie, start new group every time there's a one)
\$\endgroup\$
0
8
\$\begingroup\$

Jelly, 4 bytes

I²’k

Try it online!

Possibly caird's solution:

Jelly, 4 bytes

IACk

Try it online!

   k    Split the input after
I       the deltas of the input
 ……     equal to ±1:

 ²      square each
  ’     and decrement each

 A      take the absolute value of each
  C     and subtract from 1
\$\endgroup\$
1
  • 2
    \$\begingroup\$ There's also another 4 byter, that's ascii only :) \$\endgroup\$ – caird coinheringaahing Apr 18 at 23:12
8
\$\begingroup\$

R, 38 bytes

split(a<-scan(),diffinv(diff(a)^2!=1))

Try it online!

\$\endgroup\$
3
  • \$\begingroup\$ Very elegant. This seems to work for 37 bytes, but I might be missing some edge cases. \$\endgroup\$ – Robin Ryder Apr 19 at 19:32
  • \$\begingroup\$ @RobinRyder - Nice! Thanks! I think I was stupidly worrying about outputting the groups in the same order as the input, without properly reading the challenge rules... \$\endgroup\$ – Dominic van Essen Apr 19 at 19:59
  • \$\begingroup\$ @RobinRyder - I'm afraid I found the edge-case you were worrying about... thanks for the idea anyway! \$\endgroup\$ – Dominic van Essen Apr 19 at 22:03
7
\$\begingroup\$

Factor, 33 32 bytes

[ [ - sq 1 = ] monotonic-split ]

Try it online!

Saved a byte by peeking at @xnor's Haskell answer! Take the square instead of the absolute value.

Explanation:

It's a quotation (anonymous function) that takes a sequence from the data stack as input and leaves a sequence (of sequences) on the data stack as output. Assuming { 1 2 4 } is on the data stack when this quotation is called...

  • [ - sq 1 = ] Push a quotation for monotonic-split to use later. It's a function that tests whether two numbers have an absolute difference of 1.

    Stack: { 1 2 4 } [ - sq 1 = ]

  • monotonic-split Take a sequence and a quotation and apply the quotation to each pair of adjacent members of the sequence, splitting the sequence when the result is f but grouping elements together when the result is t. Inside the quotation during the first iteration now...

    Stack: 1 2

  • - Subtract.

    Stack: -1

  • sq Raise to the power of 2.

    Stack: 1

  • 1 Push 1.

    Stack: 1 1

  • = Test whether two objects are equal.

    Stack: t, thus 1 and 2 belong to the same group.

Now the next iteration begins, 2 and 4 produce f, so 4 is in a different group from 1 and 2.

\$\endgroup\$
5
\$\begingroup\$

Retina 0.8.2, 54 bytes

\B
¶
.
$&$&
%T`d`_d`^.
(?<=(.)(.))¶(\2|.(?=\1))

%`^.

Try it online! No test suite because the multiline output makes it confusing. Explanation:

\B
¶

Split the string into individual digits.

.
$&$&
%T`d`_d`^.

Duplicate each digit and decrement the first digit of each pair.

(?<=(.)(.))¶(\2|.(?=\1))

Merge together consecutive digits, removing the decremented duplicate of the second digit.

%`^.

Remove the remaining decremented duplicates.

\$\endgroup\$
5
\$\begingroup\$

Branch, 28 bytes

/,^\b[N^-b;c;^*{[10.0]\n.b,]

Try it on the online Branch interpreter!

Takes input as a string of digits. Outputs with groups newline-separated and elements of a group joined in one string on each line. There is a leading newline; hopefully that's acceptable.

Explanation

/,                       Go to the left child and read a character (stores codepoint)
^\                       Go to the right child (just creates this node for operating on)
b                        Go to register B; this is the left child since it was created second
[                     ]  While [the left child] is true
 N                       Save the most recently inputted byte as register N
  ^-                     Go to the root and perform (left child) - (right child); the right child saves the previous input; initially codepoint 0
    b;c;                 Go to register B (left child) and copy parent; go to C (right child) and copy parent
        ^*               Go to parent and perform (left child) * (right child) (this could've been done with b;c2^' as well to square with conventional exponentiation)
          {              Decrement; this is now 0 if the absolute difference was 1 and non-zero otherwise
           [   0]        While statement; zeroes the value at the end so this is transformed into an if statement
            10.          Set value 10 and output as character (outputs a newline if the difference isn't 1 / -1)
                 \n      Go to the right child and save N
                   b,    Go to the left child and read a new character, setting the state for the next iteration of the while loop

Reading from STDIN when nothing is left gives 0, so this terminates once input ends.

\$\endgroup\$
5
\$\begingroup\$

Haskell, 59 bytes

f[]=[]
f(x:y)|(a:b):t<-f y,(x-a)^2==1=(x:a:b):t|0<1=[x]:f y

Try it online!

The relevant function is f, which takes a list as input and returns a list of lists as output.


Unfortunately the builtin

groupBy(\x y->(x-y)^2==1)
import Data.List

doesn't work, since Haskell's groupBy always compares new elements to the first element of the group.

\$\endgroup\$
5
\$\begingroup\$

Vim, 43 38 bytes

-5 bytes thanks to @DLosc by using clever hyphen evaluating shenanigans.

qqy3ll:if abs(<C-r>0)!=1
norm r|
en
l@qq@q

Try it online!

Takes input as a hyphen-separated list of numbers.

Explanation:

qq                        # Start recording macro 'q'
  y3l                     # Yank this character and the next two; this will be 'X-X'
     l                    # Move right one character
      :if                 # If...
          abs(      )     # The absolute value of...
              <C-r>0      # The previously yanked text, evaluated...
                     !=1  # Does not equal 1:
norm r|                   #   Replace the current character with '|'
en                        #   End if
l                         # Move right one character
 @q                       # Call macro 'q' recursively
   q                      # End macro
    @q                    # Call macro 'q'
\$\endgroup\$
2
  • \$\begingroup\$ Here's 41 bytes using the C-r C-w shortcut for "current word" (bonus: the input doesn't need any trailing spaces). Or 38 bytes if you're willing to take the input hyphen-separated. ;) \$\endgroup\$ – DLosc 5 hours ago
  • \$\begingroup\$ @DLosc Added. Since this is a bit cleverer than my version, I also added an explanation. \$\endgroup\$ – Aaron Miller 4 hours ago
4
\$\begingroup\$

Haskell, 74 bytes

p%(a:b:t)|abs(a-b)/=1=(p++[a]):[]%(b:t)|x<-p++[a]=x%(b:t)
p%t=[p++t]
([]%)

Try it online!

I don't like the repetition here, but I can't see a way to get around it.

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

brainfuck, 51 bytes

This beats some of the mainstream language answers!

(byte count excludes 4 unnecessary newlines added for clarity.)

,[[<->>+<-]<
-[>]>[>+<<]<+
+[>]>[>+<<]<-
>>>-[.-]
<.>,]

Try it online!

Outputs each group of characters preceded by an ASCII 1 for example as below

123565441

The digits are interpreted as ASCII characters and the initial ASCII 1 separator appears because the ASCII codes 48-57 of the digits are not consecutive to the zeroes which fill the Brainfuck memory at the start. Removing the initial separator would take another few bytes of code (I think it's no more of an issue than a trailing newline separator. Others may disagree.)

Commented code

,[[<->>+<-]<  Take input in cell 0 and copy it to the cell 1 while subtracting from cell minus 1
-[>]>[>+<<]<+ Subtract 1 from cell minus 1 and if it is not now zero add 1 to cell 2 (relies on the fact that cell 0 is zero and cell 1 is positive) 
+[>]>[>+<<]<- Add 1 to cell minus 1 and if it is not now zero add 1 to cell 2
>>>-[.-]      Subtract 1 from cell 2 and if not now zero both tests above failed so output ascii 1 and then zero the cell  
<.>,]         Output the input character now in cell 1 and loop again until a zero byte terminator is encountered
              Second input character will go into cell 2 and will be copied into cell 3 and compared with the previous character in cell 1 and so on advancing 2 cells each time
\$\endgroup\$
3
  • \$\begingroup\$ I've edited it to use the actual ASCII 1 characters in the example. Feel free to rollback if you'd rather stick with . :) \$\endgroup\$ – caird coinheringaahing Apr 19 at 23:01
  • \$\begingroup\$ @cairdcoinheringaahing Thanks! They looked fine when I was editing, but completely vanished when I posted. \$\endgroup\$ – Level River St Apr 19 at 23:07
  • \$\begingroup\$ Yeah, SE has a bit of a problem with unprintables. The "hack" to make them work (so you and anyone else don't have to go diving into the revision history) is to do &#<num>; where <num> is their ASCII code point, e.g. &#1;, and wrapping code blocks in <pre><code>...</code></pre> tags \$\endgroup\$ – caird coinheringaahing Apr 19 at 23:09
3
\$\begingroup\$

Husk, 5 bytes

ġo=1≠

Try it online!

group on absolute difference = 1.

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

JavaScript (ES7), 43 bytes

Saved 4 bytes thanks to @tsh

Expects an array of digit characters. Returns a string with the groups separated with commas.

a=>a.map(p=v=>(p-(p=v))**2-1?[,v]:v).join``

Try it online!

\$\endgroup\$
3
  • \$\begingroup\$ a=>a.map(p=v=>(p-(p=v))**2-1?[,v]:v).join`` \$\endgroup\$ – tsh Apr 19 at 7:40
  • \$\begingroup\$ Using flatMap is 43 bytes too a=>a.flatMap(p=v=>(p-(p=v))**2-1?[',',v]:v) \$\endgroup\$ – tsh Apr 19 at 7:53
  • 1
    \$\begingroup\$ @tsh Thank you! I think I should refrain from posting when I'm almost falling asleep... :-/ \$\endgroup\$ – Arnauld Apr 19 at 11:27
3
\$\begingroup\$

Wolfram Language (Mathematica), 23 bytes

Split[#,!-1!=#2-#!=1&]&

Try it online!

Split can take a second argument, which is applied to adjacent pairs to see if they should be in the same group.

!-1!=#2-#!=1 has the same length as Abs[#2-#]==1, and asserts that -1, #2-#, and 1 are not all unequal - that is, -1==1 || -1==#2-# || #2-#==1.

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

Ruby, 48 bytes

->l{y=0;l.chunk{|x|$.+=(y-y=x)**2-1}.map &:last}

Try it online!

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

Japt, 6 bytes

Outputs a 2D array.

òÈaY É

Try it

òÈaY É     :Implicit input of array
ò          :Partition between pairs that return falsey (0)
 È         :When passed through this function as X & Y
  aY       :  Absolute difference
     É     :  Minus 1
\$\endgroup\$
2
\$\begingroup\$

Julia, 47 bytes

f(s,p='a')=join(' '^((p-i)^2!=1)*(p=i) for i=s)

Try it online!

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

Python 2, 52 bytes

p=0
for n in input():print"X"*p*(abs(n-p)!=1),n,;p=n

The program separates the input with the character "X".

Try it online!

55 bytes

lambda n:reduce(lambda a,b:a+[abs(a[-1]-b)==1,b],n,[0])

Alternate 55 byte solution that uses reduce.

Try it online!

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

PHP -F, 59 bytes

for(;$n=$argn[$i++];$m=$n)$a.=abs($n-$m)-1?",$n":$n;echo$a;

Try it online!

Takes a string of digits, outputs a string with delimiter ",". Has a preceding delimiter except when first digit is 1.

Well, at least it beats the Scratch answer :P

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

Racket, 241 bytes

(λ(s)(letrec([d(λ(t n c)(if(null?(cdr t))(reverse c)(if(=(sqr(-(car t)(cadr t)))1)(d(cdr t)(+ 1 n)c)(d(cdr t)1(cons n c)))))][g(λ(t c a)(if(null? c)(cons t a)(g(drop t(car c))(cdr c)(cons(take t(car c))a))))])(reverse(g s(d s 1'())'()))))

Try it online!

What a monstrosity! I won't be surprised if it can be done in under 100 bytes.

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

K (oK), 24 21 bytes

-3 bytes thanks to streetster!

{(?0,&~1=d*d:-':x)_x}

Try it online!

\$\endgroup\$
4
  • 1
    \$\begingroup\$ {(?0,&~1=d*d:-':x)_x} for 21 bytes. \$\endgroup\$ – streetster Apr 20 at 15:21
  • \$\begingroup\$ @streetster Thank you! Can you explain to me how does ? work (how it removes the empty lists)? \$\endgroup\$ – Galen Ivanov Apr 20 at 17:53
  • \$\begingroup\$ ? is distinct :) for a full breakdown see TIO \$\endgroup\$ – streetster Apr 21 at 16:49
  • 1
    \$\begingroup\$ @streetster Thanks, I finally got it - ? just gets rid of the double 0s and thus doesn't create empty sublists. \$\endgroup\$ – Galen Ivanov Apr 22 at 11:16
2
\$\begingroup\$

C (gcc), 56 54 bytes

f(char*n){for(;*n;~-abs(putchar(*n)-*++n)&&puts(""));}

Try it online!

Takes a string of digits as input; prints output to STDOUT with each group on a separate line.

-2 thanks to @ceilingcat

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

Charcoal, 21 bytes

P§θ⁰FΦθκ«¿⊖↔⁻IKKι⸿→Pι

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

P§θ⁰

Output the first character of the input without moving the cursor.

FΦθκ«

Loop over the remaining characters.

¿⊖↔⁻IKKι

If the current character is not a neighbour of the character under the cursor, then ...

⸿

... move to the start of the next line, ...

... otherwise move right one character.

Pι

Output the current character without moving the cursor.

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

><>, 19 bytes

:n$:@-:1=$i=+1$-a*o

Looks like TIO's -v flag support broke, and fishlanguage.com is down, so no link.

Takes the list on the stack, from top to bottom.

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

Zsh -o extendedglob, 38 bytes

>-1;for a {wc<^*$[b?a-b:1];b=$a;<<<$a}

Try it online!

I really feel like there's some way to shave off 1 or 2 bytes from the $[b?a-b:1].

  • >-1: create the empty file -1
  • for a {}: for each input element:
    • $[]: arithmetic expansion
      • a-b: take the difference between this element and the previous b
      • b?:1: if b is not defined (because we're on the first iteration), then assume the difference is 1
    • *...: match files that end with that difference. This is so the file -1 will be matched by a difference of either 1 or -1
    • ^*...: inverted match; matches files that don't end with that difference
    • <: and feed them as input to:
    • wc word count; outputs 0 0 0 (our separator) since the file is empty
    • So if the difference is 1 or -1, it will not match, so there will be no files as input to wc and it won't output the separator
    • b=$a: set b for the next iteration
    • <<<$a: print a
\$\endgroup\$
1
\$\begingroup\$

Scratch, (by @att) 184 bytes

Try it online!

All credit goes to @att

define(x
set[a v]to(
set[i v]to(
repeat(length of(x
change[i v]by(1
set[t v]to(letter(i)of(x
set[a v]to(join(a)((t)*(((2)*<(-1)contains((t)-(letter(length of(a))of(a)))?>)-(1
end
say(a
\$\endgroup\$
2
  • 2
    \$\begingroup\$ 184 bytes, delimiting with -s (28 blocks, I think) \$\endgroup\$ – att Apr 20 at 3:48
  • \$\begingroup\$ Exhales drink. Wow! You should post that as your own answer \$\endgroup\$ – Nilster Apr 20 at 17:24
1
\$\begingroup\$

Arn 1.0, 6 bytes

PWº··,

Explained

Unpacked: ::-.|=1

  _         Input; implied
::          Sort adjacent by
        _   First value
      -     Minus
        _   Second value
    .|      Absolute value
  =         Equals
    1       One
\$\endgroup\$
1
\$\begingroup\$

Python 2, 47 bytes (43 bytes?)

47 bytes

p=0
for n in input():print`-n`[-abs(n-p):],;p=n
  • Separator inside a group is

  • Separator between groups is -

Try it online!

how it work:

  • `-n` is the string representation of -n (it is 2 character long)

With strings:

  • if 2 consecutive number are equal : -abs(n-p) = 0 and "ab"[0:] = "ab"
  • if the absolute difference is equal to 1: -abs(n-p) = -1 and "ab"[-1:] = "b"
  • if the absolute difference is greater than 1 (say for example 2): -abs(n-p) = -2 and "ab"[-2:] = "ab"

43 bytes?

I also have a "edgy" solution in 43 bytes, don't know if the output format is "reasonable" :

p=0
for n in input():print(n-p)**2==1,n;p=n
  • Separator inside a group is \nTrue

  • Separator between groups is \nFalse

Try it online!

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

05AB1E, 7 bytes

üα≠0šÅ¡

Try it online or verify all test cases.

Explanation:

ü        # For each overlapping pair in the (implicit) input-list:
 α       #  Get the absolute difference
  ≠      # Check for each that they're NOT 1 (0 if 1; 1 otherwise)
   0š    # Prepend a 0 to the list
     Å¡  # Split the (implicit) input-list at the truthy indices
\$\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.