Data commit

Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-1.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE BangPatterns #-}
+
+import Control.Monad
+import Data.List
+import Data.IORef
+
+data Pair a b = Pair !a !b
+
+mean :: Fractional a => [a] -> a
+mean = divl . foldl' (\(Pair s l) x -> Pair (s+x) (l+1)) (Pair 0.0 0)
+  where divl (_,0) = 0.0
+        divl (s,l) = s / fromIntegral l
+
+series = [1,2,3,4,5,5,4,3,2,1]
+
+mkSMA :: Int -> IO (Double -> IO Double)
+mkSMA period = avgr <$> newIORef []
+  where avgr nsref x = readIORef nsref >>= (\ns ->
+            let xs = take period (x:ns)
+            in writeIORef nsref xs $> mean xs)
+
+main = mkSMA 3 >>= (\sma3 -> mkSMA 5 >>= (\sma5 ->
+    mapM_ (str <$> pure n <*> sma3 <*> sma5) series))
+  where str n mm3 mm5 =
+    concat ["Next number = ",show n,", SMA_3 = ",show mm3,", SMA_5 = ",show mm5]

Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-2.hs

@@ -0,0 +1,10 @@
+import Data.List
+import Control.Arrow
+import Control.Monad
+
+sMA p = map (head *** head ).tail.
+      scanl (\(y,_) -> (id &&& return. av) . (: if length y == p then init y else y)) ([],[])
+    where av = liftM2 (/) sum (fromIntegral.length)
+
+printSMA n p = mapM_ (\(n,a) -> putStrLn $ "Next number: " ++ show n ++ "  Average: " ++ show a)
+  . take n . sMA p $ [1..5]++[5,4..1]++[3..]

Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-3.hs

@@ -0,0 +1,26 @@
+import Control.Monad
+import Control.Monad.State
+
+period :: Int
+period = 3
+
+type SMAState = [Float]
+
+computeSMA :: Float -> State SMAState Float
+computeSMA x = do
+  previousValues <- get
+  let values = previousValues ++ [x]
+  let newAverage = if length values <= period then (sum values) / (fromIntegral $ length remainingValues :: Float)
+                   else (sum remainingValues) / (fromIntegral $ length remainingValues :: Float)
+                     where remainingValues = dropIf period values
+  put $ dropIf period values
+  return newAverage
+
+dropIf :: Int -> [a] -> [a]
+dropIf x xs = drop ((length xs) - x) xs
+
+demostrateSMA :: State SMAState [Float]
+demostrateSMA = mapM computeSMA [1, 2, 3, 4, 5, 5, 4, 3, 2, 1]
+
+main :: IO ()
+main = print $ evalState demostrateSMA []