Skip to content
Permalink
Fetching contributors…
Cannot retrieve contributors at this time
41 lines (34 sloc) 1.3 KB
-- | Dynamic programming solution
module BeautifulBridges.DP where
import Data.List as List
import Data.Maybe (catMaybes)
import Data.Vector ((!))
import qualified Data.Vector as V
import Safe.Foldable (minimumMay)
beautifulBridges :: [(Int, Int)] -> Int -> Int -> Int -> Maybe Int
beautifulBridges ground h α β = V.head memo
where
ground' = V.fromList ground
memo = V.map bestFor . V.indexed . V.fromList . drop 1 $ List.tails ground
bestFor (i, xys)
| i == V.length ground' - 1 = Just*(h-y))
| otherwise = minimumMay . catMaybes $ go [] i (i+1) 0 (2*(h-y)) xys
where (_,y) = ground' ! i
go r i j inf sup = \case
[] -> r
((x',y'): xys)
| dx >= inf' && dx <= sup' ->
let c = fmap (+ cost i x') (memo ! j)
in go (c:r) i (j+1) inf' sup' xys
| inf' > sup' || dx > sup' -> r
| otherwise -> go r i (j+1) inf' sup' xys
where
(x,_) = ground' ! i
(dx,dy) = (x'-x, h-y')
inf' = if dy*2 > dx then inf else max inf (r1 - floor r2)
sup' = min sup (r1 + floor r2)
-- r1±r2 are the roots of (x-dx)^2 + (x-dy)^2 = x^2.
(r1,r2) = (2*(dx+dy), sqrt(fromIntegral (8*dx*dy) :: Double))
cost i x' = α*(h-y) + β*d*d
where (x,y) = ground' ! i
d = x'-x
You can’t perform that action at this time.