Files
aoc-2022/src/Days/D08.hs
2023-09-23 07:55:47 +02:00

132 lines
4.2 KiB
Haskell

{-# 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.unsafeFreeze l
rf <- VS.unsafeFreeze r
uf <- VS.unsafeFreeze u
df <- VS.unsafeFreeze d
vf <- VS.unsafeFreeze 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)
)