parent
9b37e496cb
commit
841930a8ef
@ -0,0 +1,21 @@ |
||||
takeUntilMax :: [Int] -> Int -> (Int, [Int]) |
||||
takeUntilMax [] m = (m, []) |
||||
takeUntilMax [x] _ = (x, [x]) |
||||
takeUntilMax (x:xs) m |
||||
| x == m = (x, [x]) |
||||
| otherwise = |
||||
let (m', xs') = takeUntilMax xs m |
||||
in (max m' x, x:xs') |
||||
|
||||
doTakeUntilMax :: [Int] -> [Int] |
||||
doTakeUntilMax l = l' |
||||
where (m, l') = takeUntilMax l m |
||||
|
||||
takeUntilMax' :: [Int] -> Int -> (Int, [Int]) |
||||
takeUntilMax' [] m = (m, []) |
||||
takeUntilMax' [x] _ = (x, [x]) |
||||
takeUntilMax' (x:xs) m |
||||
| x == m = (maximum (x:xs), [x]) |
||||
| otherwise = |
||||
let (m', xs') = takeUntilMax' xs m |
||||
in (max m' x, x:xs') |
@ -0,0 +1,28 @@ |
||||
import Data.Map as Map |
||||
import Data.Maybe |
||||
import Control.Applicative |
||||
|
||||
data Element = A | B | C | D |
||||
deriving (Eq, Ord, Show) |
||||
|
||||
addElement :: Element -> Map Element Int -> Map Element Int |
||||
addElement = alter ((<|> Just 1) . fmap (+1)) |
||||
|
||||
getScore :: Element -> Map Element Int -> Float |
||||
getScore e m = fromMaybe 1.0 $ ((1.0/) . fromIntegral) <$> Map.lookup e m |
||||
|
||||
data BinaryTree a = Empty | Node a (BinaryTree a) (BinaryTree a) deriving Show |
||||
type ElementTree = BinaryTree Element |
||||
type ScoredElementTree = BinaryTree (Element, Float) |
||||
|
||||
assignScores :: ElementTree -> Map Element Int -> (Map Element Int, ScoredElementTree) |
||||
assignScores Empty m = (Map.empty, Empty) |
||||
assignScores (Node e t1 t2) m = (m', Node (e, getScore e m) t1' t2') |
||||
where |
||||
(m1, t1') = assignScores t1 m |
||||
(m2, t2') = assignScores t2 m |
||||
m' = addElement e $ unionWith (+) m1 m2 |
||||
|
||||
doAssignScores :: ElementTree -> ScoredElementTree |
||||
doAssignScores t = t' |
||||
where (m, t') = assignScores t m |
Loading…
Reference in new issue