Skip to content
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.