Close neighbours stick together

Question

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 code-golf 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]]

Answer 1

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!

Answer 2

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.

Answer 3

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)

Answer 4

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

Answer 5

R, 38 bytes

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

Try it online!

Answer 6

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.

Answer 7

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.

Answer 8

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.

Answer 9

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.

Answer 10

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.

Answer 11

Vim, ⁴³ 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'

Answer 12

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

123
5654
4
1

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

Answer 13

Husk, 5 bytes

ġo=1≠

Try it online!

group on absolute difference = 1.

Answer 14

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!

Answer 15

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

Answer 16

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.

Answer 17

K (oK), 24 21 bytes

-3 bytes thanks to streetster!

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

Try it online!

Answer 18

Ruby, 48 bytes

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

Try it online!

Answer 19

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!

Answer 20

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

Answer 21

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.

Answer 22

C (gcc), ⁵⁶ 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

Answer 23

Julia, ⁴⁷ 46 bytes

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

Try it online!

Input is a list of Chars and output is a string with spaces to delimit groups, example:

f(['2','4','1','2','7','6','5','1']) = " 2 4 12 765 1"

Answer 24

Charcoal, 21 bytes

Ｐ§θ⁰ＦΦθκ«¿⊖↔⁻ＩＫＫι⸿→Ｐι

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

Ｐ§θ⁰

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

ＦΦθκ«

Loop over the remaining characters.

¿⊖↔⁻ＩＫＫι

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.

Ｐι

Output the current character without moving the cursor.

Answer 25

><>, 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.

Answer 26

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

Answer 27

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

Answer 28

Arn 1.0, 6 bytes

PWº··,

Explained

Unpacked: ::-.|=1

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

Answer 29

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

Answer 30

Pip, 14 bytes

aWV(k1N_-BMPa)

Takes input via command-line argument as a string of digits. Outputs with separator , between groups and within groups. Try it online!

Explanation

          MPa   Map this function to each pair of digits in the input:
     1N          Count the number of 1's in
       _-B       the first digit minus the second (1 if the difference is +/-1, 0 otherwise)
   (k        )  Use that list of 1's and 0's to index into the preset variable k == ", "
                We now have a list of length len(a)-1 containing spaces and commas
aWV             Weave the input string with that list
                Autoprint (implicit)