To rococo

rot. Not one of my better titles, sorry. Here is another old Advent of Code problem that demonstrates how K's geometric manipulation facilities make it a great calculator—and how its data structures and control flow make it an incredibly frustrating general purpose language. Much like with the previous grouping example, this article also introduces a procedure I hope to get repeat use from: rotation.

The problem

Best to read it from the link, but here's the gist.

Scanning left to right, find the first, largest number n in an array.
Set the index of n to zero.
Starting from the index to the right of n, and wrapping around the array, distribute n to each index until it is depleted.
So if n were 3, the next 3 indices of the array each have 1 added to them.
Repeat this process against the redistributed array until an already-encountered arrangement is discovered.

The example infinite arrangement loop from the example looks like

Because "2 4 1 2" has already been seen, this sequence will loop indefinitely, and the rearrangements should cease.

Spinning around

This seems like a great use case for array rotation functions, but K doesn't have them by default. I had to roll my own. Since I was only worried about shifting in one direction, I could keep it simple. Rotating an array one index to the right is simply a matter of dropping one element from the tail, then appending it to the front.

 xs:0 2 7 0

 shiftr:{(last x),-1_x}

 shiftr xs

0 0 2 7

 shiftr shiftr xs

7 0 0 2

 shiftr shiftr shiftr xs

2 7 0 0

 shiftr shiftr shiftr shiftr xs

0 2 7 0

You get it. There's a clever way to shiftr n times: fold over a list of n zeros, but ignore them completely. The rots function below does this, but scans instead of folding so that the whole rotation history is returned. x and y are explicitly declared in the higher order function; this allows us to ignore y.

 rots:{{[x;y] shiftr x}\[x;y#0]}

 rots[xs;4]

0 0 2 7
7 0 0 2
2 7 0 0
0 2 7 0

This rotation matrix will guide the redistribution. A given cycle would play out as follows.

Find the max value m in the array.
Form a truth mask where only m's index is set to 1.
Create a rots matrix of m rows of the truth mask.
Sum the columns to determine how much of m is distributed to each index.

Finding the max is easy.

 m:max xs;m

7

The truth mask is a bit trickier, because we only want the first occurrence of the max.

 mi:(m=)@xs;mi

0 0 1 0 / <- Temporary mask. Could have more than one max.

 mf:*&mi;mf

2 / <- The index of the first max.

 mx:@[(#xs)#0;mf;1];mx

0 0 1 0 / <- The true mask. Here it's the same as `mi`.
        / <- Create a new array of zeroes and only set `mf`.

This truth mask mx is then rotated m (7) times, producing the distribution cycle.

Transposing this matrix and summing its rows shows how much of m will be distributed to each column.

 +rots[mx;m]

0 1 0 0 0 1 0
0 0 1 0 0 0 1
0 0 0 1 0 0 0
1 0 0 0 1 0 0

 spread:(+/)'+rots[mx;m];spread

2 2 1 2

The original array xs should have its max index mf set to zero, then be summed vectorwise against spread.

 @[xs;mf;0]

0 2 0 0

 spread+@[xs;mf;0]

2 4 1 2

One distribution cycle has taken place. The full function is available below.

redistribute:{m:max x;mi:(m=)@x;mf:*&mi;mx:@[(#x)#0;mf;1];spread:(+/)'+rots[mx;m];spread+@[x;mf;0]}

Keeping track

Here's where things get annoying, sorry. When keeping track of which redistribution schemes we've already encountered, a hash table seems like an obvious choice.

Create a hash table to store each permutation of the array, along with a specially-keyed slot for the previous distribution.
Loop with this table. In each iteration, pop off the most recent distribution and redistribute it.
If the redistribution already exists in the table, end the loop and return the table's size.
Otherwise, add the redistribution to the table, also setting it to the special previous slot, and loop again.

I could not find an elegant way to create this dictionary of previously-seen arrays, however.

Keying a table with literal arrays behaves funky. Try for yourself.
Strings are also just arrays of characters, so keying with strings representing already-encountered arrays is just as bad.
Symbols are limited to 8 characters, so the full problem set (16 integers) doesn't fit.

Maybe I'm missing something obvious? Using a 2D array would work fine, but searching for previous permutations would be needlessly slow. While a general array-hashing solution remains out of reach, this specific problem can actually be hashed perfectly into standard 64 bit integers. Was this by design? All 16 of the 16 numbers provided are between [0,15]: 4 bits each. And 4 × 16 = 64. Math does what K kan't.

If we want 16 four bit slots in which to hash the array indices, we should iterate 1…16, multiply it by four vectorwise, and then use each value n in that array as the exponent in 2ⁿ.

 pow:{*/y#x}

 4*!16

0 4 8 12 16 20 24 28 32 36 40 44 48 52 56 60

 slots:pow[2]'4*!16

 slots

1 16 256 4096 65536 1048576 16777216 268435456 4294967296 68719476736 1099511627776 17592186044416 281474976710656 4503599627370496 72057594037927936 1152921504606846976

Hashing an array xs means taking the first |xs| indices of slots, multiplying them against xs, and then summing the list of products. All values in xs should be incremented by 1 to remove any zeroes that will mess up the multiplication. This method is only free from collisions because nothing is bigger than 15 in the problem.

 hash:{+/((#x)#slots)*1+x}

 hash 0 2 7 0

6193

 hash 2 8 8 5 4 2 3 1 5 5 1 2 15 13 5 14

-652966531693188717

There is one hitch to this solution that makes things a bit hacky. Since the dictionary is keyed by integers, the special previous iteration index must be a number as well. This will be zero. Determining what a collision here might look like is an exercise left to the reader. Popping the previous distribution from the table is therefore a simple reference to its zero index.

pop:{x[0]}

Pushing an item to the table means hashing the new distribution, as well as rewriting its zero index.

push:{h:(hash x)!x;np:0!x;h,y,np}

The singleton function provides a starting table.

 singleton:{push[x;0!0N]}

 t:singleton 0 2 7 0;t

6193|0 2 7 0
   0|0 2 7 0

 push[redistribute(pop t);t]

12883|2 4 1 2
 6193|0 2 7 0
    0|2 4 1 2

The table will return the distribution if it exists, or a zero otherwise. We can get a boolean (0 or 1) value regarding a distribution's existence by performing a hash lookup, summing, and checking if greater than one.

 exists:{1<(+/)x[hash y]}

 exists[t;0 2 7 0]

1

 exists[t;1 1 1 1]

0

A full cycle of the loop is performed by determining if the redistribution's hash already exists in the table or not. If it does exist, the loop can be broken by returning an unchanged version of the dictionary. This is thanks to K's converge operation /: . Converging f(x) will apply f(f(f…f(x))) until its output no longer changes. This is a tad difficult to visualize sometimes, but it's nicer than recursing with an explicit base case (which actually blows the stack for this problem—I tried that first).

 cycle:{r:redistribute (pop x);$[exists[x;r];x;push[r;x]]}

 cycle/:(singleton 0 2 7 0)

 9538|1 3 4 1
21553|0 2 3 4
17188|3 1 2 3
12883|2 4 1 2
 6193|0 2 7 0
    0|1 3 4 1

 cycle/:(singleton 2 8 8 5 4 2 3 1 5 5 1 2 15 13 5 14)

7471772100274531549 |12 12 11 9 8 7 6 4 2 1 0 0 0 10 6 5
6245948503398849484 |11 11 10 8 7 6 5 3 1 0 0 0 13 9 5 4
5016413023987272379 |10 10 9 7 6 5 4 2 0 0 0 13 12 8 4 3
3786645551917201834 |9 9 8 6 5 4 3 1 0 0 13 12 11 7 3 2 
2556863580305975449 |8 8 7 5 4 3 2 1 0 13 12 11 10 6 2 1
1327080702473426824 |7 7 6 4 3 2 2 1 13 12 11 10 9 5 1 0
-2131984051322272137|6 6 5 3 2 1 1 0 12 11 10 9 8 5 1 13
-3361766985793653402|5 5 4 2 1 1 1 13 11 10 9 8 7 4 0 12
-3577958532905884587|4 4 3 1 0 0 0 12 10 9 8 7 7 4 13 11
-4807741470917192892|3 3 2 0 0 0 13 11 9 8 7 6 6 3 12 10
-6037524409149746637|2 2 1 0 0 13 12 10 8 7 6 5 5 2 11 9
-7267307347396128222|1 1 1 0 13 12 11 9 7 6 5 4 4 1 10 8
-8497090285643378142|1 1 1 12 12 11 10 8 6 5 4 3 3 0 9 7
8783220311764812049 |0 0 0 11 11 10 9 7 5 4 3 3 3 13 8 6
7553437373517512209 |0 0 13 10 10 9 8 6 4 3 2 2 2 12 7 5
7476575939877055969 |0 13 12 9 9 8 7 5 3 2 1 1 1 11 6 5 
7471772100274527454 |13 12 11 8 8 7 6 4 2 1 0 0 0 10 6 5
6245948503398845389 |12 11 10 7 7 6 5 3 1 0 0 0 13 9 5 4
5016413023987268284 |11 10 9 6 6 5 4 2 0 0 0 13 12 8 4 3
3786645551917197739 |10 9 8 5 5 4 3 1 0 0 13 12 11 7 3 2
2556863580305971354 |9 8 7 4 4 3 2 1 0 13 12 11 10 6 2 1
1327080702473422729 |8 7 6 3 3 2 2 1 13 12 11 10 9 5 1 0
-2131984051322276232|7 6 5 2 2 1 1 0 12 11 10 9 8 5 1 13
-3361766985793657497|6 5 4 1 1 1 1 13 11 10 9 8 7 4 0 12
-3577958532905888682|5 4 3 0 0 0 0 12 10 9 8 7 7 4 13 11
-4807741470933970107|4 3 2 0 0 0 12 11 9 8 7 6 6 3 12 10
-6037524409166523852|3 2 1 0 0 13 11 10 8 7 6 5 5 2 11 9
-7267307347412905437|2 1 1 0 13 12 10 9 7 6 5 4 4 1 10 8
-8497090285660151262|1 1 1 13 12 11 9 8 6 5 4 3 3 0 9 7 
8783220311748038929 |0 0 0 12 11 10 8 7 5 4 3 3 3 13 8 6
7553437373500739089 |0 0 13 11 10 9 7 6 4 3 2 2 2 12 7 5
7548633533898210769 |0 12 12 10 9 8 6 5 3 2 1 1 1 11 7 5
7543829694295682254 |13 11 11 9 8 7 5 4 2 1 0 0 0 10 7 5
..

This performs well. The answer to the problem is the size of the final table minus 1 (for the special zero index). So 5 and 3,156 respectively for the above problems. The algorithm history is also preserved in the table rows, which makes part 2 of the problem (exercise for you!) a breeze.

Thus concludes another document on the ecstasy and agony of array langs. I hope you can appreciate how beautiful the first half of the solution is compared to how garbage the second part is. And nope, I didn't come up with that table-based solution on my first go. I just appended 10,000 redistributions to a 2D array and enforced uniqueness on it. You gotta do what you gotta do.