TrendGraph (empty) → 0.1.0.0
raw patch · 8 files changed
+296/−0 lines, 8 filesdep +basedep +containersdep +diagrams-cairosetup-changed
Dependencies added: base, containers, diagrams-cairo, diagrams-lib, mtl, optparse-applicative, time
Files
- Date.hs +27/−0
- FromFiles.hs +15/−0
- LICENSE +1/−0
- Main.hs +60/−0
- Settings.hs +31/−0
- Setup.hs +2/−0
- Trend.hs +138/−0
- TrendGraph.cabal +22/−0
+ Date.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}+++module Date where++import Data.Time+import Data.Time.Clock+import Data.List++months = ["Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"]+++data Date = Date (Int, String, Int)++instance Show Date where+ show (Date(d,m,y)) = show d ++ " " ++ m ++utcToDate :: UTCTime -> Date+utcToDate t = let s = take 10 (show t)+ s' = words $ map (\ c -> if c=='-' then ' ' else c) s+ [y,m,d] = map ( \ t -> read t :: Int) s'+ in Date(d, months !! m, y) ++m=60 :: NominalDiffTime+h=60*m+d=24*h
+ FromFiles.hs view
@@ -0,0 +1,15 @@++module FromFiles where++import Settings++import Data.List+import Data.Time.Clock+++timeListFromString :: String -> [(UTCTime, Double)]+timeListFromString l = map timeI l'+ where l'= lines l+ timeI l = let (fw, lst) = span (/=',') l+ in (read (fw) :: UTCTime, read (tail lst) ::Double)+
+ LICENSE view
@@ -0,0 +1,1 @@+It is public domain so do what you want with it.
+ Main.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}++import Settings+import Trend+import Date+import FromFiles++import Diagrams.Prelude hiding ((<>))+import Diagrams.Backend.Cairo.CmdLine+import Diagrams.Backend.CmdLine+import Diagrams.TwoD.Shapes+import Diagrams.TwoD.Text+import Diagrams.TrailLike+import Options.Applicative++import qualified Data.Map as Map+import Data.List+import Data.Time.Clock++import Control.Monad.Identity+import Control.Monad.Error+import Control.Monad.Reader++import System.IO+import System.Environment+++-- Source file flag:++data Source = Source String++instance Parseable Source where+ parser = Source+ <$> strOption ( long "Source"+ <> metavar "FILE"+ <> help "File that has the info")++points t = map (\ n ->(addUTCTime (n*d) t,timeToDouble n^2)) [0, 1.0 .. 10]++cross = hrule 1 <> vrule 1++setting = Map.empty++graphfromFile src = do file <- openFile src ReadMode+ times <- hGetContents file+ timenum <- return $ timeListFromString times+ case runEnv setting ( graph timenum) of+ (Right s) -> return $ (s <> circle 0.1 # fc red)+ (Left st) -> return $ (circle 1 # fc red)+ +main = mainWith ( \ (Source src) -> graphfromFile src)+++ +{-timelist <- openFile "TestList.txt" ReadMode+ times <- hGetContents timelist+ timenum <- return $ timeListFromString times-}+{-t <- getCurrentTime+ point <- return $ points t-}
+ Settings.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}++module Settings where++import GHC.Read++import Diagrams.Prelude+import Diagrams.Backend.Cairo.CmdLine+import Diagrams.TwoD.Shapes+import Diagrams.TwoD.Text+import Diagrams.TrailLike++import qualified Data.Map as Map+--Convenient Type Versions:++type C = Colour Double++type Di= Diagram B R2++type Setting = String++--Definitions of the settings++data Value = Col C+ | Wdth Double+ | Shape Di+ | Intervalle [Double]+ | Frequency Int++type Choices = Map.Map Setting Value
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Trend.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}++module Trend where++import Settings+import Date++import Diagrams.Prelude+import Diagrams.Backend.Cairo.CmdLine+import Diagrams.TwoD.Shapes+import Diagrams.TwoD.Text+import Diagrams.TrailLike++import qualified Data.Map as Map+import Data.Time.Clock+import Data.List++import Control.Monad.Identity+import Control.Monad.Error+import Control.Monad.Reader++--Convenience:++type C=Colour Double++dot = circle 0.1 # fc black++type UTime = UTCTime++write = text.show++push :: Double -> Double -> Di -> Di+push x y = translate $ r2(x,y)++--Our monad with the error handling+--and reader characteristic:++type Env a = ReaderT Choices (ErrorT String Identity) a++runEnv :: Choices -> Env Di -> Either String Di+runEnv choice a = runIdentity ( runErrorT(runReaderT a choice))++-- We will use Env Di in our functions:++-- These take a list of points+markers :: [P2] -> Env Di+markers l = do m <- ask+ case Map.lookup "markers" m of+ Nothing -> return $ position (zip l (repeat dot))+ Just (Shape s) -> return $ position (zip l (repeat s))+ _ -> throwError " Markers input not a shape"+++drawcurve :: [P2] -> Env Di+drawcurve l = do m <- ask+ curve1 <- case Map.lookup "Curve Width" m of+ Just( Wdth w) -> return $ curve0 # lwO w+ _-> return $ curve0 + case Map.lookup "Curve Colour" m of+ Nothing -> return $ curve1 # lc blue+ Just (Col c) -> return $ curve1 # lc c+ _ -> throwError "Curve Colour not a colour"+ where curve0 = fromVertices l++-- Order:+++order :: [(UTime,Double)] -> [(UTime,Double)]+order l = sortBy (\ (t1,i1) (t2,i2) -> compare t1 t2 ) l++--Avarage difference in time in a list+sumdiff :: [NominalDiffTime] -> NominalDiffTime+sumdiff [] = 0+sumdiff (_:[]) = 0+sumdiff (x1:x2:xs) = (x2-x1)+sumdiff(x2:xs)++meandiff :: [UTCTime] -> NominalDiffTime+meandiff t = sumdiff l / (genericLength l)+ where l = map (\ x -> diffUTCTime x (head t)) t++--Transform time into points++timeToDouble :: NominalDiffTime -> Double+timeToDouble a = realToFrac a++timeToPoint:: [(UTime,Double)] -> [P2]+timeToPoint l = map p2 p+ where l' = order l+ (fi,t) = head l'+ p = map (\ (time,i) -> (f time, i)) l'+ mean = meandiff $ map (\(time,i) -> time) l'+ f time = timeToDouble $ (diffUTCTime time fi )/mean++--+yaxis :: Env Di+yaxis = do m <- ask+ case Map.lookup "Y-axis" m of+ Just (Intervalle l) -> return $ yaxis l <> f' l+ _ -> return $ yaxis ls <> f' ls+ where yaxis l = fromVertices $ map p2 [(0,0),(0, last l)]+ ymark n = hrule 1+ <> write n # push (-3) 0 # pad 1.6+ f n = (p2(0,n),ymark n)+ f' list = position $ map f list+ ls = [0.0 , 20.0 .. 100.0]++xaxis :: [(UTime,Double)] -> Env Di+xaxis t = do m <- ask+ case Map.lookup "XAxisFrequency" m of+ Just(Frequency f) -> return $ axis f+ _-> return $ circle 01 # fc red <> axis 7+ where lnth = length t+ l = timeToPoint $ map projX t+ projX (i,_) = (i,0)+ t' n = indmod n t+ l' n = indmod n l+ xmark c = vrule 1 # pad 1.1+ <> write (utcToDate c) # pad 1.1 # push 0 (-2)+ <> circle 0.1 # fc blue+ m n = map (\ (t,_) -> xmark t) (t' n)+ axis n = position (zip (l' n) (m n))++indmod :: Int -> [a] -> [a]+indmod n list = foldl f [] [0 .. (length list)-1]+ where f xs x = if x `mod` n == 0+ then xs++[list!!x]+ else xs++ +--Combining the previous functions+graph :: [(UTime,Double)] -> Env Di+graph t = do marks <- markers l+ curve <- drawcurve l+ yax <- yaxis+ xax <- xaxis t+ return $ mconcat [marks, curve, yax,xax]+ where l = timeToPoint t
+ TrendGraph.cabal view
@@ -0,0 +1,22 @@+-- Initial TrendGraph.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: TrendGraph+version: 0.1.0.0+synopsis: A simple trend Graph script++description: Mainly a function that takes in list of UTCTime and a double ++license: PublicDomain+license-file: LICENSE+author: Alperen AYDIN+maintainer: aydin.alperen.bugra@gmail.com+-- copyright: +category: Graphics+build-type: Simple+cabal-version: >=1.8++library+ exposed-modules: Date, Settings, Trend, FromFiles, Main+ -- other-modules: + build-depends: base ==4.6.*, time ==1.4.*, diagrams-lib ==1.2.*, diagrams-cairo ==1.2.*, containers ==0.5.*, mtl ==2.1.*, optparse-applicative ==0.9.*