[-] lwhjp@lemmy.sdf.org 3 points 2 months ago

Oh, that's fun! (And looks like an easy way to lose track of a few hours as well...)

[-] lwhjp@lemmy.sdf.org 3 points 7 months ago

In case anybody hasn't seen it, the relevant Oglaf (NSFW)

[-] lwhjp@lemmy.sdf.org 45 points 7 months ago

Most people would use "word", "half-word", "quarter-word" etc, but the Anglophiles insist on "tuppit", "ternary piece", "span" and "chunk" (that's 5 bits, or 12 old bits).

[-] lwhjp@lemmy.sdf.org 9 points 10 months ago

Maybe it was due to attempting the puzzles in real-time for the first time, but it felt like there was quite a spike in difficulty this year. Day 5 (If You Give A Seed A Fertilizer) in particular was pretty tough for an early puzzle.

Day 8 (Haunted Wasteland), Day 20 (Pulse Propagation) and Day 21 (Step Counter) were (I felt) a bit mean due to hidden properties of the input data.

I particularly liked Day 6 (Wait For It), Day 14 (Parabolic Reflector Dish) and Day 24 (Never Tell Me The Odds), although that one made my brain hurt.

Day 25 (Snowverload) had me reading research papers, although in the end I stumbled across Karger's algorithm. That's the first time I've used a probabilistic approach. This solution in particular was very clever.

I learned the Shoelace formula and Pick's theorem this year, which will be very helpful to remember.

Perhaps I'll try using Prolog or J next year :)

[-] lwhjp@lemmy.sdf.org 4 points 11 months ago* (last edited 11 months ago)

Haskell

Took a while to figure out what part 2 was all about. Didn't have the energy to golf this one further today, so looking forward to seeing the other solutions!

Solution0.3 line-seconds

import Data.Char
import Data.List
import Data.List.Split
import qualified Data.Vector as V

hash :: String -> Int
hash = foldl' (\a c -> ((a + ord c) * 17) `rem` 256) 0

hashmap :: [String] -> Int
hashmap = focus . V.toList . foldl' step (V.replicate 256 [])
  where
    focus = sum . zipWith focusBox [1 ..]
    focusBox i = sum . zipWith (\j (_, z) -> i * j * z) [1 ..] . reverse
    step boxes s =
      let (label, op) = span isLetter s
          i = hash label
       in case op of
            ['-'] -> V.accum (flip filter) boxes [(i, (/= label) . fst)]
            ('=' : z) -> V.accum replace boxes [(i, (label, read z))]
    replace ls (n, z) =
      case findIndex ((== n) . fst) ls of
        Just j ->
          let (a, _ : b) = splitAt j ls
           in a ++ (n, z) : b
        Nothing -> (n, z) : ls

main = do
  input <- splitOn "," . head . lines <$> readFile "input15"
  print $ sum . map hash $ input
  print $ hashmap input

[-] lwhjp@lemmy.sdf.org 5 points 11 months ago

Haskell

A little slow (1.106s on my machine), but list operations made this really easy to write. I expect somebody more familiar with Haskell than me will be able to come up with a more elegant solution.

Nevertheless, 59th on the global leaderboard today! Woo!

Solution

import Data.List
import qualified Data.Map.Strict as Map
import Data.Semigroup

rotateL, rotateR, tiltW :: Endo [[Char]]
rotateL = Endo $ reverse . transpose
rotateR = Endo $ map reverse . transpose
tiltW = Endo $ map tiltRow
  where
    tiltRow xs =
      let (a, b) = break (== '#') xs
          (os, ds) = partition (== 'O') a
          rest = case b of
            ('#' : b') -> '#' : tiltRow b'
            [] -> []
       in os ++ ds ++ rest

load rows = sum $ map rowLoad rows
  where
    rowLoad = sum . map (length rows -) . elemIndices 'O'

lookupCycle xs i =
  let (o, p) = findCycle 0 Map.empty xs
   in xs !! if i < o then i else (i - o) `rem` p + o
  where
    findCycle i seen (x : xs) =
      case seen Map.!? x of
        Just j -> (j, i - j)
        Nothing -> findCycle (i + 1) (Map.insert x i seen) xs

main = do
  input <- lines <$> readFile "input14"
  print . load . appEndo (tiltW <> rotateL) $ input
  print $
    load $
      lookupCycle
        (iterate (appEndo $ stimes 4 (rotateR <> tiltW)) $ appEndo rotateL input)
        1000000000

42.028 line-seconds

[-] lwhjp@lemmy.sdf.org 6 points 11 months ago

Haskell

This was fun and (fairly) easy! Off-by-one errors are a likely source of bugs here.

import Control.Monad
import Data.List
import Data.List.Split
import Data.Maybe

score d pat = ((100 *) <$> search pat) `mplus` search (transpose pat)
  where
    search pat' = find ((d ==) . rdiff pat') [1 .. length pat' - 1]
    rdiff pat' i =
      let (a, b) = splitAt i pat'
       in length $ filter (uncurry (/=)) $ zip (concat $ reverse a) (concat b)

main = do
  input <- splitOn [""] . lines <$> readFile "input13"
  let go d = print . sum . map (fromJust . score d) $ input
  go 0
  go 1

Line-seconds score: 0.102 πŸ˜‰

5

We all know and love (!) the leaderboard, but how about a different method?

One can solve a problem with a simple, naive method resulting in a short program and long runtime, or put in lots of explicit optimizations for more code and shorter runtime. (Or if you're really good, a short, fast program!)

I propose the line-second.

Take the number of lines in your program (eg, 42 lines) and the runtime (eg 0.096 seconds). Multiply these together to get a score of 4.032 line-seconds.

A smaller score is a shorter, faster program.

Similarly, (for a particular solver), a larger score is a "harder" problem.

[-] lwhjp@lemmy.sdf.org 4 points 11 months ago

Haskell

Phew! I struggled with this one. A lot of the code here is from my original approach, which cuts down the search space to plausible positions for each group. Unfortunately, that was still way too slow...

It took an embarrassingly long time to try memoizing the search (which made precomputing valid points far less important). Anyway, here it is!

Solution

{-# LANGUAGE LambdaCase #-}

import Control.Monad
import Control.Monad.State
import Data.List
import Data.List.Split
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe

readInput :: String -> ([Maybe Bool], [Int])
readInput s =
  let [a, b] = words s
   in ( map (\case '#' -> Just True; '.' -> Just False; '?' -> Nothing) a,
        map read $ splitOn "," b
      )

arrangements :: ([Maybe Bool], [Int]) -> Int
arrangements (pat, gs) = evalState (searchMemo 0 groups) Map.empty
  where
    len = length pat
    groups = zipWith startPoints gs $ zip minStarts maxStarts
      where
        minStarts = scanl (\a g -> a + g + 1) 0 $ init gs
        maxStarts = map (len -) $ scanr1 (\g a -> a + g + 1) gs
        startPoints g (a, b) =
          let ps = do
                (i, pat') <- zip [a .. b] $ tails $ drop a pat
                guard $
                  all (\(p, x) -> maybe True (== x) p) $
                    zip pat' $
                      replicate g True ++ [False]
                return i
           in (g, ps)
    clearableFrom i =
      fmap snd $
        listToMaybe $
          takeWhile ((<= i) . fst) $
            dropWhile ((< i) . snd) clearableRegions
      where
        clearableRegions =
          let go i [] = []
              go i pat =
                let (a, a') = span (/= Just True) pat
                    (b, c) = span (== Just True) a'
                 in (i, i + length a - 1) : go (i + length a + length b) c
           in go 0 pat
    searchMemo :: Int -> [(Int, [Int])] -> State (Map (Int, Int) Int) Int
    searchMemo i gs = do
      let k = (i, length gs)
      cached <- gets (Map.!? k)
      case cached of
        Just x -> return x
        Nothing -> do
          x <- search i gs
          modify (Map.insert k x)
          return x
    search i gs | i >= len = return $ if null gs then 1 else 0
    search i [] = return $
      case clearableFrom i of
        Just b | b == len - 1 -> 1
        _ -> 0
    search i ((g, ps) : gs) = do
      let maxP = maybe i (1 +) $ clearableFrom i
          ps' = takeWhile (<= maxP) $ dropWhile (< i) ps
      sum <$> mapM (\p -> let i' = p + g + 1 in searchMemo i' gs) ps'

expand (pat, gs) =
  (intercalate [Nothing] $ replicate 5 pat, concat $ replicate 5 gs)

main = do
  input <- map readInput . lines <$> readFile "input12"
  print $ sum $ map arrangements input
  print $ sum $ map (arrangements . expand) input

[-] lwhjp@lemmy.sdf.org 4 points 11 months ago* (last edited 11 months ago)

Haskell

This problem has a nice closed form solution, but brute force also works.

(My keyboard broke during part two. Yet another day off the bottom of the leaderboard...)

import Control.Monad
import Data.Bifunctor
import Data.List

readInput :: String -> [(Int, Int)]
readInput = map (\[t, d] -> (read t, read d)) . tail . transpose . map words . lines

-- Quadratic formula
wins :: (Int, Int) -> Int
wins (t, d) =
  let c = fromIntegral t / 2 :: Double
      h = sqrt (fromIntegral $ t * t - 4 * d) / 2
   in ceiling (c + h) - floor (c - h) - 1

main = do
  input <- readInput <$> readFile "input06"
  print $ product . map wins $ input
  print $ wins . join bimap (read . concatMap show) . unzip $ input
[-] lwhjp@lemmy.sdf.org 4 points 11 months ago

Haskell

Not hugely proud of this one; part one would have been easier if I'd spend more time reading the question and not started on an overly-general solution, and I lost a lot of time on part two to a missing a +. More haste, less speed, eh?

import Data.List
import Data.List.Split

readInput :: String -> ([Int], [(String, [(Int, Int, Int)])])
readInput s =
  let (seedsChunk : mapChunks) = splitOn [""] $ lines s
      seeds = map read $ tail $ words $ head seedsChunk
      maps = map readMapChunk mapChunks
   in (seeds, maps)
  where
    readMapChunk (title : rows) =
      let name = head $ words title
          entries = map ((\[a, b, c] -> (a, b, c)) . map read . words) rows
       in (name, entries)

part1 (seeds, maps) =
  let f = foldl1' (flip (.)) $ map (ref . snd) maps
   in minimum $ map f seeds
  where
    ref [] x = x
    ref ((a, b, c) : rest) x =
      let i = x - b
       in if i >= 0 && i < c
            then a + i
            else ref rest x

mapRange :: [(Int, Int, Int)] -> (Int, Int) -> [(Int, Int)]
mapRange entries (start, end) =
  go start $ sortOn (\(_, b, _) -> b) entries
  where
    go i [] = [(i, end)]
    go i es@((a, b, c) : rest)
      | i > end = []
      | b > end = go i []
      | b + c <= i = go i rest
      | i < b = (i, b - 1) : go b es
      | otherwise =
          let d = min (b + c - 1) end
           in (a + i - b, a + d - b) : go (d + 1) rest

part2 (seeds, maps) =
  let seedRanges = map (\[a, b] -> (a, a + b - 1)) $ chunksOf 2 seeds
   in minimum $ map fst $ foldl' (flip mapRanges) seedRanges $ map snd maps
  where
    mapRanges m = concatMap (mapRange m)

main = do
  input <- readInput <$> readFile "input05"
  print $ part1 input
  print $ part2 input
[-] lwhjp@lemmy.sdf.org 4 points 11 months ago

Haskell

11:39 -- I spent most of the time reading the scoring rules and (as usual) writing a parser...

import Control.Monad
import Data.Bifunctor
import Data.List

readCard :: String -> ([Int], [Int])
readCard =
  join bimap (map read) . second tail . break (== "|") . words . tail . dropWhile (/= ':')

countShared = length . uncurry intersect

part1 = sum . map ((\n -> if n > 0 then 2 ^ (n - 1) else 0) . countShared)

part2 = sum . foldr ((\n a -> 1 + sum (take n a) : a) . countShared) []

main = do
  input <- map readCard . lines <$> readFile "input04"
  print $ part1 input
  print $ part2 input
[-] lwhjp@lemmy.sdf.org 74 points 1 year ago

TDD

const max12 = (x, y) => {
    if (x === 1 && y === 2) {
        return 2;
    } else if (x === 7 && y === 4) {
        return 7;
    } else {
        return x;
    }
};
1

Tried a little too hard to go with a theme on this one, and some of the clues are a bit contrived. Feel free to suggest alternatives!

1
Puzzle #5 (lwh.jp)

Here's an old puzzle of mine to get started. One of the clues (at least!) is a little unfair, but the puzzle has been solved by others so it should be possible. Comments much appreciated, and more to come...

view more: next β€Ί

lwhjp

joined 1 year ago
MODERATOR OF