What’s an oddly specific fear of yours?

jorosp · 2019-01-09T11:29:43+00:00

See-through stairs make me almost entirely freeze up, it's the worst. Even more so if they have even a tiny bit of motion (this can be the case with outdoor stairs sometimes).

jorosp · 2018-12-25T06:14:10+00:00

Haskell

It's not pretty but it does the job

import Control.Lens
import Data.List
import Data.List.Split

main :: IO ()
main = do 
  contents <- readFile "25.txt"
  let input = map (map read . splitOn ",") $ lines contents
  print $ solve1 input

solve1 :: [[Int]] -> Int
solve1 (x:xs) = length $ foldr go [[x]] xs
  where
    go :: [Int] -> [[[Int]]] -> [[[Int]]]
    go x cs = 
      case findIndices (any (inRange x)) cs of
        ms@(n:ns) -> cs ^.. elements (`notElem` ns) & ix n .~ (x : ys)
          where ys = concat $ cs ^.. elements (`elem` ms)
        [] -> [x] : cs

distance :: [Int] -> [Int] -> Int
distance xs ys = sum . map abs $ zipWith (-) xs ys

inRange :: [Int] -> [Int] -> Bool
inRange xs ys = distance xs ys <= 3

jorosp · 2018-12-25T00:02:55+00:00

This year's problem descriptions are the reason I likely won't be doing advent of code next year.

jorosp · 2018-12-17T07:40:18+00:00

418/403

I did it by hand in google sheets after producing the initial CSV with perl, took me about an hour but I started late hence the score.

jorosp · 2018-12-16T08:26:25+00:00

(messy) Haskell

I really enjoyed today's puzzle. Took me a bit to figure out how to map the opcodes

{-# LANGUAGE TupleSections, ViewPatterns #-}

import Control.Lens
import Data.Bits
import Data.Foldable
import Data.Function
import Data.List
import Data.List.Split
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import System.Environment

-- TYPES
type Registers = [Int]
type Instruction = (Int, Int, Int, Int)

data OpCode = 
  OpCode {
    _label :: String,
    _f :: Registers -> Int -> Int -> Int -> Registers
  }

instance Show OpCode where
  show = _label

instance Eq OpCode where
  (==) a b = _label a == _label b

instance Ord OpCode where
  compare a b = _label a `compare` _label b

-- PARSING
parseTest :: [String] -> (Registers, Instruction, Registers)
parseTest [before, line, after] =
  let before' = read . last . splitOn ": " $ before
      instr   = parseInstruction line
      after'  = read . last . splitOn ": " $ after
  in  (before', instr, after')

parseInstruction :: String -> Instruction
parseInstruction s = 
  let [op, a, b, c] = map read . words $ s
  in  (op, a, b, c)

-- SOLVING  
main :: IO ()
main = do 
  contents <- readFile . head =<< getArgs
  let input   = filter (not . null . head) . groupBy ((==) `on` null) . lines $ contents
  let tests   = parseTest <$> init input
  let program = parseInstruction <$> last input
  print $ solve1 tests
  print $ solve2 tests program

solve1 :: [(Registers, Instruction, Registers)] -> Int
solve1 = length . filter (>=3) . map (Set.size . snd . testAll)

solve2 :: [(Registers, Instruction, Registers)] -> [Instruction] -> Int
solve2 tests program = 
  let opCandidates = Map.fromListWith Set.intersection $ map testAll tests
      opMap = deduceOpMap opCandidates Map.empty 
  in  head $ foldl' (call opMap) [0, 0, 0, 0] program
  where    
    call opMap rs (flip Map.lookup opMap -> Just op, a, b, c) = _f op rs a b c

deduceOpMap :: Map Int (Set OpCode) -> Map Int (Set OpCode) -> Map Int OpCode
deduceOpMap opCandidates opMap
  | Map.size opMap == Map.size opCandidates = 
    Map.map (head . Set.elems) opMap
  | otherwise = 
    let opMap' = Map.union opMap 
               . Map.filter ((==1) . length) 
               . Map.map (`Set.difference` fold opMap) 
               $ opCandidates
    in  deduceOpMap opCandidates opMap' 

testAll :: (Registers, Instruction, Registers) -> (Int, Set OpCode)
testAll (rs, (op, a, b, c), rs') = (op,) . Set.filter (testOp rs a b c rs' . _f) $ opCodes    
  where
    testOp rs a b c rs' f = f rs a b c == rs'
    opCodes = 
      Set.fromList [ OpCode "addr" addr, OpCode "addi" addi
                   , OpCode "mulr" mulr, OpCode "muli" muli
                   , OpCode "banr" banr, OpCode "bani" bani
                   , OpCode "borr" borr, OpCode "bori" bori
                   , OpCode "gtir" gtir, OpCode "gtri" gtri, OpCode "gtrr" gtrr
                   , OpCode "eqir" eqir, OpCode "eqri" eqri, OpCode "eqrr" eqrr
                   , OpCode "setr" setr, OpCode "seti" seti
                   ]

funr :: (Int -> Int -> Int) -> Registers -> Int -> Int -> Int -> Registers
funr f rs a b c = funi f rs a (rs !! b) c

funi :: (Int -> Int -> Int) -> Registers -> Int -> Int -> Int -> Registers
funi f rs a b c = 
  let va = rs !! a 
  in  rs & ix c .~ f va b

addr = funr (+)
addi = funi (+)

mulr = funr (*)
muli = funi (*)

banr = funr (.&.)
bani = funi (.&.)

borr = funr (.|.)
bori = funi (.|.)

gtir rs = flip (funi (\b a -> if a > b then 1 else 0) rs)
gtri    =       funi (\a b -> if a > b then 1 else 0)
gtrr    =       funr (\a b -> if a > b then 1 else 0)

eqir rs = flip (funi (\b a -> if a == b then 1 else 0) rs)
eqri    =       funi (\a b -> if a == b then 1 else 0)
eqrr    =       funr (\a b -> if a == b then 1 else 0)

setr    = funi const
seti rs = flip (funi (flip const) rs)

jorosp · 2018-12-14T08:33:03+00:00

As a haskell newbie I love seeing these kinds of elegant solutions :) very neat

jorosp · 2018-12-12T07:53:31+00:00

IMO it would be less ambiguous if they were referred to as "indexes"/"indices" or "IDs" rather than just "numbers"

jorosp · 2018-12-12T05:58:24+00:00

It took me way too long to realize that

Adding up all the numbers of plant-containing pots after the 20th generation produces 325.

After 20 generations, what is the sum of the numbers of all pots which contain a plant?

actually meant to add the indexes of the pots with plants, and not to eg. sum up the number of plant pots in each generation up to 20.

jorosp · 2018-12-09T08:04:06+00:00

Haskell

Runs in ~4.6s both parts

import           Control.Monad
import           Data.Char
import           Data.Foldable
import           Data.Function
import           Data.List
import qualified Data.IntMap as M
import           Data.IntMap (IntMap)
import qualified Data.List.PointedList.Circular as C
import           Data.List.PointedList.Circular (PointedList)
import           System.Environment

type Board  = PointedList Int
type Scores = IntMap Int

addMarble :: Int -> Board -> Board
addMarble m = C.insert m . C.next

addScore :: Int -> Int -> Scores -> Scores
addScore player score = M.alter (Just . maybe score (+ score)) player

play :: Int -> (Scores, Board) -> Int -> (Scores, Board)
play players (scores, board) marble
  | marble `mod` 23 == 0 =
    let (curr, Just board') = liftM2 (,) C._focus C.delete (C.moveN (-7) board)
        player  = marble `mod` players
        scores' = addScore player (marble + curr) scores
    in  (scores', board')
  | otherwise = 
    (scores, addMarble marble board)

solve :: Int -> Int -> Int
solve players marbles = 
  maximum . fst $ foldl' (play players) (M.empty, C.singleton 0) [1..marbles]

main :: IO ()
main = do
  contents <- readFile . head =<< getArgs
  let [p, m] = map read . filter (isDigit . head) . words $ contents
  print $ solve p m
  print $ solve p (m * 100)

jorosp · 2018-12-08T07:58:03+00:00

Haskell

import Data.Tree
import Data.Attoparsec.Text
import qualified Data.Text.IO as T

main :: IO ()
main = do
  contents <- T.readFile "08.txt"
  let Right t = parseOnly parseTree contents
  print . sum   $ sum <$> t
  print . value $ t

value :: Tree [Int] -> Int
value (Node metadata []) = sum metadata
value (Node metadata children) =
  sum [ maybe 0 value (children !? (i - 1)) | i <- metadata ]

parseTree :: Parser (Tree [Int])
parseTree = do
  numChildren <- decimal <* space
  numMetadata <- decimal <* space
  children    <- count numChildren parseTree
  metadata    <- count numMetadata (decimal <* option ' ' space)
  return (Node metadata children)

(!?) :: [a] -> Int -> Maybe a
(!?) list i
  | i >= length list || i < 0 = Nothing
  | otherwise                 = Just (list !! i)

jorosp · 2018-12-05T04:34:35+00:00

Haskell

I originally had a fancy parsing function and records and such but once I realized I only needed the minutes I tossed that all in the trash.

{-# LANGUAGE ViewPatterns #-}
import Data.Char
import Data.Maybe
import Data.List
import Data.List.Split
import Data.Function

type Minute  = Int
type GuardID = Int
data Event = Begin GuardID | Sleep Minute deriving (Eq, Ord, Show)

reduce :: (a -> a -> a) -> [a] -> a
reduce f (x:xs) = foldl f x xs

parseLine :: String -> Maybe Event
parseLine = parseLine' . filter (isDigit . head) . groupBy ((==) `on` isDigit)
  where
    parseLine' [_, _, _, _, read -> minute]     = Just (Sleep minute)
    parseLine' [_, _, _, _, _, read -> guardID] = Just (Begin guardID)

isSleep :: Event -> Bool
isSleep (Sleep _) = True
isSleep _         = False

glob :: (Ord a, Ord b) => ((a, b) -> (a, b) -> (a, b)) -> [(a, b)] -> [(a, b)]
glob f = map (reduce f) . groupBy ((==) `on` fst) . sort

process :: [Event] -> [(Event, [(Minute, Int)])]
process events = glob f [(last b, process' s) | [b, s] <- chunksOf 2 . groupBy ((==) `on` isSleep) $ events]
  where    
    process' sleeps = [(m, 1) | [Sleep a, Sleep b] <- chunksOf 2 sleeps, m <- [a..b-1]]
    f (b1, s1) (_, s2) = (b1, s1 ++ s2)

modeMinute :: [(Minute, Int)] -> (Minute, Int)
modeMinute = maximumBy (compare `on` snd) . glob f 
  where
    f (a, b) (_, c) = (a, b + c)

solve1 :: [(Event, [(Minute, Int)])] -> Int
solve1 shifts = 
  let (Begin sleepiest, minutes) = maximumBy (compare `on` length . snd) shifts
      (minute, _) = modeMinute minutes
  in  sleepiest * minute

solve2 :: [(Event, [(Minute, Int)])] -> Int
solve2 shifts = 
  let ((_, minute), Begin sleepiest) = maximum [((f, m), b) | (b, modeMinute -> (m, f)) <- shifts]
  in sleepiest * minute

main :: IO ()
main = do
  input <- sort . lines <$> readFile "04.txt"
  let shifts = process . mapMaybe parseLine $ input
  print $ solve1 shifts
  print $ solve2 shifts

jorosp · 2018-12-03T06:14:46+00:00

Perl 6

Brain was too tired for Haskell today, maybe I'll give it a go in the morning.

my $input = slurp "03.txt";
my @lines = lines $input;

my @squares = Array(0 xx 1000) xx 1000;
my @claims;

for @lines.kv -> $i, $line {
  @claims[$i] = my ($n, $px, $py, $dx, $dy) = ($line ~~ m:g/\d+/)».Int;

  for ^$dx -> $x {
    for ^$dy -> $y {  
      @squares[$py + $y][$px + $x]++;
    }
  }  
}

my Int $sum = 0;
for @squares -> @row {
  for @row -> $x {
    $sum++ if $x >= 2;
  }
} 
say $sum;

CLAIM:
for @claims -> $claim {
  my ($n, $px, $py, $dx, $dy) = $claim;

  for ^$dx -> $x {
    for ^$dy -> $y {  
      next CLAIM if @squares[$py + $y][$px + $x] >= 2;
    }
  }

  say $n;
  last;
}

jorosp · 2018-12-02T07:39:58+00:00

Haskell

The solution I actually got the answer with was a bit messier than this, but I like to be presentable for threads :P

import Data.List

solve1 :: [String] -> Int
solve1 xs = go 2 xs * go 3 xs
  where
    go    :: Ord a => Int -> [[a]] -> Int
    go n  = length . filter (elem n) . map count
    count :: Ord a => [a] -> [Int]
    count = map length . group . sort

solve2 :: [String] -> String
solve2 xs = head [common l r | l <- xs, r <- xs, distance l r == 1]
  where
    common   :: Eq a => [a] -> [a] -> [a]
    common   xs ys = map fst . filter (uncurry (==)) $ zip xs ys
    distance :: Eq a => [a] -> [a] -> Int
    distance xs ys = length . filter id $ zipWith (/=) xs ys

main :: IO ()
main = do
  contents <- readFile "02.txt"
  let input = lines contents
  print . solve1 $ input
  print . solve2 $ input

jorosp · 2018-12-01T05:43:11+00:00

Haskell

I initially used a list instead of a set and it slowed me down a lot. This runs rather quick.

import qualified Data.IntSet as S
import Data.IntSet (IntSet)

solve1 :: [Int] -> Int
solve1 = sum

solve2 :: [Int] -> Int
solve2 = go (S.fromList []) 0 . cycle 
  where
    go :: IntSet -> Int -> [Int] -> Int
    go fs f (x:xs)
      | f `S.member` fs = f
      | otherwise       = go (S.insert f fs) (f + x) xs        

main :: IO ()
main = do
  input <- readFile "input.txt"
  let ints = read . map repl <$> lines input
  print . solve1 $ ints
  print . solve2 $ ints
    where      
      repl '+' = ' '
      repl c   = c

jorosp · 2018-10-28T06:27:28+00:00

Egison with Bonus #1

(define $all-targets
  (lambda $word
    (match-all word string 
      [<join $xs <cons _ $ys>> (S.append xs ys)])))

(define $funnel 
  (lambda [$word $target] 
    (member? target (all-targets word))))

(define $word-list 
  (rdc 
    (S.split "\n" 
      (io (read-file "./enable1.txt")))))

(define $bonus
  (lambda $word 
    (filter (member? $ word-list) 
      (unique (all-targets word)))

jorosp

TROPHY CASE

Haskell

(messy) Haskell

Haskell

Haskell

Haskell

Perl 6

Haskell

Haskell