Day 19 - Linen Layout

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)
  • You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL

FAQ

  • @VegOwOtenks
    link
    English
    23 hours ago

    Haskell

    I had several strategy switches from brute-force to pathfinding (when doing part1 input instead of example) because It simply wouldn’t finish. My solution only found the first path to the design, which is why I rewrote to only count how many towels there are for each prefix I have already built. Do that until there is either only one entry with the total combinations count or no entry and it’s impossible to build the design.

    I like the final solution, its small (unlike my other solutions) and runs fast.

    🚀
    import Control.Arrow
    
    import Data.Map (Map)
    
    import qualified Data.List as List
    import qualified Data.Map as Map
    
    parse :: String -> ([String], [String])
    parse = lines . init
            >>> (map (takeWhile (/= ',')) . words . head &&& drop 2)
    
    countDesignPaths :: [String] -> String -> Map Int Int -> Int
    countDesignPaths ts d es
            | Map.null es    = 0
            | ml == length d = mc
            | otherwise = countDesignPaths ts d es''
            where
                    ((ml, mc), es') = Map.deleteFindMin es
                    ns = List.filter (flip List.isPrefixOf (List.drop ml d))
                            >>> List.map length
                            >>> List.map (ml +)
                            $ ts
                    es'' = List.foldl (\ m l' -> Map.insertWith (+) l' mc m) es'
                            $ ns
    solve (ts, ds) = List.map (flip (countDesignPaths ts) (Map.singleton 0 1))
            >>> (List.length . List.filter (/= 0) &&& List.sum)
            $ ds
    
    main = getContents
            >>= print
            . solve
            . parse