AoC 2023HEADmain

1 files changed, 52 insertions, 0 deletions

diff --git a/2023/day05/Main2.hs b/2023/day05/Main2.hs
new file mode 100644
index 0000000..3a57caa
--- /dev/null
+++ b/2023/day05/Main2.hs
@@ -0,0 +1,52 @@
+import Data.List.Split
+import Data.List
+import Data.Maybe
+
+windows :: [a] -> [[a]]
+windows = filter (\xs -> length xs == 2) . map (take 2) . tails
+
+genBetweens :: [[Int]] -> [[Int]]
+genBetweens section = map (\[[dl, sl, rl], [du, su, ru]] -> [sl + rl, sl + rl, su + ru - sl]) (windows section)
+
+-- 79 14
+--
+-- 50 98 2
+-- 52 50 48
+sectionToRange :: [Int] -> [Int] -> [Int]
+sectionToRange [d,s,r] [start,range] 
+  | begin <= s + r - 1 && end >= s = [d + (begin - s), end - begin + 1]
+  | otherwise = [start, range]
+  where 
+    begin = max start s
+    end = min (start+range -1) (s+r-1)
+
+toMapFn :: [[Int]] -> [[Int]] -> [[Int]]
+toMapFn section seedPairs = nub $ filter (/= []) $ concat $ map (\f -> (map (f) seedPairs)) (map (sectionToRange) section) 
+
+main :: IO ()
+main = do
+  lines <- lines <$> getContents
+
+  let sections = splitOn [""] lines
+  let seeds = map read $ tail $ splitOn [' '] (sections!!0!!0) :: [Int]
+  let seedPairs = chunksOf 2 seeds
+
+  let maps = map (\(_:xs) -> (map (\l -> map (\i -> (read i) :: Int) (splitOn [' '] l)) xs)) (tail sections)
+  let mapsBetweens = map (\x -> [0, 0, (x!!0!!2 -1)] ++ mapBetweens map ++ maps ++ [(last x)!!1 + (last x)!!2, (last x)!!1 + (last x)!!2, (maxBound :: Int) - (last x)!!1 + (last x)!!2] ) maps
+  let myMapFns = map (toMapFn) maps
+  let myFn = foldr (.) id (reverse myMapFns)
+
+  let seedRanges = concat $ map (\seedPair -> myFn [seedPair]) seedPairs
+
+  print ((myMapFns!!0) [seedPairs!!0])
+  -- print ((myMapFns!!1) ((myMapFns!!0) [seedPairs!!0]))
+  -- print ((myFn) [seedPairs!!0])
+  -- print ((map (head) ((myFn) [seedPairs!!0])))
+  -- print ((map (head) ((myFn) [seedPairs!!0])))
+  -- print seedRanges
+  -- print ((map (\[start, range] -> start) seedRanges))
+  -- print (minimum (map (\[start, range] -> start) seedRanges))
+
+
+  -- mapM_ putStrLn lines
+