# AoCG2021 Day 13: Defrag in action!

Part of Advent of Code Golf 2021 event. See the linked meta post for details.

The story continues from AoC2017 Day 14.

To recap: The disk is a rectangular grid with $$\r\$$ rows and $$\c\$$ columns. Each square in the disk is either free (0) or used (1). So far, you have identified the current status of the disk (a 0-1 matrix), and the number of regions in it (a region is a group of used squares that are all adjacent, not including diagonals).

But we didn't actually defrag the disk yet! Since we identified the regions of used squares, let's assume the shape of each region should be kept intact. It makes it hard to compact the used space, but we can at least move each chunk to the left. Let's do it.

More formally, the algorithm would look like this:

• Identify the regions of used cells in the disk.
• Loop until there is nothing to move:
• Select a region that can be moved 1 unit to the left without overlapping with another region.
• Move it 1 unit to the left. (The regions do not fuse into one even if they become adjacent after such a move.)

Input: A rectangular array of zeroes and ones.

Output: A rectangular array of same size, which represents the result of the simple defrag operation.

For example, if the memory looks like this: (# is used, . is free)

##.#.#..
.#.#.#.#
....#.#.
#.#.##.#
.##.#...
##..#..#
.#...#..
##.#.##.


then it has 12 distinct regions

00.1.2..
.0.1.2.3
....4.5.
6.7.44.8
.77.4...
77..4..9
.7...a..
77.b.aa.


which should be defragged in this way:

0012....
.0123...
...45...
6.7448..
.774....
77.49...
.7.a....
77baa...


resulting in the disk state of

####....
.####...
...##...
#.####..
.###....
##.##...
.#.#....
#####...


Standard rules apply. The shortest code in bytes wins.

## Additional test cases

...#####
...#...#
...#.#.#
.....#..
########
->
..#####.
..#...#.
..#..##.
.....#..
########

.....#####..
.....#...#..
.....#.#.#.#
.......#...#
.......#####
->
#####.......
#...#.......
##..##......
.#...#......
.#####......

• I think some test cases with weird overhangs would be good, especially where a region is prevented from moving left by a cell that's not the leftmost in its row.
– xnor
Commented Dec 13, 2021 at 1:54
• Suggested test-case: .....#####../.....#...#../.....#.#.#.#/.......#...#/.......#####. Requires moving region A one to the left, then B one to the left, A one to the left, ... Commented Dec 13, 2021 at 4:53

# Wolfram Language (Mathematica), 109 bytes

#//.x_:>(x-#+RotateLeft/@#&)@ImageData@SelectComponents[Image@x,#BoundingBox[[1,1]]>0&,CornerNeighbors->1<0]&


Try it online!

Repeatedly select the components whose bounding box's x_min is greater than 0, and move these components 1 unit to the left.

The SelectComponents function has a bug: when it takes an array instead of an image as input, the CornerNeighbors option does not work. So we have to convert the input into an image.

# TypeScript Types, 804 bytes

//@ts-ignore
type a<T,N=[]>=T extends${N["length"]}?N:a<T,d<N>>;type b<T>={[I in keyof T]:{[J in keyof T[I]]:T[I][J]extends 1?[a<J>,a<I>]:never}[keyof T[I]]}[number];type c<T>=(T extends T?(x:()=>T)=>0:0)extends(x:infer U)=>0?U extends()=>infer V?V:0:0;type d<T>=[...T,0];type e<T>=T extends[0,...infer X]?X:[];type f<T>=T extends[infer A,infer B]?[e<A>,B]|[d<A>,B]|[A,e<B>]|[A,d<B>]:0;type g<P,T=c<P>,U=0>=[T]extends[U]?T:g<P,T|Extract<f<T>,P>,T>;type h<P,G=[]>=[P]extends[never]?G:h<Exclude<P,g<P>>,[...G,g<P>]>;type i<T>=T[0]extends[0,...0[]]?T extends T?[e<T[0]>,T[1]]:0:{};type j<T,U=0>=T extends U?T:j<{[K in keyof T]:Extract<Exclude<T[number],T[K]>,i<T[K]>>extends 0?i<T[K]>:T[K]},T>;type M<T,U=j<h<b<T>>>[number]>={[I in keyof T]:T[I]extends infer X?{[J in keyof X]:[a<J>,a<I>]extends U?1:0}:0}  Try It Online! ## Ungolfed / Explanation // Converts a stringified number into a tuple type StrNumToTuple<T, N = []> = T extends ${N["length"]} ? N : StrNumToTuple<T, [...N, 0]>;

// Converts the input (e.g. [[0,0,1],[1,0,1],[0,1,1]])
// to a union of on cells ([2,0]|[0,1]|[2,1]|[1,2]|[2,2]) (where the numbers are represented by tuples)
type ToUnion<T> =
// Map over the 2d array
{ [I in keyof T]: { [J in keyof T[I]]:
T[I][J] extends 1
// if the cell is on, add this tuple
? [StrNumToTuple<J>, StrNumToTuple<I>]
: never
// put the results into a union
}[keyof T[I]] }[number]

// Retrieves an arbitrary element of a union
type PopUnion<T> = (T extends T ? (x: () => T) => 0 : 0) extends (x: infer U) => 0 ? U extends () => infer V ? V : 0 : 0;

type Inc<T> = [...T, 0];
type Dec<T> = T extends [0, ...infer X] ? X : [];

// Get the orthogonal neighbor positions of a position
type Neighbors<T> = T extends [infer A, infer B] ? ( ([Dec<A>, B] | [Inc<A>, B] | [A, Dec<B>] | [A, Inc<B>]) ) : 0;

type FindGroup<All, Group = PopUnion<All>, LastGroup = 0> =
[Group] extends [LastGroup]
// If the group didn't change last iteration, return it
? Group
// Add to Group the Neighbors of Group that are in All
: FindGroup<All, Group | Extract<Neighbors<Group>, All>, Group>

// Converts a union of positions into a tuple of unions of positions, grouped by connectedness
type Group<Ungrouped, Groups = []> =
[Ungrouped] extends [never]
// If there are no positions left in Ungrouped, return Groups
? Groups
// Find a group, remove its elements from Ungrouped, and add it to Groups
: Group<Exclude<Ungrouped, FindGroup<Ungrouped>>, [...Groups, FindGroup<Ungrouped>]>

// Shift a group to the left. Returns {} (a top type of sorts) if it's at the leftmost border
type ShiftLeft<Group> =
Group[0] extends [0, ...0[]]
// If all X coordinates are >= 1, map over the positions in Group
? Group extends Group
// Decrement the X coordinate of this position
? [Dec<Group[0]>, Group[1]]
// Unreachable
: 0
// Otherwise, return {}
: {}

// The meat of the logic. Continually shifts groups left until it can't anymore
type Defrag<Groups, PrevGroups = 0> =
Groups extends PrevGroups
// If Groups == PrevGroups, return Groups
? Groups
// Otherwise, recurse:
: Defrag<
{
// Map over Groups
[K in keyof Groups]:
// If (Groups[number] (all live positions) - Groups[K]) shares no elements with ShiftLeft<Groups<K>>,
Extract<Exclude<Groups[number], Groups[K]>, ShiftLeft<Groups[K]>> extends 0
// Change this group to ShiftLeft<Groups[K]>
? ShiftLeft<Groups[K]>
// Otherwise, leave it unchanged
: Groups[K]
},
Groups
>

type Main<Input, FinalLivePositions = Defrag<Group<ToUnion<Input>>>[number]> = {
// Map over every row of Input
[I in keyof Input]: Input[I] extends infer Row ? {
// Map over every cell of Row
[J in keyof Row]:
// If this coordinate is in FinalLivePositions, set this cell to 1; otherwise, set it to 0
[StrNumToTuple<J>, StrNumToTuple<I>] extends FinalLivePositions ? 1 : 0
} : 0
}


# Python3, 519 bytes

import re
r=range
def f(b,x,y,t):
b[x][y]=t
for j,k in[[1,0],[0,1],[-1,0],[0,-1]]:
try:
if x+j>=0 and y+k>=0 and b[x+j][y+k]==1:f(b,x+j,y+k,t)
except:1
def g(b):
n=map(chr,r(97,123))
while'1'in str(b):f(b,*[(x,y)for x in r(len(b))for y in r(len(b[x]))if b[x][y]==1][0],next(n))
return re.sub('\w','#',(q:=lambda r:r if r==(t:=re.sub('\.\w+',lambda x:j if re.findall('^'+(j:=x.group())[1]+'|(?<=[^'+'\.'+j[1]+'])'+j[1],r)else j[1:]+'.',r))else q(t))('\n'.join(''.join(['.',i][bool(i)]for i in k)for k in b)))


Try it online!

• You can remove the space at return'' for -1 byte. Also, we have to output as 0/1 (or any two distinct characters) instead of the unique regions, so you'll have to convert the flood-filled regions back to 1 after you're done moving them.. (This also costed +42 bytes in my Java answer unfortunately.) Commented Dec 14, 2021 at 7:50
• @KevinCruijssen Thank you, updated. Commented Dec 15, 2021 at 1:22
• Np. :) One more thing to golf is x+j>=0 and y+k>=0 to x+j>=0<=y+k, although I'm sure a lot more can be golfed. I'm not too skilled with Python tbh. Commented Dec 15, 2021 at 8:11

# JavaScript (Node.js), 190 bytes

w=>g=a=>a.some((c,i)=>!a.some(n=_=>a.some((d,j)=>(r=~j%w?j+1:j,d-c)?d*n[r]:(n[j]=[j,j%w?j-1:j,r,j-w,j+w].some(k=>n[k]))*!(j%w)),n[i]=++t))?g(a.map((c,i)=>n[i+1]?t:!n[i]*c)):a.map(c=>c>0);t=1


Try it online!

Input as 1d array of boolean values and width as an integer. Output 1d array of boolean values.

# Charcoal, 120 105 bytes

ＷＳ⊞υι≔⊕Ｌθθ≔⌕Ａ⪫υψ#η≔⟦⟧ζＷη«≔⟦⊟η⟧εＦεＦ⁺κ⟦θ¹±¹±θ⟧Ｆ№ηλ«⊞ελ≔⁻ηεη»⊞ζε»ＷΦζ⬤κ∧﹪μθ¬⊙ζ›№ξ⊖μ⁼ξκＦιＵＭκ⊖λＥυ⭆ι§.#⊙ζ№ν⁺×θκμ


Try it online! Link is to verbose version of code. Takes input as a list of newline-terminated strings of .s and #s and outputs a list of newline-separated strings. Explanation:

ＷＳ⊞υι


Input the cells.

≔⊕Ｌθ


Get the offset between each cell and the cell below. (This is one more than the width so a region at the end of a line doesn't inadvertently connect with the one at the start of the next line.)

≔⌕Ａ⪫υψ#η


Get the list of used cells.

≔⟦⟧ζ


Start with no regions.

Ｗη«


Repeat until all of the used cells have been allocated to a region.

≔⟦⊟η⟧ε


Start the region with the last (i.e. golfiest) used cell.

Ｆε


Perform a breadth-first search over the region.

Ｆ⁺κ⟦θ¹±¹±θ⟧


Enumerate the coordinates of the adjacent cells.

Ｆ№ηλ«⊞ελ≔⁻ηεη»


If this is a used cell, then add it to the region and remove it from the list of used cells.

⊞ζε


Save this region to the list of regions.

»ＷΦζ⬤κ∧﹪μθ¬⊙ζ›№ξ⊖μ⁼ξκ


Repeat while any regions can be defragmented...

ＦιＵＭκ⊖λ


... move all cells in those regions left by 1 cell. (Sadly MapAssign doesn't do what I want here.)

Ｅυ⭆ι§.#⊙ζ№ν⁺×θκμ


Output the original input updated with the new locations of all the used cells.

Previous 120-byte version did not require rectangular input:

≔⟦⟧θＷＳ«Ｆ⌕Ａι#⊞θ⟦Ｌυκ⟧⊞υι»≔⟦⟧ηＷθ«≔⟦⊟θ⟧ζＦζＦＥ⁴Ｅκ⁺ν∧⁼ξ＆¹λ⊖＆²λＦ№θλ«⊞ζλ≔⁻θζθ»⊞ηζ»ＷΦη⬤κ∧§μ¹¬⊙η›№ξＥμ⁻ρς⁼ξκＦιＦκＵＭλ⁻μνＥυ⭆ι§.#⊙η№ν⟦κμ


Try it online! Link is to verbose version of code. Takes input as a list of newline-terminated strings of .s and #s and outputs a list of newline-separated strings. Explanation:

≔⟦⟧θ


Start with no used cells.

ＷＳ«


Loop over the input strings.

Ｆ⌕Ａι#⊞θ⟦Ｌυκ⟧


Record the used cells in this string.

⊞υι


Save this string so that the output has the same shape as the input.

»≔⟦⟧η


Start with no regions.

Ｗθ«


Repeat until all of the used cells have been allocated to a region.

≔⟦⊟θ⟧ζ


Start the region with the last (i.e. golfiest) used cell.

Ｆζ


Perform a breadth-first search over the region.

ＦＥ⁴Ｅκ⁺ν∧⁼ξ＆¹λ⊖＆²λ


Enumerate the coordinates of the adjacent cells.

Ｆ№θλ«⊞ζλ≔⁻θζθ»


If this is a used cell, then add it to the region and remove it from the list of used cells.

⊞ηζ


Save this region to the list of regions.

»ＷΦη⬤κ∧§μ¹¬⊙η›№ξＥμ⁻ρς⁼ξκ


Repeat while any regions can be defragmented...

ＦιＦκＵＭλ⁻μν


... move all cells in those regions left by 1 cell.

Ｅυ⭆ι§.#⊙η№ν⟦κμ


Output the original input updated with the new locations of all the used cells.

# Python 3 + scipy, 162, 160 bytes

from scipy.ndimage import*
def f(A):
B,J=label(A.T);j=1
while~J+j:C=B==j;B[C]=0;D=C^C;D[:-1]=C[1:];d=C[0].any()|B[D].any();B[[D,C][d]]=j;j=d*j+1
return B.T>0


Try it online!

#### Older versions:

from scipy.ndimage import*
def f(A):
B,J=label(A.T);j=1
while~J+j:C=B==j;B[C]=0;D=C^C;D[:-1]=C[1:];d=C[0].any()or B[D].any();B[[D,C][d]]=j;j=d*j+1
return B.T>0


Try it online!

# Explanation

Leaves the heavy lifting (the segmentation) to a library function, scipy.ndimage.label.

The rest is relatively straight forward. Everything is done with transposed axes to save indexing clutter. We push one labelled component one unit a time until we run through all of them without being able to move anything anymore.

More specifically, C selects the pixels for label l and we immeditately zero them out; D shifts the selection. d decides based on whether there are labelled pixels (1) in the base column or (2) (after shifting) collisions with other labels. If d is set we write the erased pixels back and move to the next label, if d is not set we shift them and reset the label index.

# Java 10, 463459444 443 bytes

int M[][],v;m->{int l=m[0].length,t=m.length*l,i,F=v=1,f,x,a,b;for(M=m;v++<t;)for(i=t;i-->0;)i=m[i/l][i%l]==1?f(i/l,i%l)-1:i;for(;F>0;)for(F=v=0;v++<t;F=f>0?1:F){for(f=-1,i=t;i-->0;)f&=m[a=i/l][b=i%l]==v&b>0?(x=m[a][b-1])<1|x==v&b>1?1:0:f;for(;f>0&++i<t;)m[a=i/l][b=i%l]-=m[a][b]==v&b>0?m[a][b-1]=v:0;}for(;t-->0;)m[t/l][t%l]=1/~m[t/l][t%l]+1;}int f(int x,int y){try{if(M[x][y]==1){M[x][y]=v;f(x+f(x,y+f(x-f(x,y-1),y)),y);}}finally{return 1;}}


-5 bytes thanks to @ceilingcat.

Try it online.

Explanation:

int M[][],             // Integer-matrix on class-level, uninitialized
v;                 // Value-integer on class-level, uninitialized
m->{                   // Method with integer-matrix parameter & boolean return
int l=m[0].length,   //  The amount of columns in the matrix
t=m.length*l,    //  The total amount of cells in the matrix
i,               //  Index-integer, starting uninitialized
F=               //  Flag-integer, whether we can still move anything
v=1;           //  Set it and the class-level value both to 1
f,               //  Flag-integer, whether the current region can move
x,a,b;           //  Temp-integers to save bytes, uninitialized
for(M=m;             //  Set the class-level M to the input-matrix
v++<t;)          //  Loop v in the range (1,t):
for(i=t;i-->0;)    //   Inner loop over the cells:
i=m[i/l][i%l]==1?//    If the current cell contains a 1:
f(i/l,i%l,v)  //     Flood-fill the region with the current v
-1            //     And break out of the inner loop
:              //    Else:
i;            //     Simply continue the loop
//  (now every region has its own positive integer)
for(;F>0;)           //  Loop as long as F is still 1:
for(F=v=0;         //   Reset F to 0
v++<t          //   Inner loop v in the range (0,t):
;              //     After every iteration:
F=f>0?        //      If f is 1:
1          //       Set F to 1 as well
:           //      Else:
F){        //       Leave F the same
for(f=-1,        //    Reset f to -1
i=t;i-->0;)  //    Inner loop over the cells:
f&=m[a=i/l][b=i%l]==v
//     If the current cell contains value v,
&b>0?       //     and this is NOT the first column:
(x=m[a][b-1])<1
//      If the cell at the left contains a 0
|x==v      //      Or the cell at the left contains value v,
&b>1?     //      and this is also not the second column:
1         //       Bitwise-AND f with 1
:          //      Else:
0         //       Bitwise-AND f with 0 instead
//      (if the check is truthy: -1→1; 0→0; 1→1;
//       if the check is falsey: -1→0; 0→0; 1→0)
:           //     Else:
f;         //      Bitwise-AND f with itself to stay f
for(;f>0&        //    If f is now 1, which means we can move the region
//    with value v:
++i<t;)      //     Do another inner loop over the cells:
m[a=i/l][b=i%l]-=
//      Decrease the value in the current cell by:
m[a][b]==v   //       If the current cell contains value v,
&b>0?        //       and this is NOT the first column:
m[a][b-1]=v //        Set the cell at the left to v
//        Set the current cell to 0 by decreasing by v
:            //       Else:
0;          //        Decrease by 0 to stay the same
//  After everything has been moved,
for(;t-->0;)         //  loop one last time over the cells:
m[t/l][t%l]=       //   Change the value in the current cell to:
//    Transform all positive values to 1,
//    while keeping any 0s the same:
1/~m[t/l][t%l]+1;//     (1 integer-divided by (-value-1)) + 1

// Recursive method with coordinate as parameters & integer return-type
int f(int x,int y){
try{if(M[x][y]==1){  //  If the current cell contains a 1:
M[x][y]=v;         //   Fill the cell with the current value
f(m,x,y-1)      //   Recursive call west
f(m,x-...,y)     //   Recursive call north
f(m,x,y+...)      //   Recursive call east
f(m,x+...,y);}     //   Recursive call south
}finally{            //  Catch and swallow any ArrayIndexOutOfBoundsExceptions
//  (shorter than manual if-checks)
return 1;}  //  Always return 1, so we use it to our advantage to
//  save bytes


# Rust, 558 334 bytes

|p:&mut Vec<Vec<_>>|{fn k(x:usize,y:usize,p:&mut Vec<Vec<u8>>){if p[y][x]==1{p[y][x]+=2;if x>0{k(x-1,y,p)}if x<p[0].len()-1{k(x+1,y,p)}if y>0{k(x,y-1,p)}if y<p.len()-1{k(x,y+1,p)}}}loop{let q=p.clone();for j in 0..p.len(){k(0,j,p)}for i in 0..p[0].len(){for j in 0..p.len(){if p[j][i]==1{p[j].swap(i,i-1)}p[j][i]&=1}}if p==&q{break}}}


Try it online!

• -224 bytes (wow!) by changing the algorithm (Thanks @alephalpha)

# Pari/GP, 157 bytes

m->while(a=0*m;a[,1]=m[,1];while(a!=b=matrix(#a~,#a,i,j,m[i,j]&&matrix(#a~,#a,k,l,abs(i-k)+abs(j-l)<2&&a[k,l])),a=b);m!=n=a+concat((m-a)[,^1],0*m[,1]),m=n);m


Try it online!