- 23 Posts
- 110 Comments
Joined 2 years ago
Cake day: May 9th, 2024
You are not logged in. If you use a Fediverse account that is able to follow users, you can follow this user.
2·10 days agoFuthark + sed
Futhark can read only number and array types from stdin, the input data is often a non-starter. Therefore, I often massage it into the right format using
sed.Sed Script
s/[: ]/,/g s/[rgbs]/0/g s/[RGBS]/1/g 1s/^/[ [/ 2,$s/^/, [/ s/$/]/ s/,\([01]\)/,0b\1/g $a]This formats everything nicely, e.g. the example for part 1:
2456:rrrrrr ggGgGG bbbbBB 7689:rrRrrr ggGggg bbbBBB 3145:rrRrRr gggGgg bbbbBB 6710:rrrRRr ggGGGg bbBBbBis transformed into this:
[ [2456,0b000000,0b001011,0b000011] , [7689,0b001000,0b001000,0b000111] , [3145,0b001010,0b000100,0b000011] , [6710,0b000110,0b001110,0b001101] ]Futhark Solution
entry part1 (colors: [][4]i32) = let isGreenDominant c = c.g > c.r && c.g > c.b in colors |> map (\array -> (array[0], {r = array[1], g = array[2], b = array[3]})) |> filter ((.1) >-> isGreenDominant) |> map (.0) |> i32.sum type Optional 'a = #absent | #present a def map_optional 'a 'b (f: a -> b) (this: Optional a) : Optional b = match this case #absent -> #absent case #present a -> #present (f a) def optional_is_present 'a (this: Optional a) : bool = match this case #absent -> false case _ -> true def unwrap_optional 'a (this: Optional a) : a = match this case #absent -> assert (("unwrap_optional: #absent", false).1) ([][1]) case #present a -> a def bind_optional 'a 'b (f: a -> Optional b) (this: Optional a) : Optional b = match this case #absent -> #absent case #present a -> f a def maximum_by 'a (gte: a -> a -> bool) (as: []a) : Optional a = let choose (this: Optional a) (other: Optional a) = match (this, other) case (#absent, o) -> o case (t, #absent) -> t case (#present t, #present o) -> #present (if o `gte` t then o else t) in reduce choose #absent (map (\a -> #present a) as) type ShineColor = {r: i32, g: i32, b: i32, s: i32} def array2ShineColor (array: [5]i32) : (i32, ShineColor) = (array[0], {r = array[1], g = array[2], b = array[3], s = array[4]}) def on f g a b = f (g a) (g b) entry part2 (colors: [][5]i32) = let gte (this: ShineColor) (other: ShineColor): bool = let colorSum c = c.r + c.g + c.b in this.s > other.s || (this.s == other.s && colorSum this <= colorSum other) in colors |> map array2ShineColor |> maximum_by (gte `on` (.1)) |> unwrap_optional |> (.0) type Shininess = #matte | #shiny type DominantColor = #red | #green | #blue def filterMap 'a 'b [n] (f: a -> Optional b) (as: [n]a) : []b = as |> map f |> filter optional_is_present |> map unwrap_optional def categorize_shininess (s: i32) : Optional Shininess = if s <= 30 then #present #matte else if s >= 33 then #present #shiny else #absent def categorize_color (color: ShineColor) : Optional DominantColor = if color.r > color.g && color.r > color.b then #present #red else if color.g > color.r && color.g > color.b then #present #green else if color.b > color.r && color.b > color.g then #present #blue else #absent def categorize ((value, color): (i32, ShineColor)) : Optional (i32, (DominantColor, Shininess)) = categorize_shininess color.s |> bind_optional (\s -> map_optional (\c -> (c, s)) (categorize_color color)) |> map_optional (\g -> (value, g)) -- >>> category_index (#red, #shiny) -- 3 def category_index ((c, s): (DominantColor, Shininess)) : i64 = (+) (match c case #red -> 0 case #green -> 1 case #blue -> 2) (match s case #matte -> 0 case #shiny -> 3) def (&&&) f g x = (f x, g x) def sum2d (a, b) (c, d) : (i32, i32) = (a + c, b + d) entry part3 (colors: [][5]i32) = colors |> map array2ShineColor |> filterMap categorize |> map ((.1) >-> category_index &&& ((.0) &&& const 1)) |> unzip |> uncurry (hist sum2d (0, 0) 6) |> maximum_by ((>=) `on` (.1)) |> unwrap_optional |> (.0)I had hoped that the input might get big enough for optimization purposes, but the calculations are likely too simple.
It’s the only possible interpretation left, like with
Spy multiplied by Family(Edit: Typo)
Correct. They haven’t even properly minimized their expression.
Yes it is. It’s not my daily driver but I had just been showing someone the awesome adwaita tab overview.
You can use
:terto open a new terminal buffer in nvim. The window/space management shortcuts for terminal buffers are different, so you may have to look them up.
Yes, not for real.
Apparently some people feel the “haha long hair, must be a grill” too much
I left it because
CW: Nonbinarywas listed as well, thought it may provide some value in that direction. I understand that you think the tag is pointless, should I remove it?
Yes it is. I realized the meme would be confusing because of the switching POVs only after posting it, too late. Happy it was accessible in some way though :]
Like the other commenter noted, in my experience, presenting hyper* is not necessary for this to happen.
I thought this was the correct way to tag since the community rules in the sidebar specifically request CWs for Transfem/Transmasc POVs.
4·3 months agoThanks for posting it! It’s probably exactly what I was searching for.
Futhark
First, formatting the input with an unreadable sed script:
formatting script
1i [ 1,$ { s/^/[/ s/$/], / } $i ] $dThen, 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.
As always, wonky syntax highlighting
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)
This is crazy concise and fast! Impressive.
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 :]
Futhark
As always, futhark does not support arbitrary inputs, so I have a sed script to transform the input to something readable.
input transformer
it produces a textual representation of
[][3]u32, try it on your example or input :]1i [ 1,$ { s/^/[/ s/$/]/ } 2,$i, $i ] $dCalculate 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
Program Source
Basic
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 )
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.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-Script to Transform input for Futhark
i [ s/\([0-9]\+\)-\([0-9]\+\)/\[\1, \2]/g a ]
Futhark
I am on my way to re-do all previous days in Futhark and complete the Rest of AoC, hopefully.
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)Script to Generate input for Futhark
{-# 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
Sorry, what does “clocking someone” mean? I tried to look it up but could only find explanations like: hit someone, especially in the face or alternatively measuring something with a clock/metronome.
From context: Is it related to fooling someone?