Advent of Array Elegance (AoC2023 Day 7)

Kap uses some namespaces, which makes reading in a bit nicer, and the output is boxed, with explicit quotes for strings

p ← io:read "p07.txt"

┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
┃"32T3K 765" "T55J5 684" "KK677 28" "KTJJT 220" "QQQJA 483"┃
┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

readLines reads in each line as an element of a vector

p <- readLines("example07.txt")
p

## [1] "32T3K 765" "T55J5 684" "KK677 28"  "KTJJT 220" "QQQJA 483"

Rather than the partition idiom, Kap has regex support, so splitting the components involes regex:split for each (¨) element of input

p←⊃{" " regex:split ⍵}¨p

┌→────────────┐
↓"32T3K" "765"│
│"T55J5" "684"│
│"KK677"  "28"│
│"KTJJT" "220"│
│"QQQJA" "483"│
└─────────────┘

The boilerplate of R’s matrix construction takes a toll after using APL/Kap…

p <- matrix(unlist(strsplit(p, " ")), ncol = 2, byrow = TRUE)
p

##      [,1]    [,2] 
## [1,] "32T3K" "765"
## [2,] "T55J5" "684"
## [3,] "KK677" "28" 
## [4,] "KTJJT" "220"
## [5,] "QQQJA" "483"

Kap uses exactly the same approach as APL for this

hands←⊣/p
bids←⍎¨⊢/p

R’s ‘subset by index’ works just fine, but if this was generalised I’d use something like p[, ncol(p)] to get to the last column

hands <- p[,1]
hands

## [1] "32T3K" "T55J5" "KK677" "KTJJT" "QQQJA"

bids <- as.integer(p[,2])
bids

## [1] 765 684  28 220 483

Kap doesn’t have the equivalent Key, but after some discussion with the creator, it’s entirely possible to get something that does the same

  key⇐(⍪+⌿≡⌻)∘∪ ⍝ using outer product - see the R solution
  key2⇐{u←∪⍵ ⋄ c←⍸˝∧u⍳⍵} ⍝ using inverse 'where' and 'index of'

  key2¨hands

┌→────────────────────────────────────────┐
│┌→──────┐ ┌→────┐ ┌→────┐ ┌→────┐ ┌→────┐│
││2 1 1 1│ │1 3 1│ │2 1 2│ │1 2 2│ │3 1 1││
│└───────┘ └─────┘ └─────┘ └─────┘ └─────┘│
└─────────────────────────────────────────┘

The rest is the same as APL, except Kap uses a dedicated sort (∨)

    handrank⇐{10⊥2↑∨⊢/key ⍵}
    handrank¨hands

┏━━━━━━━━━━━━━━┓
┃21 31 22 22 31┃
┗━━━━━━━━━━━━━━┛

I wanted to recreate the above approach in R, so this will take the long way ’round.

First, we need a ‘key’ function

key <- function(x) {
  l <- strsplit(x, "")[[1]]
  setNames(colSums(outer(l, unique(l), "==")), unique(l))
}

sapply(hands, key)

## $`32T3K`
## 3 2 T K 
## 2 1 1 1 
## 
## $T55J5
## T 5 J 
## 1 3 1 
## 
## $KK677
## K 6 7 
## 2 1 2 
## 
## $KTJJT
## K T J 
## 1 2 2 
## 
## $QQQJA
## Q J A 
## 3 1 1

The idea of this is to create an outer product between the set of unique letters in the string, and the individual letters, performing an == check on each combination

y <- strsplit(hands[2], "")[[1]]
outer(y, unique(y), "==")

##       [,1]  [,2]  [,3]
## [1,]  TRUE FALSE FALSE
## [2,] FALSE  TRUE FALSE
## [3,] FALSE  TRUE FALSE
## [4,] FALSE FALSE  TRUE
## [5,] FALSE  TRUE FALSE

This is, of course, unnecessary as R has a way to do this

table(y)

## y
## 5 J T 
## 3 1 1

but I wanted to see how to do it from scratch.

Applying this over the hands, we can sort each of the counts again, but now taking the first two values fails for the five-of-a-kind which only has a 5, so in that case I add the missing 0. Decoding as base 10 can be done a couple of ways, but pasting and converting seems to work fine.

handrank <- function(x) {
  rank <- sort(sapply(x, key), decreasing = TRUE)
  if (length(rank) == 1) rank <- c(rank, 0)
  as.integer(paste(rank[1:2], collapse = ""))
}

sapply(hands, handrank)

## 32T3K T55J5 KK677 KTJJT QQQJA 
##    21    31    22    22    31

This is mostly the same solution as APL, except I couldn’t find the ‘numbers as string’ so i just typed it out. Kap also uses ‘disclose’ (⊃) in place of mix (↑) (ref (kapdemo.dhsdevelopments.com)).

    ranks←"23456789TJQKA"
    +/ranks{bids×1+⍋⍋⍵,⍺⍳⊃hands}handrank¨hands

6440

R doesn’t support Total Array Ordering, but it does seem to have a way to do it, so say the documentation examples for order

## or along 1st column, ties along 2nd, ... *arbitrary* no.{columns}:
dd[ do.call(order, dd), ]

That only works for a data.frame, which is a list (per do.call’s requirement). We can still work with that. First, smoosh together all the hands and convert the individual cards to a matrix - again, a long line of commands for what is reasonably straightforward in APL… 3 3⍴'abcdefghi' reshapes those 9 letters into a 3x3 matrix.

m <- matrix(strsplit(paste0(hands, collapse = ""), "")[[1]], ncol = 5, byrow = TRUE)
m

##      [,1] [,2] [,3] [,4] [,5]
## [1,] "3"  "2"  "T"  "3"  "K" 
## [2,] "T"  "5"  "5"  "J"  "5" 
## [3,] "K"  "K"  "6"  "7"  "7" 
## [4,] "K"  "T"  "J"  "J"  "T" 
## [5,] "Q"  "Q"  "Q"  "J"  "A"

The individual cards vector benefits from coercing the digits to characters

ranks <- c(2:9, "T", "J", "Q", "K", "A")

The index mapping does actually work nicely with match, except it returns a single vector, not a matrix, so we need to reshape yet again. Plus, this time, the matches went down columns not along rows, so we need to use byrow = FALSE

mm <- matrix(match(m, ranks), ncol = 5, byrow = FALSE)
mm

##      [,1] [,2] [,3] [,4] [,5]
## [1,]    2    1    9    2   12
## [2,]    9    4    4   10    4
## [3,]   12   12    5    6    6
## [4,]   12    9   10   10    9
## [5,]   11   11   11   10   13

Prepending with the type rankings does work nicely via cbind

g <- cbind(sapply(hands, handrank), mm)
g

##       [,1] [,2] [,3] [,4] [,5] [,6]
## 32T3K   21    2    1    9    2   12
## T55J5   31    9    4    4   10    4
## KK677   22   12   12    5    6    6
## KTJJT   22   12    9   10   10    9
## QQQJA   31   11   11   11   10   13

Then ordering with the do.call idiom

gdf <- as.data.frame(g)
gdf[do.call(order, gdf), ]

##       V1 V2 V3 V4 V5 V6
## 32T3K 21  2  1  9  2 12
## KTJJT 22 12  9 10 10  9
## KK677 22 12 12  5  6  6
## T55J5 31  9  4  4 10  4
## QQQJA 31 11 11 11 10 13

Putting this all together into a function

sortrank <- function(x, y) {
  m <- matrix(strsplit(paste0(y, collapse = ""), "")[[1]], ncol = 5, byrow = TRUE)
  mm <- matrix(match(m, x), ncol = 5, byrow = FALSE)
  g <- cbind(sapply(y, handrank), mm)
  do.call(order, as.data.frame(g))
}

sortrank(ranks, hands)

## [1] 1 4 3 2 5

This isn’t the double sorting that APL and Kap used, and that little difference is what held me up for all too long trying to figure out why my solution passed tests but gave the wrong answer. Annoyingly, this mistake doesn’t show up in the test case because the ranks only differ by a switched place. The true input was not so kind.

This result is the order in which we need to place the bids, so doing that, then multiplying by the position (since it’s sorted, this is just a vector from 1 to the number of elements) we get the answer

sum(bids[sortrank(ranks, hands)]*seq_along(bids))

## [1] 6440