I was scared of a hard combinatorial puzzle day, but this was a breeze.

{-# LANGUAGE TupleSections #-}
module Main (main) where
import Control.Monad ((<$!>))
import qualified Data.Text.IO as TextIO
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.IntSet as IntSet
import Control.Arrow ((>>>))
import qualified Data.List as List
import qualified Data.IntMap as IntMap

part1 :: [IntSet.Key] -> IntSet.Key
part1 = IntSet.fromList
  >>> IntSet.foldl (+) 0

part2 :: [IntSet.Key] -> IntSet.Key
part2 = IntSet.fromList
  >>> IntSet.toAscList
  >>> take 20
  >>> sum

part3 :: [IntMap.Key] -> Int
part3 = List.map (, 1)
  >>> IntMap.fromListWith (+)
  >>> IntMap.toList
  >>> List.map snd
  >>> maximum

main :: IO ()
main = do
  sizes <- map (read . Text.unpack) . Text.split (== ',') <$!> TextIO.getLine
  print $ part1 sizes
  print $ part2 sizes
  print $ part3 sizes

I struggled for a long time because I had nearly the correct results. I had to switch div with quot.

This puzzle was fun. If you have a visualization, it’s even cooler. (It’s a fractal)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall #-}
module Main (main) where
import Text.Read (ReadPrec, Read (readPrec))
import Data.Functor ((<&>))
import Data.Text (pattern (:<), Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as TextIO
import Control.Monad ((<$!>))
import Control.Arrow ((<<<))

newtype Complex = Complex (Int, Int)

instance Read Complex where
  readPrec :: ReadPrec Complex
  readPrec = readPrec <&> \case
    [a, b] -> Complex (a, b)
    _ -> undefined

instance Show Complex where
  show :: Complex -> String
  show (Complex (a, b))= show [a, b]

readAEquals :: Text -> Complex
readAEquals ('A' :< '=':< rest) = read $ Text.unpack rest
readAEquals _ = undefined


-- >>> Complex (1, 1) `add` Complex (2, 2)
-- [3,3]

add :: Complex -> Complex -> Complex
(Complex (x1, y1)) `add` (Complex (x2, y2)) = Complex (x1 + x2, y1 + y2)

-- >>> Complex (2, 5) `times` Complex (5, 7)
-- [-25,-11]

times :: Complex -> Complex -> Complex
(Complex (x1, y1)) `times` (Complex (x2, y2)) = Complex (x1 * x2 - y1 * y2, x1 * y2 + x2 * y1)

dividedBy :: Complex -> Complex -> Complex
(Complex (x1, y1)) `dividedBy` (Complex (x2, y2)) = Complex (x1 `quot` x2, y1 `quot` y2)

step :: Complex -> Complex -> Complex
step a r = let
 r1 = r `times` r
 r2 = r1 `dividedBy` Complex (10, 10)
 r3 = r2 `add` a
 in r3

zero :: Complex
zero = Complex (0, 0)

part1 :: Complex -> Complex
part1 a = iterate (step a) (Complex (0, 0)) !! 3

shouldBeEngraved :: Complex -> Bool
shouldBeEngraved complexPoint = let

  cycleStep :: Complex -> Complex -> Complex
  cycleStep point r = let
    r2 = r `times` r
    r3 = r2 `dividedBy` Complex (100000, 100000)
    in point `add` r3

  inRange x = x <= 1000000 && x >= -1000000


  in all (\ (Complex (x, y)) -> inRange x && inRange y)
    <<< take 101
    <<< iterate (cycleStep complexPoint)
    $ zero

-- >>> shouldBeEngraved $ Complex (35630,-64880)
-- True
-- >>> shouldBeEngraved $ Complex (35460, -64910)
-- False
-- >>> shouldBeEngraved $ Complex (35630, -64830)
-- False

part2 :: Complex -> Int
part2 (Complex (xA, yA)) = let

    xB = xA + 1000
    yB = yA + 1000

  in length . filter shouldBeEngraved $ do
    x <- [xA, xA+10.. xB]
    y <- [yA, yA+10.. yB]
    pure $ Complex (x, y)

part3 :: Complex -> Int
part3 (Complex (xA, yA)) = length . filter shouldBeEngraved $ do
  x <- [xA..xA+1000]
  y <- [yA..yA+1000]
  pure $ Complex (x, y)

-- >>> [0, 10..100]
-- [0,10,20,30,40,50,60,70,80,90,100]

main :: IO ()
main = do
  a <- readAEquals <$!> TextIO.getContents
  print $ part1 a
  print $ part2 a
  print $ part3 a

My girlfriend is learning python, we are taking on the challenges together, today I may upload her solution:

A=[-3344,68783]
R = [0, 0]
B= [A[0]+1000, A[1]+1000]
pointsengraved = 0
cycleright = 0


for i in range(A[1], B[1]+1):
    for j in range(A[0], B[0]+1):
        for k in range(100):
            R = [int(R[0] * R[0] - R[1] * R[1]), int(R[0] * R[1] + R[1] * R[0])]
            R = [int(R[0] / 100000), int(R[1] / 100000)]
            R = [int(R[0] + j), int(R[1] + i)]
            if -1000000>R[0] or R[0]>1000000 or -1000000>R[1] or R[1]>1000000:
                #print(".", end="")
                break
            cycleright += 1
        if cycleright == 100:
            pointsengraved += 1
            #print("+", end="")
        cycleright = 0
        R = [0, 0]
    #print()

print(pointsengraved)

The commented out print statements produce an ascii map of the set, which can be cool to view at the right font size.

I’m very curious about F# since I’ve never used it or seen it anywhere before but I’m afraid I’m too tired to read it right now. Thank you for posting, I hope I’ll remember to come back tomorrow.

I coded this along with my girlfriend who’s learning python, but not motivated to share her solution. The program reads from stdin, because I usually invoke it like so: runhaskell Main.hs < input or runhaskell Main.hs < example. I think this is quite handy because I don’t have to change the source code to check the example input again.

I struggled with Part 3, where I suddenly forgot I could’ve simply used mod, which I ended up doing anyway. I immediately recognized that Part 3 needs Mutable Arrays if I care to avoid Index hell, which is not what I wanted to with Haskell but oh well.

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE PatternSynonyms #-}
module Main (main) where

import qualified Data.Text as Text
import qualified Data.Text.IO as TextIO
import Control.Monad ((<$!>), forM_)
import Data.Text (Text, pattern (:<))
import qualified Data.List as List
import qualified Data.Array.MArray as MutableArray
import Control.Monad.ST (runST, ST)
import Data.Array.ST (STArray)

commaSepLine :: IO [Text.Text]
commaSepLine = Text.split (== ',') <$!> TextIO.getLine

readInstruction :: Text -> Int
readInstruction ('R' :< n) = read . Text.unpack $ n
readInstruction ('L' :< n) = negate . read . Text.unpack $ n
readInstruction _ = undefined

myName :: (Foldable t, Ord b, Enum b, Num b) => b -> t b -> b
myName maxPosition = List.foldl' (\ pos offset -> min (pred maxPosition) . max 0 $ pos + offset) 0

parentName1 :: [Int] -> Int
parentName1 = List.sum

newSTArray :: [e] -> ST s (STArray s Int e)
newSTArray xs = MutableArray.newListArray (0, length xs - 1) xs

swap :: (MutableArray.MArray a e m, MutableArray.Ix i) => a i e -> i -> i -> m ()
swap array i0 i1 = do
  e0 <- MutableArray.readArray array i0
  e1 <- MutableArray.readArray array i1
  MutableArray.writeArray array i0 e1
  MutableArray.writeArray array i1 e0

parentName2 :: [Text] -> [Int] -> Text
parentName2 nameList instructions = runST $ do
  names <- newSTArray nameList
  arrayLength <- succ . snd <$> MutableArray.getBounds names
  forM_ instructions $ \ offset -> do
    let arrayOffset = offset `mod` arrayLength
    swap names 0 arrayOffset
  MutableArray.readArray names 0

main :: IO ()
main = do
  names <- commaSepLine
  _ <- TextIO.getLine
  instructions <- fmap readInstruction <$> commaSepLine

  let namesLength = length names
  print $ names !! myName namesLength instructions
  print . (names !!) . (`mod` namesLength) $ parentName1 instructions
  print $ parentName2 names instructions

Yes exactly that. It was previously called Coq, maybe you know it under that name?

https://rocq-prover.org/

Somewhat, I’m quite motivated but it’s part of my studies.

I think this is what they are referring to: https://en.wikipedia.org/wiki/Broughton_Suspension_Bridge.

TL;DR: The bridge collapsed because soldiers marching on it created force they hadn’t anticipated, soldiers breaking step supposedly don’t have as much of an impact.

I also like watching Doctor Who, how did you manage to make a cute dalek? :d

The extension is called Burn-My-Windows and I always look forward to it when booting into GNOME because it feels so ✨fancy✨

I stumbled over Gradience just yesterday but I tought it was archived sometime last year, is it still working accordingly?

Unfortunately not :/ But I do have rainbow-gradient window borders.

I suppose you’re mainly concerned about LibAdwaita-Apps?

I was surprised to learn that

• a) macOS only recently added Left/Right-tiling natively (without extensions, just like GNOME does)
• b) they leave gaps when you tile them so that it looks like you messed up the tiling somehow

Thank you for the detailed answer, especially the explanation ‘in more words’ and the link helped me understand what happens in this Monoid instance.

Not the first year I participate but the first year I finished, 2021 was my all-time high so far with 42 stars when I was just starting oit and learning python. Knowing that there were more people in the same boat and that there was a competition kept me going, although the competiton also induced a lot of stress, not sure whether I want to keep the competitive attitude.

Thanks to everyone for uploding solutions, Ideas and program stats, this kept me optimizing away, which was a lot of fun!

I alwqys assumed you were Cameron Wu, who is?

Haskell

Have a nice christmas if you’re still celebrating today, otherwise hope you had a nice evening yesterday.

import Control.Arrow
import Control.Monad (join)
import Data.Bifunctor (bimap)
import qualified Data.List as List

heights = List.transpose
        >>> List.map (pred . List.length . List.takeWhile (== '#'))

parse = lines
        >>> init
        >>> List.groupBy (curry (snd >>> (/= "")))
        >>> List.map (List.filter (/= ""))
        >>> List.partition ((== "#####") . head)
        >>> second (List.map List.reverse)
        >>> join bimap (List.map heights)

cartesianProduct xs ys = [(x, y) | x <- xs, y <- ys]

part1 = uncurry cartesianProduct
        >>> List.map (uncurry (List.zipWith (+)))
        >>> List.filter (List.all (<6))
        >>> List.length
part2 = const 0

main = getContents
        >>= print
        . (part1 &&& part2)
        . parse

Thank you for showing this trick, I knew Haskell was lazy but this one blew my mind again.

Haskell

Part 1 was trivial, just apply the operations and delay certain ones until you have all the inputs you need.

import Control.Arrow
import Data.Bits
import Numeric

import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map

parse s = (Map.fromList inputs, equations)
        where
                ls = lines s
                inputs = map (take 3 &&& (== "1") . drop 5) . takeWhile (/= "") $ ls
                equations = map words . filter (/= "") . tail . dropWhile (/= "") $ ls

operations = Map.fromList
        [ ("AND", (&&))
        , ("XOR", xor)
        , ("OR", (||))
        ]

solveEquations is []     = is
solveEquations is (e:es)
        | is Map.!? input1 == Nothing = solveEquations is (es ++ [e])
        | is Map.!? input2 == Nothing = solveEquations is (es ++ [e])
        | otherwise      = solveEquations (Map.insert output (opfunc value1 value2) is) es
        where
                value1 = is Map.! input1
                value2 = is Map.! input2
                opfunc = operations Map.! operation
                (input1:operation:input2:_:output:[]) = e

wireNumber prefix = List.filter ((prefix `List.isPrefixOf`) . fst)
        >>> flip zip [0..]
        >>> List.filter (snd . fst)
        >>> List.map ((2 ^ ). snd)
        >>> sum

part1 = uncurry solveEquations
        >>> Map.toList
        >>> wireNumber "z"

part2 (is, es) = List.intercalate "," . List.sort . words $ "z08 ffj dwp kfm z22 gjh jdr z31"

main = getContents
        >>= print
        . (part1 &&& part2)
        . parse

For part 2 I tried symbolic solving to detect discrepancies but I wouldn’t achieve anything with it.

data SymbolicEquation = Single { eqName :: String }
        | Combine
        { eqName :: String
        , eqOperation :: String
        , eqLeft :: SymbolicEquation
        , eqRight :: SymbolicEquation
        }
        deriving (Eq)

instance Show SymbolicEquation where
        show (Single name) = name
        show (Combine name op l r) = "(" ++ name ++ "= " ++ show l ++ " " ++ op ++ " " ++ show r ++ ")"

symbolicSolve is [] = is
symbolicSolve is (e:es)
        | is Map.!? input1 == Nothing = symbolicSolve is (es ++ [e])
        | is Map.!? input2 == Nothing = symbolicSolve is (es ++ [e])
        | otherwise = symbolicSolve (Map.insert output (Combine output operation value1 value2) is) es
        where
                value1 = is Map.! input1
                value2 = is Map.! input2
                (input1:operation:input2:_:output:[]) = e

My solution was to use the dotEngine-function to translate the operations into a digraph in graphviz-style which I simply plotted and searched through using a python script.

dotEngine (input1:operation:input2:_:output:[]) = [
          input1 ++ " -> " ++ output ++ " [ label=" ++ operation ++ "];"
        , input2 ++ " -> " ++ output ++ " [ label=" ++ operation ++ "];"
        ]

I took a loook at the initial graph which was a vertical line with a few exception which I figured would be the misordered wires. I did try some hardware-simulations in the far past to build bit-adders which helped me recognize patterns like carry calculation. First I replaced all occurences of x__ XOR y__ -> w with x__ XOR y__ -> xor__ to recognize them more easily. The same with AND of xs and ys. Using the following script I would then use some Regex to search for the rules that corresponded to carry calculations or structures I knew. The script would break exactly four times and I would then figure out what to switch by hand through looking at the updated graphViz.

Please excuse the bad coding style in the script, I had written it on the ipython-REPL.

r = open("input").read()
for i in range(2, 45):
    prevI = str(i - 1).zfill(2)
    I = str(i).zfill(2)
    forward = f"xor{I} AND carry{prevI} -> (\\w+)"
    backward = f"carry{prevI} AND xor{I} -> (\\w+)"
    m1 = re.search(forward, r)
    m2 = re.search(backward, r)
    if m1 is None and m2 is None:
        print(forward, backward)
        break
    m = m1 or m2
    r = r.replace(m.group(1), f"combinedCarry{I}")
    forward = f"and{I} OR combinedCarry{I} -> (\\w+)"
    backward = f"combinedCarry{I} OR and{I} -> (\\w+)"
    m1 = re.search(forward, r)
    m2 = re.search(backward, r)
    if m1 is None and m2 is None:
        print(forward, backward)
        break
    m = m1 or m2
    r = r.replace(m.group(1), f"carry{I}")
open("input", "w").write()

When solving such a swapped wire problem I would then use my haskell function to plot it out again and stare at it for a few minutes until I understood wich parts belonged where.

The last one looked like this

In this one I needed to switch jdr and carry31 to make it work.

There probably are multiple ways to partition the graph. I haven’t applied any optimizations and my program checks members of already detected groups again, would that yield all possible partitions because I choose all the possible starting points for a k-clique?