Skip Navigation

InitialsDiceBearhttps://github.com/dicebear/dicebearhttps://creativecommons.org/publicdomain/zero/1.0/„Initials” (https://github.com/dicebear/dicebear) by „DiceBear”, licensed under „CC0 1.0” (https://creativecommons.org/publicdomain/zero/1.0/)V

VegOwOtenks

@ VegOwOtenks @lemmy.world

Posts
16
Comments
45
Joined
2 yr. ago

  • 🍗 - 2025 DAY 10 SOLUTIONS - 🍗

    Jump

  • 🎁 - 2025 DAY 9 SOLUTIONS - 🎁

    Jump

  • Futhark

    First, formatting the input with an unreadable sed script:

     sed
        
1i [
1,$ {
	s/^/[/
	s/$/], /
}
$i ]
$d

    Then, the actual program. main is the default entrypoint, part one is trivially solved in the preparations for part two. In part two, the faster check is to look for any point inside the current rectangle. If this can't find any, it'll have to check whether any edge crosses through the rectangle with a simple range check. I'm not happy with the performance, I feel like I left a lot on the table.

     ocaml
        
import "lib/github.com/diku-dk/sorts/radix_sort"

def (&&&) 'a 'b 'c (f: a -> b) (g: a -> c) (x: a): (b, c) = (f x, g x)
def odd (x: i64): bool = x % 2 == 1

def count 'a (f: a -> bool) (xs: []a): i64
  = map (f >-> i64.bool) xs |> reduce_comm (+) 0

def coordinateFromArray (as: [2]i64): (i64, i64)
  = (as[0], as[1])

def maximum = reduce_comm i64.max i64.lowest
def minimum = reduce_comm i64.min i64.highest

def concatMap [n] 'a 'b (f: a -> ?[l].[l]b) (placeholder: b) (xs: [n]a): *[]b
  = let totalLength = reduce (+) 0 <| map (\ x -> length (f x)) xs in
    ( loop (results, offset) = (replicate totalLength placeholder, 0)
      for x in xs
      do
        let bs = f x in
        let scatterIndices = indices bs |> map (+offset) in
        (scatter results scatterIndices bs, offset + length bs)
    ).0

def rectSize (a: (i64, i64)) (b: (i64, i64)) = 
  let dx = i64.max a.0 b.0 - i64.min a.0 b.0 in
  let dy = i64.max a.1 b.1 - i64.min a.1 b.1 in
  (dx + 1) * (dy + 1)

def pair_iota (n: i64): [n](i64, i64)
  = map (\ j -> (n, j)) (iota n)

def pairs 'a (xs: []a): [](a, a)
  = concatMap pair_iota (i64.highest, i64.highest) (indices xs)
    |> map (\ (i, j) -> (xs[i], xs[j]))

def findFirst 'a (f: a -> bool) (xs: []a): a
  = ( loop (i, x) = (0, xs[0])
      while not (f x)
      do (i + 1, xs[i+1])
    ) |> (.1)

def orderedPair (p: (i64, i64)): (i64, i64) = (i64.min p.0 p.1, i64.max p.0 p.1)

def overlapsWith (a: (i64, i64)) (b: (i64, i64)): bool 
  = a.0 < b.1 && b.0 < a.1

def anyInside (points: [](i64, i64)) (rectangle: (((i64, i64), (i64, i64)), i64))
  = let (lowerX, upperX) = orderedPair (rectangle.0.0.0, rectangle.0.1.0) in
    let (lowerY, upperY) = orderedPair (rectangle.0.0.1, rectangle.0.1.1) in
    map (\ (x, y) -> lowerX < x && x < upperX && lowerY < y && y < upperY) points
    |> or

def anyIntersects (edges: []((i64, i64), (i64, i64))) (rectangle: (((i64, i64), (i64, i64)), i64)): bool
  = let rectRangeX = orderedPair (rectangle.0.0.0, rectangle.0.1.0) in
    let rectRangeY = orderedPair (rectangle.0.0.1, rectangle.0.1.1) in
    map (\ e -> 
      let edgeRangeX = orderedPair (e.0.0, e.1.0) in
      let edgeRangeY = orderedPair (e.0.1, e.1.1) in
      (edgeRangeX `overlapsWith` rectRangeX) && (edgeRangeY `overlapsWith` rectRangeY)
    ) edges
    |> or

def part2 (sortedRectangles: [](((i64, i64), (i64, i64)), i64)) (points: [](i64, i64))
  = let edges = zip points (rotate 1 points) in
    let filled = \ r -> not (anyInside points r || anyIntersects edges r) in
    findFirst filled sortedRectangles
    |> (.1)

-- benchmark
-- ==
-- input @fut-input
-- auto output

def main (coordinateArrays: [][2]i64)
  = let coordinates = map coordinateFromArray coordinateArrays in
    let rectangleCorners = pairs coordinates in
    let rectangleSizes = map (id &&& uncurry rectSize) rectangleCorners in
    let sortedRectangles = radix_sort_by_key (.1) i64.num_bits i64.get_bit rectangleSizes |> reverse in
  (sortedRectangles[0].1, part2 sortedRectangles coordinates)

  • 🤶 - 2025 DAY 8 SOLUTIONS - 🤶

    Jump

  • This is crazy concise and fast! Impressive.

  • 🤶 - 2025 DAY 8 SOLUTIONS - 🤶

    Jump

  • It seems like you forgot the backticks around the code. It's very hard to read this way. Also python comments look like markdown headlines :]

  • 🤶 - 2025 DAY 8 SOLUTIONS - 🤶

    Jump

  • Futhark

    As always, futhark does not support arbitrary inputs, so I have a sed script to transform the input to something readable.

    it produces a textual representation of [][3]u32, try it on your example or input :]

     sed
        
1i [
1,$ {
	s/^/[/
	s/$/]/
}
2,$i,
$i ]
$d

    Calculate all the distances (even the redundant ones, I had no idea on how to filter them out). Sort them, keep only the first 1000 for part 1. Keep all for part two. Initialize all boxes to be in no component. Add them to components as time goes on. When connecting two boxes already in a component. Mark all boxes in the second component as part of the first one. Stop when everything is connected.

    After improving my implementation of concatMap (preallocate the entire array), the overall performance improved greatly. My end stats are

    • Time: 7s -> 0.35s
    • Memory: 2GB -> 66MB

    Basic

     ocaml
        
import "lib/github.com/diku-dk/sorts/radix_sort"

type position = (u32, u32, u32)
def positionFromArray (p: [3]u32): position
  = (p[0], p[1], p[2])
def pair_iota (n: i64): [n](i64, i64)
  = map (\ j -> (n, j)) (iota n)
def gaussian_sum (n: i64) = n * (n + 1) / 2

def euclidean_distance (a: position) (b: position): f64
  = f64.sqrt 
    ( (f64.u32 a.0 - f64.u32 b.0) ** 2
    + (f64.u32 a.1 - f64.u32 b.1) ** 2
    + (f64.u32 a.2 - f64.u32 b.2) ** 2
    )

def distance_table [n] (positions: [n]position): [n][n]f64
  = let distance_function = \ i j -> euclidean_distance positions[i] positions[j] in
    tabulate_2d n n distance_function

def existsLength 'a 'b (f: a -> ?[l].[l]b) (x: a): i64
  = length (f x)

def concatMap [n] 'a 'b (f: a -> ?[l].[l]b) (placeholder: b) (xs: [n]a): *[]b
  = let totalLength = reduce (+) 0 <| map (\ x -> length (f x)) xs in
    ( loop (results, offset) = (replicate totalLength placeholder, 0)
      for x in xs
      do
        let bs = f x in
        let scatterIndices = indices bs |> map (+offset) in
        (scatter results scatterIndices bs, offset + length bs)
    ).0

def distance_array [n] (positions: [n]position): []((i64, i64), f64)
  = let table = distance_table positions in
    let triangle_indices = concatMap pair_iota (i64.highest, i64.highest) (iota n |> drop 1) in
    map (\ (i, j) -> ((i, j), table[i, j])) triangle_indices

def sort_distances (distances: []((i64, i64), f64)): []((i64, i64), f64)
  = radix_sort_float_by_key (.1) f64.num_bits f64.get_bit distances

type option 'a
  = #Empty
  | #Present a

def empty 'a : option a = #Empty

def overrideWith (old: u16) (new: u16) (x: option u16): option u16
  = match x
      case #Empty -> #Empty
      case #Present inner -> 
        if inner == old
        then #Present new
        else #Present inner

def orElse 'a (o: option a) (d: a): a
  = match o
      case #Empty -> d
      case #Present x -> x

def is_present 'a (o: option a): bool
  = match o
      case #Empty -> false
      case #Present _ -> true

def connect (circuits: *[](option u16)) (newCircuitId: u16) (connection: (i64, i64)): (u16, *[](option u16))
  = let circuitA = circuits[connection.0] in
    let circuitB = circuits[connection.1] in
    match (circuitA, circuitB)
      case (#Empty, #Empty) -> 
        ( newCircuitId + 1
        , scatter circuits [connection.0, connection.1] (rep (#Present newCircuitId))
        )
      case (#Present a, #Empty) -> 
        ( newCircuitId
        , scatter circuits [connection.1] [#Present a]
        )
      case (#Empty, #Present b) -> 
        ( newCircuitId
        , scatter circuits [connection.0] [#Present b]
        )
      case (#Present a, #Present b) ->
        ( newCircuitId
        , map (b `overrideWith` a) circuits
        )

def countCircuit (counts: *[]u64) (o: option u16): *[]u64 
  = match o
    case #Empty -> counts 
    case #Present i -> scatter counts [i64.u16 i] [counts[i64.u16 i] + 1]

def countCircuits (c: u16) (circuits: [](option u16)): *[i64.u16 c]u64
  = let circuitCounts = replicate (i64.u16 c) 0 in
    loop counts = circuitCounts
    for circuit in circuits
    do countCircuit counts circuit

def exampleConnectionCount = 10i64
def inputConnectionCount = 1000i64

def part1 (positions: i64) (connectionCount: i64) (distances: []((i64, i64), f64))
  = let connections = take connectionCount distances |> map (.0) in
    let circuitMap: *[positions](option u16) = replicate positions empty in
    ( loop (circuitCount, circuits) = (0, circuitMap)
      for connection in connections
      do
        connect circuits circuitCount connection
    ) |> uncurry countCircuits 
      |> radix_sort u64.num_bits u64.get_bit
      |> reverse
      |> take 3
      |> foldl (*) 1

def part2 (positionCount: i64) (distances: []((i64, i64), f64)) (positions: []position)
  = let circuitMap: *[positionCount](option u16) = replicate positionCount empty in
    ( loop (circuitCount, connectionIndex, circuits) = (0, 0, circuitMap)
      while not
        ( and (map is_present circuits)
        && and (map (== circuits[0]) circuits)
        )
      do
        let connection = distances[connectionIndex].0 in
        let (newCircuitId, circuits') = connect circuits circuitCount connection in
        (newCircuitId, connectionIndex+1, circuits')
    ).1
    |> \ i -> distances[i-1].0
    |> \ (a, b) -> positions[a].0 * positions[b].0

def main [n] (position_array: [n][3]u32)
  = let positions = map positionFromArray position_array in
    let unsorted_distances = distance_array positions in
    let sorted_distances = sort_distances unsorted_distances in
    ( part1 n inputConnectionCount sorted_distances
    , part2 n sorted_distances positions
    )

  • 🧑 - 2025 DAY 2 SOLUTIONS - 🧑

    Jump

  • Futhark

    I translated my Haskell solution to Futhark, basically. It runs abysmally faster.

    The syntax highlighting is likely very off, because the closest language highlighter I could find was ocaml.

     ocaml
        
def fst 'a 'b ((a, _b): (a, b)): a = a
def snd 'a 'b ((_a, b): (a, b)): b = b
def (>>>) 'a 'b 'c (f: a -> b) (g: b -> c) (x: a): c = g (f x)
def (|) '^a 'b (f: a -> b) (x: a): b = f x -- $ is not allowed
def even (x: i64): bool = x % 2 == 0

def digitCount (x: i64): i64
  = snd | 
      loop (i, len) = (x, 0)
      while i != 0
      do (i / 10, len + 1)

def digitAt (n: i64) (i: i64): i64 = (n / 10 ** i) % 10

def keepTrue (p: i64 -> bool) (x: i64): i64
  = if p x
      then x
      else 0

def tup2RangeArray ((start, end): (i64, i64)): []i64
  = (start ... end)

def sumInvalidIds (p: i64 -> bool) (rangeTup: (i64, i64)): i64 
  = let range = tup2RangeArray rangeTup in
  reduce (+) 0 (map (keepTrue p) range)

def tup2FromArray 'a (as: [2]a): (a, a) = (as[0], as[1])

def impl (p: i64 -> bool) (ranges: [](i64, i64)): i64 
  = reduce (+) 0 (map (sumInvalidIds p) ranges)

def withValidRepeatOffsets (nDigits: i64) (f: i64 -> bool): bool
  = match nDigits
    case 2  -> map f >>> or | [1]
    case 3  -> map f >>> or | [1]
    case 4  -> map f >>> or | [1, 2]
    case 5  -> map f >>> or | [1]
    case 6  -> map f >>> or | [1, 2, 3]
    case 7  -> map f >>> or | [1]
    case 8  -> map f >>> or | [1, 2, 4]
    case 9  -> map f >>> or | [1, 3]
    case 10 -> map f >>> or | [1, 2, 5]
    case 11 -> map f >>> or | [1]
    case 12 -> map f >>> or | [1, 2, 3, 4, 6]
    case _ -> false

def isValid2 (x: i64): bool = 
  let len = digitCount x in
  let lookupDigit = digitAt x in
  withValidRepeatOffsets len | \ repeatOffset ->
    let repeatCount = len / repeatOffset in
    let digitIndices = (0..< repeatOffset) in
    let repeatIndices = (0..<repeatCount) in
    and | 
      map (\ digitIndex -> 
        and |
          map (\ repeatIndex -> 
            let expectedDigit = lookupDigit digitIndex in
            let actualDigit   = lookupDigit | repeatIndex * repeatOffset + digitIndex in
            expectedDigit == actualDigit
          ) 
          repeatIndices
      ) digitIndices

def part2 : [](i64, i64) -> i64 = impl isValid2 

def isValid1 (x: i64): bool = 
  let len = digitCount x in
  let halfLength = len / 2 in
  let first = x / 10 ** halfLength in
  let second = x % 10 ** halfLength in
  even len && first == second

def part1 : [](i64, i64) -> i64 = impl isValid1 

def main (rangeArrays: [][2]i64) 
  = let rangeTuples = map tup2FromArray rangeArrays in
    (part1 rangeTuples, part2 rangeTuples)

  

     sed
        
i [
s/\([0-9]\+\)-\([0-9]\+\)/\[\1, \2]/g
a ]

  • 💃 - 2025 DAY 3 SOLUTIONS - 💃

    Jump

  • Futhark

    I am on my way to re-do all previous days in Futhark and complete the Rest of AoC, hopefully.

     ocaml
        
def hole: u8 = 0
def zipIndices 'a (xs: []a): [](i64, a) = zip (indices xs) xs
def foldMin (xs: []u8): (i64, u8) = 
  let indexedXs = tail (zipIndices xs) in
  let start = (0, head xs) in
  foldl (\ (ci, cv) (ni, nv) -> if nv > cv then (ni, nv) else (ci, cv)) start indexedXs

def slice 'a (xs: []a) (start: i64) (end: i64) = drop start (take end xs)

def pickBattery (bank: []u8) (reserved: i64): (i64, u8) = 
  let batteries = slice bank 0 (length bank - reserved) in
  foldMin batteries

def pickNBatteries (n: i8) (banks: []u8): u64 =
  let (_, result) =
    loop (batteries, sum) = (banks, 0)
    for i in reverse (0...n-1)
    do
      let (offset, battery) = pickBattery batteries (i64.i8 i) in
      (drop (offset + 1) batteries, sum * 10 + u64.u8 battery)
  in result

def part1 (banks: [][]u8): u64 = reduce (+) 0 (map (pickNBatteries 2) banks)

def part2 (banks: [][]u8): u64 = reduce (+) 0 (map (pickNBatteries 12) banks)

def main (banks: [][]u8) = (part1 banks, part2 banks)

  

     haskell
        
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text.IO as TextIO
import Control.Monad ((<$!>))
import qualified Data.Array.Unboxed as Array
import qualified Data.Text as Text
import qualified Data.Char as Char
import Data.Array.Unboxed (UArray)
import qualified Data.List as List
import qualified Data.ByteString as ByteString
import Data.Word (byteSwap64, Word64)
import GHC.ByteOrder (ByteOrder(..), targetByteOrder)
import qualified Data.Bits as Bits

parse :: Text.Text -> UArray (Int, Int) Int
parse t = let
    banks = init $ Text.lines t
    bankSize = maybe 0 pred $ Text.findIndex (== '\n') t
    bankCount = Text.count "\n" t - 2
  in Array.listArray ((0, 0), (bankCount, bankSize)) $ List.concatMap (fmap Char.digitToInt . Text.unpack) banks

rowsOf :: UArray (Int, Int) Int -> Int
rowsOf = fst . snd . Array.bounds

colsOf :: UArray (Int, Int) Int -> Int
colsOf = snd . snd . Array.bounds

byteStringLeWord64 :: Word64 -> ByteString.ByteString
byteStringLeWord64 word = let
    leWord = case targetByteOrder of
      BigEndian -> byteSwap64 word
      LittleEndian -> word
  in ByteString.pack . map (fromIntegral . (leWord `Bits.shiftR`)) $ [0,8..56]

main :: IO ()
main = do
  batteryBanks <- parse <$!> TextIO.getContents
  putChar 'b'
  ByteString.putStr (ByteString.singleton 2) -- version
  ByteString.putStr (ByteString.singleton 2) -- dimensions
  TextIO.putStr "  u8" -- type
  ByteString.putStr (byteStringLeWord64 . fromIntegral . succ . rowsOf $ batteryBanks) -- outer dim
  ByteString.putStr (byteStringLeWord64 . fromIntegral . succ . colsOf $ batteryBanks) -- inner dim
  ByteString.putStr . ByteString.pack . fmap fromIntegral . Array.elems $ batteryBanks -- elements

  • 🎄 - 2025 DAY 4 SOLUTIONS - 🎄

    Jump

  • Futhark

    Only part 1 so far, I want to do part 2 later too.

    This is my first ever futhark program. I have not yet figured out whether string parsing is possible or intended with this language. I used a combination of sed and vim to bring the input into a form futhark can read.

     ocaml
        
def neighbors (x: i32, y: i32): [8](i32, i32) = [(x+1, y+1), (x+1, y), (x+1, y-1), (x, y+1), (x, y-1), (x-1, y+1), (x-1, y), (x-1, y-1)]

def count 't (p: t -> bool) (xs: []t) : i32 = reduce (+) 0 (map (\ x -> i32.bool (p x)) xs)
def count2 't (p: t -> bool) (xs: [][]t) : i32 = reduce (+) 0 (map (count p) xs)

def zipIndices [n] 't (xs: [n]t): [n](i32, t) = zip (map i32.i64 (indices xs)) xs
def zipIndices2 [n][m] 't (xs: [m][n]t): [m][n]((i32, i32), t) = 
  let innerIndices = map zipIndices xs in
  let innerAndOuterIndices = zipIndices innerIndices in
  map (\ (r, a) -> map (\ (c, x) -> ((r, c), x)) a) innerAndOuterIndices

def countIndexed2 't (p: (i32, i32) -> t -> bool) (xs: [][]t): i32 = 
  let withIndices = zipIndices2 xs in
  count2 (\ (i, x) -> p i x) withIndices

type option 't
  = #single t
  | #empty

def safeIndex 't (xs: []t) (i: i32): option t = if i32.i64 (length xs) > i && i >= 0
  then #single xs[i]
  else #empty

def safeIndex2 't (xs: [][]t) ((r, c): (i32, i32)): option t = 
  match safeIndex xs r
    case #single a -> safeIndex a c
    case #empty -> #empty

def orElse 't (o: option t) (d: t): t =
  match o
    case #single x -> x
    case #empty    -> d

def isAccessible (grid: [][]bool) (p: (i32, i32)) (x:bool): bool =
  let neighborsOptions = map (safeIndex2 grid) (neighbors p) in
  let neighborsFilled = map (`orElse` false) neighborsOptions in
  x && count id neighborsFilled < 4

def mapIndexed2 'a 'b (f: (i32, i32) -> a -> b) (xs: [][]a): [][]b =
  let withIndices = zipIndices2 xs in
  map (map (\ (i, x) -> f i x)) withIndices

def removeAccessibles (grid: [][]bool): [][]bool = mapIndexed2 (\ p x -> x && not (isAccessible grid p x)) grid

def part1 (grid: [][]bool): i32 = countIndexed2 (isAccessible grid) grid
def part2 (grid: [][]bool): i32 =
  let (reducedGrid, _) = 
    loop (current, last) = (removeAccessibles grid, grid)
    while current != last
    do 
      let current' = removeAccessibles current in
      let last'    = copy current in
      (current', last')
  in count2 id grid - count2 id reducedGrid

def main (grid: [][]bool) = (part1 grid, part2 grid)

    The highlighting is a bit off because I used ocaml as the language. There is no futhark highlighter (at least in Web UI) yet.Edit: Part2

    Also, it runs blazingly fast 🚀 :O, even in sequential C mode

  • 🎄 - 2025 DAY 4 SOLUTIONS - 🎄

    Jump

  • Haskell

    I tried rewriting part 2 to use a MutableArray, but it only made everything slower. So I left it at this. I saw somebody do a 1-second-challenge last year and I feel like that will be very hard unless I up my performance game.

     haskell
        
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}
module Main (main) where
import qualified Data.Text as Text
import Data.Array.Unboxed (UArray)
import qualified Data.Array.IArray as Array
import qualified Data.List as List
import Control.Monad ((<$!>), guard)
import qualified Data.Text.IO as TextIO
import Data.Maybe (fromMaybe)
import Control.Arrow ((&&&))

parse :: Text.Text -> UArray (Int, Int) Bool
parse t = let
    gridLines = init $ Text.lines t
    lineSize = maybe 0 pred $ Text.findIndex (== '\n') t
    lineCount = Text.count "\n" t - 2
  in Array.listArray ((0, 0), (lineCount, lineSize)) $ List.concatMap (fmap (== '@') . Text.unpack) gridLines

neighbors8 :: (Int, Int) -> [(Int, Int)]
neighbors8 p@(x, y) = do
  x' <- [pred x .. succ x]
  y' <- [pred y .. succ y]
  let p' = (x', y')
  guard (p /= p')
  pure p'

main :: IO ()
main = do
  grid <- parse <$!> TextIO.getContents
  print $ part1 grid
  print $ part2 grid

part2 :: UArray (Int, Int) Bool -> Int
part2 grid = case accessiblePositions grid of
  [] -> 0
  xs -> List.length xs + part2 (grid Array.// fmap (id &&& const False) xs)

part1 :: UArray (Int, Int) Bool -> Int
part1 = List.length . accessiblePositions

accessiblePositions :: UArray (Int, Int) Bool -> [(Int, Int)]
accessiblePositions grid = let
     lookupPosition = fromMaybe False . (grid Array.!?)
     positions = Array.indices grid
     paperRollPositions = List.filter lookupPosition positions
     isPositionAccessible = (< 4) . List.length . List.filter lookupPosition . neighbors8
   in List.filter isPositionAccessible paperRollPositions

  • 💃 - 2025 DAY 3 SOLUTIONS - 💃

    Jump

  • Haskell

    Usually, I get up for AoC, way earlier than I normally would. But today I had to get up at exactly AoC time. I ended up postponing the puzzles until now:

    It reads from stdin and writes the both solutions on a separate line to stdout.

     haskell
        
{-# OPTIONS_GHC -Wall #-}
import qualified Data.Text.IO as TextIO
import Control.Monad ((<$!>))
import qualified Data.Array.Unboxed as Array
import qualified Data.Text as Text
import qualified Data.Char as Char
import Data.Array.Unboxed (UArray)
import qualified Data.Foldable as Foldable
import Control.Arrow ((&&&))
import qualified Data.List as List

parse :: Text.Text -> UArray (Int, Int) Int
parse t = let
    banks = init $ Text.lines t
    bankSize = maybe 0 pred $ Text.findIndex (== '\n') t
    bankCount = Text.count "\n" t - 2
  in Array.listArray ((0, 0), (bankCount, bankSize)) $ List.concatMap (fmap Char.digitToInt . Text.unpack) banks

rowsOf :: UArray (Int, Int) Int -> Int
rowsOf = fst . snd . Array.bounds

colsOf :: UArray (Int, Int) Int -> Int
colsOf = snd . snd . Array.bounds

main :: IO ()
main = do
  batteryBanks <- parse <$!> TextIO.getContents
  print $ part1 batteryBanks
  print $ part2 batteryBanks

part1 :: UArray (Int, Int) Int -> Int
part1 batteryBanks = Foldable.sum $ pickBatteries 2 batteryBanks <$> [0.. rowsOf batteryBanks]

part2 :: UArray (Int, Int) Int -> Int
part2 banks = Foldable.sum $ pickBatteries 12 banks <$> [0.. rowsOf banks]

pickBatteries :: Int -> UArray (Int, Int) Int -> Int -> Int
pickBatteries batteryCount banks row = let
    width = colsOf banks
    getBattery col = banks Array.! (row, col)

    go acc 0 _      = acc
    go acc n offset = let
        effectiveEnd = width - pred n
        availableIndices = [offset .. effectiveEnd]
        batteryWithIndices = (id &&& getBattery) <$> availableIndices
        (offset', selectedBattery) = maximumOn snd batteryWithIndices
      in go (acc * 10 + selectedBattery) (pred n) (succ offset')
  in go 0 batteryCount 0

maximumOn :: (Foldable t, Ord b) => (a -> b) -> t a -> a
maximumOn f collection = case Foldable.toList collection of
  [] -> error "maximumOn: empty foldable"
  (x:xs) -> List.foldl selectMax x xs
  where
    selectMax a b = if f a < f b then b else a

  • 🧑 - 2025 DAY 2 SOLUTIONS - 🧑

    Jump

  • Easy one to get through, no edge-cases biting me this time.

    I learned this year again: running in interpreted mode can cause significant slowdowns. Later, I'll hopefully find the time clean it up, this solution feels ugly. Reading everyone else did it also like this or with regex makes me feel better about it though.

    Haskell

     haskell
        
module Main (main) where
import qualified Text.ParserCombinators.ReadP as ReadP
import Numeric.Natural (Natural)
import Control.Monad ((<$!>), guard)
import qualified Data.List as List
import Control.Arrow ((>>>))
import qualified Data.Text as Text
import qualified Data.Foldable as Foldable

newtype Range = Range { getRange :: (Natural, Natural) }
  deriving Show

parseRange :: ReadP.ReadP Range
parseRange = do
  n1 <- ReadP.readS_to_P reads
  _ <- ReadP.char '-'
  n2 <- ReadP.readS_to_P reads
  pure . Range $ (n1, n2)

parseLine :: ReadP.ReadP [Range]
parseLine = parseRange `ReadP.sepBy` ReadP.char ','

main :: IO ()
main = do
  ranges <- fst . last . ReadP.readP_to_S parseLine <$!> getContents
  print $ part1 ranges
  print $ part2 ranges

part1 :: [Range] -> Natural
part1 = List.concatMap (uncurry enumFromTo . getRange)
  >>> List.filter isDoublePattern
  >>> Foldable.sum

part2 :: [Range] -> Natural
part2 = List.concatMap (uncurry enumFromTo . getRange)
  >>> List.filter isMultiplePattern
  >>> Foldable.sum

isMultiplePattern :: Natural -> Bool
isMultiplePattern n = let
    textN = Text.show n
    textLength = Text.length textN
  in flip any (divisorsOf textLength) $ \ divisor -> let
      patternLength = textLength `div` divisor
      patternPart = Text.take (fromIntegral patternLength) textN
    in Text.replicate (fromIntegral divisor) patternPart == textN

isDoublePattern :: Natural -> Bool
isDoublePattern n = let
  textN = Text.show n
  evenLength = even (Text.length textN)
  (first, second) = Text.splitAt (Text.length textN `div` 2) textN
  in evenLength && first == second

divisorsOf :: Integral b => b -> [b]
divisorsOf n = do
  x <- [2..n]
  guard ((n `mod` x) == 0)
  pure x

    Using the interpreter, this solution made me wait for two minutes until I could submit. x.x After testing it again in compiled mode, it only takes four seconds.

  • 🔒 - 2025 DAY 1 SOLUTIONS -🔒

    Jump

  • Thank you for the excellent question. This made me reflect on my coding style and why I actually chose this. Maybe you have noticed, my usage of LambdaCase is inconsistent: I didn't use it in the definition of foldRotation. Which happened with some refactorings (You couldn't know that, I didn't tell anywhere), but still.

    After going through some 'old' code I found that I didn't start using it until early this year. (For context: I started doing Haskell in September 2024) But that may just coincide with me installing HLS.

    Anyway, back to the topic: I actually think it's very elegant because it saves re-typing the function name and/or other parameters. It also easily allows me to add further arguments to the function (but only before the last one). In my mind, this is where LambdaCase shines.

    Sometimes I end up refactoring functions because it's very hard to match on multiple arguments using LambdaCase. I also try to avoid adding arguments in the back, which might bite me later and limits flexibility a lot.

    I picked it up in some forum discussion I read where somebody argued that using explicit matches litters the Codebase with re-definitions of the same functions. It makes grep-ing the source hard. I was easily influenced by this and adopted it.

    I think this is not the way I like to go about it. I would rather use Hoogle, Haddock or HLS to search in my source.

  • 🔒 - 2025 DAY 1 SOLUTIONS -🔒

    Jump

  • I think that's a really cool usage of the Writer Monad. I thought about the State Monad but didn't end up using it. Was too hectic for me. Thanks for showing and sharing this!

  • 🔒 - 2025 DAY 1 SOLUTIONS -🔒

    Jump

  • How could I run this code? Do you use some kind of framework for AoC?

  • 🔒 - 2025 DAY 1 SOLUTIONS -🔒

    Jump

  • The struggled with a counting solution for a long time. I submitted with a simple enumerative solution in the end but managed to get it right after some pause time:

    Haskell

     haskell
        
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OrPatterns #-}
module Main (main) where

import Control.Monad ( (<$!>) )
import qualified Data.List as List

main :: IO ()
main = do
  rotations <- (fmap parseRotation . init . lines) <$!> getContents
  print $ part1 rotations
  print $ part2 rotations

part2 :: [Either Int Int] -> Int
part2 rotations = let

    foldRotation (position, zeroCount) operation = case operation of
      Left y -> let
        (zeroPasses, y') = y `divMod` 100
        position' = (position - y') `mod` 100
        zeroCount' = zeroPasses + zeroCount + if position <= y' then fromEnum $ position /= 0 else 0
        in (position', zeroCount')
      Right y -> let
        (zeroPasses, y') = y `divMod` 100
        position' = (position + y') `mod` 100
        zeroCount' = zeroPasses + zeroCount + if y' + position >= 100 then 1 else 0
        in (position', zeroCount')

  in snd $ List.foldl' foldRotation (50, 0) rotations

part1 :: [Either Int Int] -> Int
part1 rotations = let
    positions = List.scanl applyRotation 50 rotations
  in List.length . filter (== 0) $ positions

applyRotation :: Int -> Either Int Int -> Int
applyRotation x = \case
  Left y -> (x - y) `mod` 100
  Right y -> (x + y) `mod` 100

parseRotation :: String -> Either Int Int
parseRotation = \case
  'R':rest -> Right $ read rest
  'L':rest -> Left $ read rest
  bad -> error $ "invalid rotation operation: " ++ bad

  

     haskell
        
-- | Old solution enumerating all the numbers

part2' :: [Either Int Int] -> Int
part2' rotations = let
  intermediatePositions _ [] = []
  intermediatePositions x (op:ops) = case op of
    Left 0; Right 0 -> intermediatePositions x ops
    Left y -> let x' = pred x `mod` 100 in x' : intermediatePositions x' (Left (pred y) : ops)
    Right y -> let x' = succ x `mod` 100 in x' : intermediatePositions x' (Right (pred y) : ops)
  in List.length . List.filter (== 0) . intermediatePositions 50 $ rotations

  • what five years of computer science will do to you

    Jump

  • Nice Setup and Picture and also the lighting!

    Seriously though, how do you take such pictures? I tried and failed multiple times already. Too dark, bad angles, blinding lights, you name it.

  • 🦆 Everybody.Codes 2025 Quest 1 Solutions 🦆

    Jump

  • Thank you for this update. Now that problwm and solution fit, I can understand whats going on in your code :]

  • 🦆 Everybody.Codes 2025 Quest 3 Solutions 🦆

    Jump

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

     haskell
        
{-# 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
  • Advent Of Code @programming.dev
    VegOwOtenks @lemmy.world

    everbody.codes, Quest 2: Visualization

  • 🦆 Everybody.Codes 2025 Quest 2 Solutions 🦆

    Jump

  • 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)

     haskell
        
{-# 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:

     python
        
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.

  • Math Memes @lemmy.blahaj.zone
    VegOwOtenks @lemmy.world

    Proof. trivial. Qed.

  • Haskell @programming.dev
    VegOwOtenks @lemmy.world

    Issue 481 :: Haskell Weekly Newsletter

    haskellweekly.news /issue/481.html
  • Haskell @programming.dev
    VegOwOtenks @lemmy.world

    Issue 480 :: Haskell Weekly Newsletter

    haskellweekly.news /issue/480.html
  • Haskell @programming.dev
    VegOwOtenks @lemmy.world

    Issue 475 :: Haskell Weekly newsletter

    haskellweekly.news /issue/475.html
  • linuxmemes @lemmy.world
    VegOwOtenks @lemmy.world

    When I try to go on a ricing journey again

  • Haskell @programming.dev
    VegOwOtenks @lemmy.world

    Use monoids for construction, what does it do?

  • No Stupid Questions @lemmy.world
    VegOwOtenks @lemmy.world

    Is there any security in the communication with Voyager I?

  • Ask Lemmy @lemmy.world
    VegOwOtenks @lemmy.world

    What is your favourite matrix client?

  • memes @lemmy.world
    VegOwOtenks @lemmy.world

    Quit Windows Fun Now

  • Programmer Humor @programming.dev
    VegOwOtenks @lemmy.world

    TemporalAccessor, TemporalAdjustor could just as well be Star Trek things

  • Programmer Humor @lemmy.ml
    VegOwOtenks @lemmy.world

    Regex flavors

  • Programmer Humor @lemmy.ml
    VegOwOtenks @lemmy.world

    What Parity Flag is that?

  • linuxmemes @lemmy.world
    VegOwOtenks @lemmy.world

    getsockname()