≡ Day 6 of Advent of Code in q

show start: first raze (til count g),/:'where each "^"=0N!g: read0 `6.txt
("....#.....";".........#";"..........";"..#.......";".......#..";"............
6 4

We can now amend the grid to treat the starting space as an empty space, a dot.

g: .[g; start; :; "."]

dirs: (-1 0;0 1;1 0;0 -1)

The first step is to calculate the new position.

new: y + dirs x

Now, if the new position is a dot, we return it. If it is a hash, instead we rotate 90 degrees and stay where we are. Otherwise, we have a null value from indexing out of bounds. In this case, we want to return the original value. This will make it easy to detect when we have at the edge of the grid.

trav: {$["."=c: g . new:y + dirs x; (x;new); "#"=c; (mod[x+1;4];y); (x;y)]}.

Now, we use scan to traverse from the start, until we leave the grid.

steps: trav scan (0;start)

Now, we can calculate the number of visited positions. We save the positions in a variable path for later use.

count path: distinct last each steps
41

We can also visualise the visited positions.

g .[;;:;"X"]/ path
"....#....."
"....XXXXX#"
"....X...X."
"..#.X...X."
"..XXXXX#X."
"..X.X.X.X."
".#XXXXXXX."
".XXXXXXX#."
"#XXXXXXX.."
"......#X.."

Part 2:

The first observation is that we only need to consider adding an obstruction to a position that occurred in the path. This must be the case as adding one elsewhere wouldn't make any difference.

The second one is that now we don't care about the path length, only whether or not it loops. This means we can do something a bit better.

Let's write a function that jumps to the next # (or just before it), rather than traversing each step.

Firstly, we'll need to find the obstructions. We need lists of indices per rows and columns.

show obs: where each' 1 flip\ "#" = g
,4 ,9 `long$() ,2       ,7 `long$() ,1 ,8 ,0 ,6
,8 ,6 ,3       `long$() ,0 `long$() ,9 ,4 ,7 ,1

Now, if we are going up or left, (directions 0 or 3) we want to find the previous index, and then add 1. However, if we are going down or right, we want to find the next index, and then subtract 1.

We can construct these two parts like this.

{b: 0110b x; (`prev`next b; 1 -1[b])} 0 1 2 3
prev next next prev
1    -1   -1   1   

How do we find these? Finding the previous index can be done with bin, and the next one can be done with binr.

Actually, the next can be done with bin too, by adding 1 to the index. This returns an incorrect result if the value is contained in the list, but we know that can't happen (we will never be inside an obstruction).

The next step is to do the search. We pick which values we're looking at based on if we're going horizontally or vertically. This is equivalent to the direction mod 2. Let's test it with the start value, and heading up.

{b:0110b x;o:obs[1-c;y@1-c:x mod 2];y[c]:1 -1[b]+ o@b+o bin y c;((1+x)mod 4;y)}[0; start]
1
1 4

We can see (if running with sample input) that this returns the correct next position.

Now, we can save that as a function and use it to test for loops.

The last part is to have a way of inserting the value. There are different ways to do this, but the easiest is to make a new global version of obs, and edit the right lists.

ins: {W::obs; W[0;x]:asc W[0;x],y; W[1;y]:asc W[1;y],x}.

This function creates a new global called W, and inserts y into the relevant x list, and x into the relevant y list.

jump:{b:0110b x;o:W[1-c;y@1-c:x mod 2];y[c]:1 -1[b]+ o@b+o bin y c;((1+x)mod 4;y)}.

Now, to test for loops, we can use a trick. Rather than testing ourselves, we can let the interpreter do the work!

If we have a list with the unique attribute, and append something we've already seen, it will lose the attribute.

So testing if it is unique is equivalent to testing if it has the unique attribute.

The steps now are:

1. Insert element: ins x
2. Initialise our "set": S:`u#enlist s:(0;start)
3. While it is unique, jump to the next value: while[`u~attr S; S,:s:jump s]
4. Test if the last value (the repeated one) is a dot: "." = g . last s

Our jump function will return null if we have left the grid, so g . last s would be a space.

5. Sum the number of looping values for each possible insertion in the path: sum {...} each 1_path

The 1_ is so we don't insert the starting value.

sum {ins x; S:`u#enlist s:(0;start); while[`u~attr S;S,:s:jump s]; "." = g . last s} each 1_path

Recap:

g:read0 `:i/6.txt
start: first raze (til count g) {x ,/: where y}' "^"=g
g: .[g;start;:;"."]
dirs: (-1 0;0 1;1 0;0 -1)
trav: {$["."=c: g . new:y + dirs x; (x;new); "#"=c; (mod[x+1;4];y); (x;y)]}.
count path: distinct last each steps: trav scan (0;start) / part 1
/ -1@g .[;;:;"X"]/ path; / visualise
obs: where each' 1 flip\ g = "#"
ins: {W::obs; W[0;x]:asc W[0;x],y; W[1;y]:asc W[1;y],x}.
jump:{b:0110b x;o:W[1-c;y@1-c:x mod 2];y[c]:1 -1[b]+ o@b+o bin y c;((1+x)mod 4;y)}.
sum {ins x; S:`u#enlist s:(0;start); while[`u~attr S;S,:s:jump s]; "."=g . last s} each 1_path

Extra!

An obvious optimisation is not to start at the starting value each time, but start just before you reach that point in the path.

This simply requires replacing start with steps@-1+path?x

Other than that, optimisaiton is difficult. As a rule of thumb, any each should stick out as a potential slow point.

You get the most out of Q by using its built in vectorised operations. One possible way to "optimise" would be to rewrite the code so it wasn't reliant on globals, and replace each with peach. This doesn't really count though.

The true way to optimise this, is to try and find a way to process all possible insertions in parallel

However, this is hard, and the logic quickly gets confusing and difficult to follow. I'm not convinced the solution I ended up with is actually correct either, merely giving the right answer on my test data, which isn't quite the same.

That being said, here is my optimised solution, written in k. It runs under 100ms, which is comparable to solutions in compiled languages like Rust and C++. Not bad if I do say so myself.

s:*,/(!#g),/:'&:'"^"=g:0:`:i/6.txt;W:{-0W,(&x),0W}''1+:\"#"=g;d:3(|-1 1*)\-1 0
#u:? :/'({$[|/".^"=c:g/p:y+d x;(x;p);"#"=c;(1 2 3 0 x;y);(x;y)]}.)\(0;s)
X:{b:0110b x;v:w@'b+bin'[w:W[c;y c];L:y@~c:1010b x];x:1 2 3 0 x;
 (x;@[y;~c;:;?[within[Z;(1-b)|:/(L;v)];Z:?[(E=y)c;E@~c;0N];v]+1-2*b])}.
+/&/~^*|200 X/0,,(#*E:+1_u)#'s