Add time traveling code.

This commit is contained in:
Danila Fedorin 2020-07-30 00:57:47 -07:00
parent 9b37e496cb
commit 841930a8ef
2 changed files with 49 additions and 0 deletions

View File

@ -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')

View File

@ -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