Browse Source

Add time traveling code.

colors
Danila Fedorin 1 year ago
parent
commit
841930a8ef
  1. 21
      code/time-traveling/TakeMax.hs
  2. 28
      code/time-traveling/ValueScore.hs

21
code/time-traveling/TakeMax.hs

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

28
code/time-traveling/ValueScore.hs

@ -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…
Cancel
Save