From 7b1b2e96ea53958865466d049e5d5790f52c8fa2 Mon Sep 17 00:00:00 2001
From: Guerric Chupin <guerric.chupin@ensta-paristech.fr>
Date: Mon, 16 May 2016 15:10:24 +0100
Subject: [PATCH 1/1] Some convenience functions.

---
 little_things/Arpeggiated.hs | 15 +++++++++++++
 little_things/AvgInt.hs      | 36 +++++++++++++++++++++++++++++++
 little_things/AvgIvl.hs      | 41 ++++++++++++++++++++++++++++++++++++
 little_things/testAvgInt.hs  | 14 ++++++++++++
 4 files changed, 106 insertions(+)
 create mode 100644 little_things/Arpeggiated.hs
 create mode 100644 little_things/AvgInt.hs
 create mode 100644 little_things/AvgIvl.hs
 create mode 100644 little_things/testAvgInt.hs

diff --git a/little_things/Arpeggiated.hs b/little_things/Arpeggiated.hs
new file mode 100644
index 0000000..9b38270
--- /dev/null
+++ b/little_things/Arpeggiated.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE Arrows #-}
+
+module Arpeggiated where
+
+import FRP.Yampa
+
+import Sound.MIDI.Message as Message
+import Sound.MIDI.Message.Channel as Channel
+import Sound.MIDI.Message.Channel.Voice as Voice
+
+arpeggiated :: SF (Event Voice.T) (Event Voice.T)
+arpeggiated = proc m ->
+  case m of
+    Event m'@(Voice.NoteOn p v) -> returnA -< Event m'
+    _ -> returnA -< NoEvent
diff --git a/little_things/AvgInt.hs b/little_things/AvgInt.hs
new file mode 100644
index 0000000..6456b03
--- /dev/null
+++ b/little_things/AvgInt.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE Arrows #-}
+
+module AvgInt ( avgInt
+              ) where
+
+import FRP.Yampa
+
+intNum :: Int
+intNum = 3
+
+maxTime :: DTime
+maxTime = 10
+
+infinity :: (Fractional a) => a
+infinity = 1/0
+
+-- Outputs the average time between intNum of the last events. Goes to
+-- infinity if less than intNum events have occured or if no event has
+-- occured in maxTime.
+avgInt :: SF (Event a) DTime
+avgInt = avgInt' [] `switch` ((>>^ fst) . avgInt')
+  where avgInt' :: [DTime] -> SF (Event a) (DTime, Event [DTime])
+        avgInt' l = proc e -> do
+          t <- localTime -< ()
+          tooLate <- after maxTime [] -< ()
+          let timeList = (e `tag` (appDTime intNum t l)) `lMerge` tooLate
+          returnA -< (avgS intNum l, timeList)
+
+appDTime :: Int -> Time -> [DTime] -> [DTime]
+appDTime _ _ [] = [0]
+appDTime n t l = (t - head l):(take (n-1) l)
+
+avgS :: (Fractional a) => Int -> [a] -> a
+avgS n l
+  | length l /= n = infinity
+  | otherwise = foldl (+) 0 l / fromIntegral n
diff --git a/little_things/AvgIvl.hs b/little_things/AvgIvl.hs
new file mode 100644
index 0000000..4a88407
--- /dev/null
+++ b/little_things/AvgIvl.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE Arrows #-}
+
+module AvgIvl ( avgIvl
+              ) where
+
+import FRP.Yampa
+
+import Debug.Trace
+
+ivlNum :: Int
+ivlNum = 3
+
+maxTime :: DTime
+maxTime = 5
+
+infinity :: (Fractional a) => a
+infinity = 1/0
+
+-- Outputs the average time between ivlNum of the last events. Goes to
+-- infinity if less than ivlNum events have occured or if no event has
+-- occured in maxTime.
+avgIvl :: SF (Event a) DTime
+avgIvl = switch (constant infinity &&& constant (Event [])) avgIvl'
+  where
+    avgIvl' l = switch avgIvl'' (avgIvl')
+      where  avgIvl'' :: SF (Event a) (DTime, Event [DTime])
+             avgIvl'' = proc e -> do
+               e' <- notYet -< e
+               t <- localTime -< ()
+               tooLate <- after maxTime [] -< ()
+               let timeList = (e' `tag` (appDTime ivlNum t l)) `lMerge` tooLate
+               returnA -< (avgS ivlNum l, timeList)
+
+appDTime :: Int -> Time -> [DTime] -> [DTime]
+appDTime _ _ [] = [0]
+appDTime n t l = t:(take (n-1) l)
+
+avgS :: (Fractional a) => Int -> [a] -> a
+avgS n l
+  | length l /= n = infinity
+  | otherwise = foldl (+) 0 l / fromIntegral n
diff --git a/little_things/testAvgInt.hs b/little_things/testAvgInt.hs
new file mode 100644
index 0000000..909553f
--- /dev/null
+++ b/little_things/testAvgInt.hs
@@ -0,0 +1,14 @@
+import AvgIvl
+
+import FRP.Yampa
+
+basicList :: (Event a, [(DTime, Maybe (Event Int))])
+basicList = (NoEvent,
+             concat $ repeat [ (1,Just (Event 1))
+                             , (1,Just (Event 1))
+                             , (1, Just (Event 1))
+                             , (1, Just (Event 1))
+                             , (1, Just (Event 1))])
+
+randomList :: [DTime]
+randomList = embed avgIvl basicList
-- 
2.47.0