Day 8

2023-09-07 08:20:07 +02:00
parent 4ea7c5329c
commit 89c9c622d1
8 changed files with 442 additions and 3 deletions
--- a/src/Days/D08.hs
+++ b/src/Days/D08.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Days.D08 where
+
+import Common
+
+import Data.ByteString.Char8 qualified as BS
+import Data.ByteString.Unsafe qualified as BS
+import Data.Int
+import Data.Maybe (fromMaybe)
+import Data.Vector.Storable qualified as VS
+import Data.Vector.Storable.Mutable qualified as VSM
+import Foreign qualified as F
+import Foreign.C qualified as FT
+import GHC.IO (unsafePerformIO)
+
+foreign import ccall unsafe "analyze"
+    cAnalyze ::
+        -- | grid
+        FT.CString ->
+        -- | result_visible
+        F.Ptr FT.CBool ->
+        -- | result_fwd
+        F.Ptr Int32 ->
+        -- | result_bwd
+        F.Ptr Int32 ->
+        -- | h
+        Int32 ->
+        -- | w
+        Int32 ->
+        -- | x_stride
+        Int32 ->
+        -- | y_stride
+        Int32 ->
+        IO ()
+
+analyzeHorizontal :: FT.CString -> F.Ptr FT.CBool -> F.Ptr Int32 -> F.Ptr Int32 -> Int32 -> Int32 -> IO ()
+analyzeHorizontal grid vis fwd bwd h w = cAnalyze grid vis fwd bwd h w w 1
+
+analyzeVertical :: FT.CString -> F.Ptr FT.CBool -> F.Ptr Int32 -> F.Ptr Int32 -> Int32 -> Int32 -> IO ()
+analyzeVertical grid vis fwd bwd h w = cAnalyze grid vis fwd bwd h w 1 h
+
+data Intermediate = Intermediate
+    { h :: Int
+    , w :: Int
+    , v :: VS.Vector FT.CBool
+    , u :: VS.Vector Int32
+    , d :: VS.Vector Int32
+    , l :: VS.Vector Int32
+    , r :: VS.Vector Int32
+    }
+    deriving (Show)
+
+process :: BS.ByteString -> Intermediate
+process bs =
+    let
+        w = fromMaybe 0 (BS.elemIndex '\n' bs)
+        h = (BS.length bs + 1) `div` (w + 1)
+        grid = BS.filter (/= '\n') bs
+        gridLen = h * w
+     in
+        unsafePerformIO $ do
+            v <- VSM.new gridLen
+            l <- VSM.unsafeNew gridLen
+            r <- VSM.unsafeNew gridLen
+            u <- VSM.unsafeNew gridLen
+            d <- VSM.unsafeNew gridLen
+
+            BS.unsafeUseAsCString
+                grid
+                ( \gridptr ->
+                    VSM.unsafeWith
+                        v
+                        ( \vptr -> do
+                            VSM.unsafeWith
+                                l
+                                ( \lptr ->
+                                    VSM.unsafeWith
+                                        r
+                                        ( \rptr ->
+                                            analyzeHorizontal
+                                                gridptr
+                                                vptr
+                                                rptr
+                                                lptr
+                                                (fromIntegral h)
+                                                (fromIntegral w)
+                                        )
+                                )
+                            VSM.unsafeWith
+                                d
+                                ( \dptr ->
+                                    VSM.unsafeWith
+                                        u
+                                        ( \uptr ->
+                                            analyzeVertical
+                                                gridptr
+                                                vptr
+                                                dptr
+                                                uptr
+                                                (fromIntegral h)
+                                                (fromIntegral w)
+                                        )
+                                )
+                        )
+                )
+
+            lf <- VS.freeze l
+            rf <- VS.freeze r
+            uf <- VS.freeze u
+            df <- VS.freeze d
+            vf <- VS.freeze v
+
+            return (Intermediate{h = h, w = w, u = uf, d = df, l = lf, r = rf, v = vf})
+
+part1 :: Intermediate -> Int
+part1 (Intermediate{v}) = VS.sum $ VS.map fromIntegral v
+
+part2 :: Intermediate -> Int
+part2 (Intermediate{u, d, l, r}) =
+    fromIntegral
+        . VS.maximum
+        $ VS.zipWith4 (\a1 a2 a3 a4 -> a1 * a2 * a3 * a4) u d l r
+
+day :: Day
+day =
+    ByteStringDay
+        ( \bs ->
+            let ffiResult = process bs
+             in Right (definitive $ part1 ffiResult, definitive $ part2 ffiResult)
+        )