Day 14: Parabolic Reflector Dish

Megathread guidelines

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • Code block support is not fully rolled out yet but likely will be in the middle of the event. Try to share solutions as both code blocks and using something such as https://topaz.github.io/paste/ , pastebin, or github (code blocks to future proof it for when 0.19 comes out and since code blocks currently function in some apps and some instances as well if they are running a 0.19 beta)

FAQ


🔒 Thread is locked until there’s at least 100 2 star entries on the global leaderboard

Edit: 🔓 Unlocked

  • @LeixB
    link
    41 year ago

    Haskell

    Managed to do part1 in one line using ByteString operations:

    import Control.Monad
    import qualified Data.ByteString.Char8 as BS
    
    part1 :: IO Int
    part1 =
      sum
        . ( BS.transpose . BS.split '\n'
              >=> fmap succ
              . BS.elemIndices 'O' . BS.reverse . BS.intercalate "#"
              . fmap (BS.reverse . BS.sort) . BS.split '#'
          )
        <$> BS.readFile "inp"
    

    Part 2

    {-# LANGUAGE NumericUnderscores #-}
    
    import qualified Data.ByteString.Char8 as BS
    import qualified Data.Map as M
    import Relude
    
    type Problem = [ByteString]
    
    -- We apply rotation so that north is to the right, this makes
    -- all computations easier since we can just sort the rows.
    parse :: ByteString -> Problem
    parse = rotate . BS.split '\n'
    
    count :: Problem -> [[Int]]
    count = fmap (fmap succ . BS.elemIndices 'O')
    
    rotate, move, rotMov, doCycle :: Problem -> Problem
    rotate = fmap BS.reverse . BS.transpose
    move = fmap (BS.intercalate "#" . fmap BS.sort . BS.split '#')
    rotMov = rotate . move
    doCycle = rotMov . rotMov . rotMov . rotMov
    
    doNcycles :: Int -> Problem -> Problem
    doNcycles n = foldl' (.) id (replicate n doCycle)
    
    findCycle :: Problem -> (Int, Int)
    findCycle = go 0 M.empty
      where
        go :: Int -> M.Map Problem Int -> Problem -> (Int, Int)
        go n m p =
          let p' = doCycle p
           in case M.lookup p' m of
                Just n' -> (n', n + 1)
                Nothing -> go (n + 1) (M.insert p' n m) p'
    
    part1, part2 :: ByteString -> Int
    part1 = sum . join . count . move . parse
    part2 input =
      let n = 1_000_000_000
          p = parse input
          (s, r) = findCycle p
          numRots = s + ((n - s) `mod` (r - s - 1))
       in sum . join . count $ doNcycles numRots p