{-|
Module      : Main
Description : Day 8 solution
Copyright   : (c) Eric Mertens, 2022
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2022/day/8>

>>> :main + "30373\n25512\n65332\n33549\n35390\n"
21
8

-}
module Main where

import Data.Array.Unboxed (Ix(inRange, range), UArray, IArray(..), (!))

import Advent (getInputArray, countBy)
import Advent.Coord (above, below, left, right, Coord)

-- |
-- >>> :main
-- 1690
-- 535680
main :: IO ()
IO ()
main =
 do UArray Coord Char
input <- Int -> Int -> IO (UArray Coord Char)
getInputArray Int
2022 Int
08
    Int -> IO ()
forall a. Show a => a -> IO ()
print ((Coord -> Bool) -> [Coord] -> Int
forall (f :: * -> *) a. Foldable f => (a -> Bool) -> f a -> Int
countBy (UArray Coord Char -> Coord -> Bool
isEdgeVisible UArray Coord Char
input) ((Coord, Coord) -> [Coord]
forall a. Ix a => (a, a) -> [a]
range (UArray Coord Char -> (Coord, Coord)
forall i. Ix i => UArray i Char -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Coord Char
input)))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (UArray Coord Char -> Coord -> Int
scenicScore UArray Coord Char
input) ((Coord, Coord) -> [Coord]
forall a. Ix a => (a, a) -> [a]
range (UArray Coord Char -> (Coord, Coord)
forall i. Ix i => UArray i Char -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Coord Char
input))))

-- | Return the list of elements in the array starting
outToEdge ::
    UArray Coord Char {- ^ array -} ->
    Coord             {- ^ starting coordinate -} ->
    (Coord -> Coord)  {- ^ coordinate step function -} ->
    [Char]            {- ^ list of elements out to the edge of the array -}
outToEdge :: UArray Coord Char -> Coord -> (Coord -> Coord) -> [Char]
outToEdge UArray Coord Char
a Coord
c Coord -> Coord
dir = [UArray Coord Char
a UArray Coord Char -> Coord -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coord
i | Coord
i <- (Coord -> Bool) -> [Coord] -> [Coord]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Coord, Coord) -> Coord -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (UArray Coord Char -> (Coord, Coord)
forall i. Ix i => UArray i Char -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Coord Char
a)) ((Coord -> Coord) -> Coord -> [Coord]
forall a. (a -> a) -> a -> [a]
iterate Coord -> Coord
dir Coord
c)]

sightLines ::
    UArray Coord Char {- ^ array -} ->
    Coord             {- ^ starting coordinate -} ->
    [[Char]]          {- ^ list of trees viewed in each cardinal direction -}
sightLines :: UArray Coord Char -> Coord -> [[Char]]
sightLines UArray Coord Char
a Coord
c = ((Coord -> Coord) -> [Char]) -> [Coord -> Coord] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (UArray Coord Char -> Coord -> (Coord -> Coord) -> [Char]
outToEdge UArray Coord Char
a Coord
c) [Coord -> Coord
above,Coord -> Coord
below,Coord -> Coord
left,Coord -> Coord
right]

isEdgeVisible :: UArray Coord Char -> Coord -> Bool
isEdgeVisible :: UArray Coord Char -> Coord -> Bool
isEdgeVisible UArray Coord Char
a Coord
c = ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char] -> Bool
clearView (UArray Coord Char -> Coord -> [[Char]]
sightLines UArray Coord Char
a Coord
c)

clearView :: [Char] -> Bool
clearView :: [Char] -> Bool
clearView [] = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"clearView: empty list"
clearView (Char
x:[Char]
xs) = (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<Char
x) [Char]
xs

scenicScore :: UArray Coord Char -> Coord -> Int
scenicScore :: UArray Coord Char -> Coord -> Int
scenicScore UArray Coord Char
a Coord
c = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
treesSeen (UArray Coord Char -> Coord -> [[Char]]
sightLines UArray Coord Char
a Coord
c))

treesSeen :: [Char] -> Int
treesSeen :: [Char] -> Int
treesSeen [] = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"treesSeen: empty list"
treesSeen (Char
x:[Char]
xs) =
    case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
x) [Char]
xs of
        ([Char]
a,[])  -> [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
a
        ([Char]
a,Char
_:[Char]
_) -> [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1