Advent of Code 2021 day 7

    Day 7 is an optimisation problem. We're given a loss function (here the fuel cost)  and asked to find the optimal solution that minimises the loss. There are many ways to solve these problems.

    • One approach is brute force: the optimal solution has to lie in the space spanned by the submarines, and that's only about 2000 spaces, so I could just try all of them and find the lowest.
    • Some optimisation problems have neat closed-form solutions where you just plug the values into some equation and it spits out the answer. Those generally have mathematically "neat" functions, and the use of absolute values here means a closed-form is unlikely here.
    • Gradient descent is a common way to solve optimisation problems. It relies on the fact that the loss function is "smooth", so the loss decreases near the optimal solution and increases as you move away from it.

    That's what I did.

    The loss function I'm minimising is the fuel cost. I assume, without proof, that the loss is strictly monotone: every step I take away from the optimal solution causes the loss to increase. It will never stay the same, it will never decrease as I move away.

    That leads to a simple gradient descent function. I guess a possible solution. I calculate the loss at that place, and the loss at one position each side. If the loss here is the lowest, I've found the optimal solution. If not, I update the guess by one, depending on which side has the lowest loss.

    gradientDescend :: ([Int] -> Int -> Int) -> [Int] -> Int -> Int
    gradientDescend loss subs guess = 
      if | lossLower  < lossHere -> gradientDescend loss subs (guess - 1)
         | lossHigher < lossHere -> gradientDescend loss subs (guess + 1)
         | otherwise -> guess
      where lossHere   = loss subs guess
            lossLower  = loss subs (guess - 1)
            lossHigher = loss subs (guess + 1)

    Note that the loss function to use is an argument of gradientDescend. The only difference between parts 1 and 2 is the definition of the loss function, so I define those two, ready to be passed into gradientDescend.

    loss1 :: [Int] -> Int -> Int
    loss1 subs target = sum $ map diff subs
      where diff s = abs (target - s)
    loss2 :: [Int] -> Int -> Int
    loss2 subs target = sum $ map triangleDiff subs
      where diff s = abs (target - s)
            triangleDiff s = ((diff s) * ((diff s) + 1)) `div` 2

    Finally, read the input, make a vaguely-sensible guess of where to start, and kick off the gradient descent with the correct loss function.

    main :: IO ()
    main = 
      do  text <- readFile "data/advent07.txt"
          let subs = map (read @Int) $ splitOn "," text
          print $ part1 subs
          print $ part2 subs
    part1 = bestFuel loss1
    part2 = bestFuel loss2
    bestFuel :: ([Int] -> Int -> Int) -> [Int] -> Int
    bestFuel loss subs = loss subs best
      where meanSub = (sum subs) `div` (length subs)
            best = gradientDescend loss subs meanSub


    You can get the code from my locally-hosed Git repo, or from Gitlab.

    Neil Smith

    Read more posts by this author.