packages feed

raft (empty) → 0.3.2.2

raw patch · 32 files changed

+3131/−0 lines, 32 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, binary, bytestring, containers, data-default, ghc-prim, mtl, scientific, split, text, time, tostring, zlib

Files

+ LICENSE view
@@ -0,0 +1,8 @@+"raft"+Copyright (c) 2005-16 Brian W Bush++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ raft.cabal view
@@ -0,0 +1,72 @@+name              : raft+version           : 0.3.2.2+synopsis          : Miscellaneous Haskell utilities for data structures and data manipulation.+description       : This Haskell library contains miscellaneous data structures and data manipulation functions for general uses.++license           : MIT+license-file      : LICENSE+author            : Brian W Bush <consult@brianwbush.info>+maintainer        : Brian W Bush <consult@brianwbush.info>+copyright         : (c) 2005-16 Brian W Bush+category          : Data+stability         : Experimental+build-type        : Simple+cabal-version     : >= 1.10+homepage          : https://bitbucket.org/functionally/raft+bug-reports       : https://bwbush.atlassian.net/projects/HRAFT/issues/+package-url       : https://bitbucket.org/functionally/raft/downloads/raft-0.3.2.2.tar.gz++source-repository head+  type            : mercurial+  location        : https://bitbucket.org/functionally/raft+ +library+  exposed-modules : Control.Monad.Except.Util+                    Data.Aeson.Util+                    Data.Attoparsec.Util+                    Data.Color.Util+                    Data.Default.Util+                    Data.EdgeTree+                    Data.Functor.Util+                    Data.Function.Excel+                    Data.Function.Finance+                    Data.Function.Tabulated+                    Data.Function.Util+                    Data.List.Util+                    Data.List.Util.Listable+                    Data.Maybe.Util+                    Data.Relational+                    Data.Relational.Lists+                    Data.Relational.Value+                    Data.String.Util+                    Data.Table+                    Data.Table.Identifier+                    Data.Tabular+                    Data.Time.Util+                    Data.Tuple.Util+                    Math.Fractions+                    Math.GeometricSeries+                    Math.Monad+                    Math.Roots+                    Math.Roots.Bisection+                    Math.Series+  hs-source-dirs  : src+  build-depends   : base         >= 4.8 && < 5+                  , aeson        >= 0.11.2+                  , attoparsec   >= 0.13.0+                  , binary       >= 0.7.5+                  , bytestring   >= 0.10.6+                  , containers   >= 0.5.6+                  , data-default >= 0.7.1+                  , ghc-prim     >= 0.4.0+                  , mtl          >= 2.2.1+                  , scientific   >= 0.3.3+                  , split        >= 0.2.2+                  , text         >= 1.2.1+                  , time         >= 1.5.0+                  , tostring     >= 0.2.1+                  , zlib         >= 0.5.4+  exposed         : True+  buildable       : True+  ghc-options     : -Wall+  default-language: Haskell2010
+ src/Control/Monad/Except/Util.hs view
@@ -0,0 +1,46 @@+-----------------------------------------------------------------------------+--+-- Module      :  Control.Monad.Except.Util+-- Copyright   :  (c) 2016 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Utilities related to the <https://hackage.haskell.org/package/mtl mtl> package.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Control.Monad.Except.Util (+-- * Assertions+  assert+, deny+-- * Input/Output+, tryIO+) where+++import Control.Exception (IOException, try)+import Control.Monad (unless, when)+import Control.Monad.Except (MonadError, MonadIO, liftIO, throwError)+import Data.String (IsString(..))+++-- | Attempt an IO action.+tryIO :: (IsString e, MonadError e m, MonadIO m) => IO a -> m a+tryIO = (>>= either (\e -> throwError . fromString $ show (e :: IOException)) return) . liftIO . try+++-- | Make an assertion.+assert :: (IsString e, MonadError e m) => e -> Bool -> m ()+assert = flip unless . throwError+++-- | Make a denial.+deny :: (IsString e, MonadError e m) => e -> Bool -> m ()+deny = flip when . throwError
+ src/Data/Aeson/Util.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Aeson.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Utilities related to the <https://hackage.haskell.org/package/aeson aeson> package.+--+-----------------------------------------------------------------------------+++module Data.Aeson.Util (+-- * Utilities+  extractMaybe+, extract+) where+++import Data.Aeson.Types (FromJSON(..), Value, (.:), parseMaybe, withObject)+import Data.Maybe (fromJust)+import Data.Text (pack)+++-- | Extract a value.+extractMaybe :: FromJSON a+             => String  -- ^ The object key.+             -> Value   -- ^ The object from which to extract the value.+             -> Maybe a -- ^ The value.+extractMaybe label = parseMaybe (withObject ("extract " ++ label) (.: pack label))+++-- | Extract a value.+extract :: FromJSON a+        => String -- ^ The object key.+        -> Value  -- ^ The object from which to extract the value.+        -> a      -- ^ The value.+extract = (fromJust .) . extractMaybe
+ src/Data/Attoparsec/Util.hs view
@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Attoparsec.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Utilities related to the <https://hackage.haskell.org/package/attoparsec attoparsec> package.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe          #-}+{-# LANGUAGE TupleSections #-}+++module Data.Attoparsec.Util (+  double'+) where+++import Control.Applicative ((<|>), many)+import Data.Attoparsec.Text (Parser, char, digit, inClass, many1, satisfy, space)+++-- | Parse a double.+double' :: Parser Double+double' = many space *> parseSigned parseFloat'+++parseSigned :: Real a => Parser a -> Parser a+parseSigned p = (negate <$> (char '-' *> p)) <|> p+++parseFloat' :: (RealFrac a) => Parser a+parseFloat' =+  do+    (x, y) <-+      ((,) <$> many1 digit) <* char '.' <*> many digit+      <|>+      (("0", ) <$ char '.' <*> many1 digit)+      <|>+      ((, "") <$> many1 digit)+    expo <-+      (satisfy (inClass "eE")+        *> (+          (char '+' *> many1 digit)+          <|>+          (((:) <$> char '-') <*> many1 digit)+          <|>+          many1 digit)+      )+      <|>+      return "0"+    return+      $ fromRational+      $ toInt (x ++ y) * 10^^(toInt' expo - length y)+++toInt :: RealFrac a => String -> a+toInt = fromIntegral . toInt'+++toInt' ::String -> Int+toInt' = read
+ src/Data/Color/Util.hs view
@@ -0,0 +1,110 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Color.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Functions for manipulating colors.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Safe          #-}+++module Data.Color.Util (+-- * Types+  RGB(..)+-- * Functions+, hsvToRgb+, rgbToHsv+, byteColor+) where+++import Data.Word (Word8)+import GHC.Generics (Generic)+++-- | A color triplet of red, green, and blue intensity.+data RGB = RGB+  {+    red   :: !Word8+  , green :: !Word8+  , blue  :: !Word8+  }+    deriving (Eq, Generic, Ord, Read, Show)+++-- | Convert a hue, saturation, value triplet to a red, green, blue one.  Source: <http://www.cs.rit.edu/~ncs/color/t_convert.html>.+hsvToRgb :: (Double, Double, Double) -> RGB+hsvToRgb (h, s, v) =+  let+    scale = floor . (255 *)+    rgb r g b = RGB (scale r) (scale g) (scale b)+  in+    if s == 0+      then+        rgb v v v+      else+        let+          h' = h / 60+          i :: Int+          i = floor h'+          f = h' - fromIntegral i+          p = v * (1 - s)+          q = v * (1 - s * f)+          t = v * (1 - s * (1 - f))+        in+          case i of+            0 -> rgb v t p+            1 -> rgb q v p+            2 -> rgb p v t+            3 -> rgb p q v+            4 -> rgb t p v+            5 -> rgb v p q+            _ -> undefined+++-- | Convert a red, green, blue triplet to a hue, saturation, value one.  Source: <http://www.cs.rit.edu/~ncs/color/t_convert.html>.+rgbToHsv :: RGB -> (Double, Double, Double)+rgbToHsv (RGB r g b) =+  let+    r' = fromIntegral r :: Double+    g' = fromIntegral g :: Double+    b' = fromIntegral b :: Double+    min' = minimum [r', g', b']+    max' = maximum [r', g', b']+    v = max'+    delta = max' - min'+  in+    if max' == 0+      then (0, 0, 0)+      else+        let+          s = delta / max'+          h = 60 *+            if r' == max'+              then (g' - b') / delta+              else+                if g' == max'+                  then 2 + (b' - r') / delta+                  else 4 + (r' - g') / delta+          h' =+            if h < 0+              then h + 360+              else h+        in+          (h', s, v)+++-- | Scale a colour to a byte.+byteColor ::+     Double  -- ^ The color intensity, in the range [0, 1].+  -> Word8   -- ^ The color intensity, in the range [0, 255].+byteColor = floor . (255 *)
+ src/Data/Default/Util.hs view
@@ -0,0 +1,47 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Default.Util+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Default numeric values.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Default.Util (+-- * Classes+  Zero(..)+-- * Values+, nan+, inf+, infNegative+) where+++-- | Class for zero values.+class Zero a where+  -- | The zero value.+  zero :: a+++-- | Not a number.+nan :: RealFloat a => a+nan = realToFrac (read "NaN" :: Double)+++-- | Positive infinity.+inf :: RealFloat a => a+inf = realToFrac (read "Infinity" :: Double)+++-- | Negative infinity.+infNegative :: RealFloat a => a+infNegative = realToFrac (read "-Infinity" :: Double)
+ src/Data/EdgeTree.hs view
@@ -0,0 +1,290 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.EdgeTree+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Trees with data on vertices and edges.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.EdgeTree (+-- * Types+  EdgeTree(..)+, TreeEdge(..)+-- * Functions+, createEdgeTree+, filterEdgeTree+, filterEdgeTree'+, mapEdgeTree+, mapEdgeTree'+, mapTop+, truncateEdgeTree+-- * Input/output+, putEdgeForest+, hPutEdgeForest+, putEdgeTree+, putEdgeTree'+, hPutEdgeTree+, hPutEdgeTree'+, putTreeEdge'+, hPutTreeEdge'+) where+++import System.IO (Handle, hPutStrLn, stdout)+++-- | A tree with data at the vertex and edges radiating from it.+data EdgeTree e v =+  EdgeTree {+    vertex :: v+  , edges :: [TreeEdge e v]+  }+    deriving (Read, Show)++instance Functor (EdgeTree e) where+  fmap f (EdgeTree v ee) = EdgeTree (f v) (map (fmap f) ee)++instance Foldable (EdgeTree e) where+  foldMap f (EdgeTree v []) = f v+  foldMap f (EdgeTree v ee) = mconcat (f v : map (foldMap f) ee)++-- TODO: The edgle labels are foldable, too.++instance Traversable (EdgeTree e) where+  traverse f (EdgeTree v ee) =+        EdgeTree+    <$> f v+    <*> sequenceA (map (traverse f) ee)+++-- | An edge with data and connecting to a tree.+data TreeEdge e v =+  TreeEdge {+    edge :: e+  , target :: EdgeTree e v+  }+    deriving (Read, Show)++instance Functor (TreeEdge e) where+  fmap f (TreeEdge e t) = TreeEdge e (fmap f t)++instance Foldable (TreeEdge e) where+  foldMap f (TreeEdge _ t) = foldMap f t++instance Traversable (TreeEdge e) where+  traverse f (TreeEdge e t) =+        TreeEdge e+    <$> traverse f t+++-- | Create a tree.+createEdgeTree ::+     (a -> v)     -- ^ Function for labelling vertices.+  -> (a -> e)     -- ^ Function for labelling edges.+  -> (a -> [a])   -- ^ Function for generating objects radiating from the starting object.+  -> a            -- ^ The starting objects.+  -> EdgeTree e v -- ^ The tree.+createEdgeTree vertexLabeller edgeLabeller generator start =+  EdgeTree {+    vertex = vertexLabeller start+  , edges = map (createTreeEdge vertexLabeller edgeLabeller generator) $ generator start+  }+++-- | Create an edge.+createTreeEdge ::+     (a -> v)     -- ^ Function for labelling vertices.+  -> (a -> e)     -- ^ Function for labelling edges.+  -> (a -> [a])   -- ^ Function for generating objects radiating from the starting object.+  -> a            -- ^ The starting objects.+  -> TreeEdge e v -- ^ The tree.+createTreeEdge vertexLabeller edgeLabeller generator start =+  TreeEdge {+    edge = edgeLabeller start+  , target = createEdgeTree vertexLabeller edgeLabeller generator start+  }+++-- | Filter a tree.+filterEdgeTree ::+     ((v, e, v) -> Bool) -- ^ Function for filtering based on vertex-edge-vertex labelling.+  -> EdgeTree e v        -- ^ The tree.+  -> EdgeTree e v        -- ^ The filtered tree.+filterEdgeTree f edgeTree@(EdgeTree v ee) =+  edgeTree {+    edges = map filterTreeEdge $ filter filterVertex ee+  }+    where+      filterVertex (TreeEdge e (EdgeTree v' _)) = f (v, e, v')+      filterTreeEdge treeEdge@(TreeEdge _ t) = treeEdge {target = filterEdgeTree f t}+++-- | Filter a tree.+filterEdgeTree' ::+     (v -> e -> Bool) -- ^ Function for filtering based on vextex-edge labelling.+  -> EdgeTree e v     -- ^ The tree.+  -> EdgeTree e v     -- ^ The filtered tree.+filterEdgeTree' = filterEdgeTree . uncurry2of3+++-- | Evaluate a function on vertices of a tree.+mapEdgeTree ::+     ((v, e, v) -> w) -- ^ Function for evaluating vertex-edge-vertex triplets.+  -> w                -- ^ The new value for the root of the tree.+  -> EdgeTree e v     -- ^ The tree.+  -> EdgeTree e w     -- ^ The transformed tree.+mapEdgeTree f start (EdgeTree v ee) =+  EdgeTree {+    vertex = start+  , edges = map mapTreeEdge ee+  }+    where+      mapTreeEdge treeEdge@(TreeEdge e t@(EdgeTree v' _)) =+        treeEdge {+          target = mapEdgeTree f (f (v, e, v')) t+        }+++-- | Evaluate a function on vertices of a tree.+mapEdgeTree' ::+     (v -> e -> w) -- ^ Function for evaluating vertex-edge-vertex triplets.+  -> w             -- ^ The new value for the root of the tree.+  -> EdgeTree e v  -- ^ The tree.+  -> EdgeTree e w  -- ^ The transformed tree.+mapEdgeTree' = mapEdgeTree . uncurry2of3+++-- | Uncurry the first two elements of a triplet.+uncurry2of3 :: (a -> b -> d) -> (a, b, c) -> d+uncurry2of3 f (x, y, _) = f x y+++-- | Apply a function to the first subtrees.+mapTop :: (EdgeTree e v -> a) -> EdgeTree e v -> [(e, a)]+mapTop f (EdgeTree _ edges') = map (\(TreeEdge edge' target') -> (edge', f target')) edges'+++-- | Truncate a tree at a particular depth.+truncateEdgeTree :: Int -> EdgeTree e v -> EdgeTree e v+truncateEdgeTree 0 (EdgeTree vertex' _) = EdgeTree vertex' []+truncateEdgeTree n (EdgeTree vertex' edges') = EdgeTree vertex' $ map (truncateTreeEdge (n - 1)) edges'+++-- | Truncate a tree at a particular depth.+truncateTreeEdge :: Int -> TreeEdge e v -> TreeEdge e v+truncateTreeEdge n (TreeEdge edge' target') = TreeEdge edge' $ truncateEdgeTree n target'+++-- | Print a forest.+putEdgeForest ::+     Int                 -- ^ How many levels to print.+  -> (a -> String)       -- ^ Function for rendering the label for a tree.+  -> (v -> String)       -- ^ Function for rendering vertex labels.+  -> (e -> String)       -- ^ Function for rendering edge labels.+  -> [(a, EdgeTree e v)] -- ^ The forest.+  -> IO ()               -- ^ The action for printing the forest.+putEdgeForest = hPutEdgeForest stdout+++-- | Print a forest.+hPutEdgeForest ::+     Handle              -- ^ Where to print the forest.+  -> Int                 -- ^ How many levels to print.+  -> (a -> String)       -- ^ Function for rendering the label for a tree.+  -> (v -> String)       -- ^ Function for rendering vertex labels.+  -> (e -> String)       -- ^ Function for rendering edge labels.+  -> [(a, EdgeTree e v)] -- ^ The forest.+  -> IO ()               -- ^ The action for printing the forest.+hPutEdgeForest handle depth showGroup showVertex showEdge =+  do+    let+      putGroup (group, edgeTree) =+        do+          hPutStrLn handle $ showGroup group+          hPutEdgeTree' handle depth ". " showVertex showEdge edgeTree+    mapM_ putGroup+++-- | Print a tree.+putEdgeTree ::+     Int           -- ^ How many levels to print.+  -> (v -> String) -- ^ Function for rendering vertex labels.+  -> (e -> String) -- ^ Function for rendering edge labels.+  -> EdgeTree e v  -- ^ The tree.+  -> IO ()         -- ^ The action for printing the tree.+putEdgeTree = hPutEdgeTree stdout+++-- | Print a tree.+putEdgeTree' ::+     Int           -- ^ How many levels to print.+  -> String        -- ^ The string for indentation, which will be prefixed to each line output.+  -> (v -> String) -- ^ Function for rendering vertex labels.+  -> (e -> String) -- ^ Function for rendering edge labels.+  -> EdgeTree e v  -- ^ The tree.+  -> IO ()         -- ^ The action for printing the tree.+putEdgeTree' = hPutEdgeTree' stdout+++-- | Print a tree.+hPutEdgeTree ::+     Handle        -- ^ Where to print the tree.+  -> Int           -- ^ How many levels to print.+  -> (v -> String) -- ^ Function for rendering vertex labels.+  -> (e -> String) -- ^ Function for rendering edge labels.+  -> EdgeTree e v  -- ^ The tree.+  -> IO ()         -- ^ The action for printing the tree.+hPutEdgeTree = flip flip "" . hPutEdgeTree'+++-- | Print a tree.+hPutEdgeTree' ::+     Handle        -- ^ Where to print the tree.+  -> Int           -- ^ How many levels to print.+  -> String        -- ^ The string for indentation, which will be prefixed to each line output.+  -> (v -> String) -- ^ Function for rendering vertex labels.+  -> (e -> String) -- ^ Function for rendering edge labels.+  -> EdgeTree e v  -- ^ The tree.+  -> IO ()         -- ^ The action for printing the tree.+hPutEdgeTree' handle depth indent showVertex showEdge (EdgeTree v ee) =+  do+    hPutStrLn handle $ indent ++ showVertex v+    mapM_ (hPutTreeEdge' handle depth (indent ++ ". ") showVertex showEdge) ee+++-- | Print an edge.+putTreeEdge' ::+     Int           -- ^ How many levels to print.+  -> String        -- ^ The string for indentation, which will be prefixed to each line output.+  -> (v -> String) -- ^ Function for rendering vertex labels.+  -> (e -> String) -- ^ Function for rendering edge labels.+  -> TreeEdge e v  -- ^ The edge.+  -> IO ()         -- ^ THe action for printing the edge.+putTreeEdge' = hPutTreeEdge' stdout+++-- | Print an edge.+hPutTreeEdge' ::+     Handle        -- ^ Where to print the tree.+  -> Int           -- ^ How many levels to print.+  -> String        -- ^ The string for indentation, which will be prefixed to each line output.+  -> (v -> String) -- ^ Function for rendering vertex labels.+  -> (e -> String) -- ^ Function for rendering edge labels.+  -> TreeEdge e v  -- ^ The edge.+  -> IO ()         -- ^ THe action for printing the edge.+hPutTreeEdge' handle depth indent showVertex showEdge (TreeEdge e t) =+  do+    hPutStrLn handle $ indent ++ showEdge e+    if depth > 0+      then hPutEdgeTree' handle (depth - 1) (indent ++ ". ") showVertex showEdge t+      else hPutStrLn handle $ indent ++ ". <<TRUNCATED>>"
+ src/Data/Function/Excel.hs view
@@ -0,0 +1,119 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Function.Excel+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Several Microsoft Excel functions, adapted from <https://gist.github.com/econ-r/dcd503815bbb271484ff>.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe                        #-}++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+++module Data.Function.Excel (+-- * Finance functions+  pmt+, ipmt+, ppmt+, nper+, pv+, fv+) where+++import Data.Maybe (fromMaybe)+++-- | Compute payments.+pmt :: Double       -- ^ Interest rate per period.+    -> Int          -- ^ Total number of periods.+    -> Double       -- ^ Present value.+    -> Maybe Double -- ^ Future value.+    -> Maybe Bool   -- ^ Whether payments are due at the beginning of each perioed.+    -> Double       -- ^ Payment per period.+pmt rate nper pv fv typ =+  if rate /= 0 +    then (rate * (fv' + pv * (1+ rate)^nper)) / ((1 + rate * typ') * (1 - (1 + rate)^nper))+    else  -1 * (fv' + pv) / fromIntegral nper+    where+      fv' = fromMaybe 0 fv+      typ' = if fromMaybe False typ then 1 else 0+++-- | Compute interest payment.+ipmt :: Double       -- ^ Interest rate per period.+     -> Int          -- ^ Period for which interest is to be computed.+     -> Int          -- ^ Total number of periods.+     -> Double       -- ^ Present value.+     -> Maybe Double -- ^ Future value.+     -> Maybe Bool   -- ^ Whether payments are due at the beginning of each period.+     -> Double       -- ^ Interest payment.+ipmt rate per nper pv fv (Just True) = ipmt rate per nper pv fv (Just False) / (1 + rate)+ipmt rate per nper pv fv _ = - ((1 + rate)^(per-1) * (pv * rate + pmt rate nper pv fv (Just False)) - pmt rate nper pv fv (Just False))+++-- | Compute principle payment.+ppmt :: Double       -- ^ Interest rate per period.+     -> Int          -- ^ Period for which interest is to be computed.+     -> Int          -- ^ Total number of periods.+     -> Double       -- ^ Present value.+     -> Maybe Double -- ^ Future value.+     -> Maybe Bool   -- ^ Whether payments are due at the beginning of each period.+     -> Double       -- ^ Interest payment. +ppmt rate per nper pv fv typ = pmt rate nper pv fv typ - ipmt rate per nper pv fv typ+++-- | Number of periods for an investment.+nper :: Double       -- ^ Interest rate per period.+     -> Double       -- ^ Payment per period.+     -> Double       -- ^ Present value.+     -> Maybe Double -- ^ Future value.+     -> Maybe Bool   -- ^ Whether payments are due at the beginning of each period.+     -> Double       -- ^ Number of periods.+nper rate pmt pv fv typ =+  if rate /= 0+    then logBase (1 + rate) ((pmt * (1 + rate * typ') - fv' * rate) / (pmt * (1 + rate * typ') + pv * rate))+    else - (fv' + pv) / pmt+    where+      fv' = fromMaybe 0 fv+      typ' = if fromMaybe False typ then 1 else 0+++-- | Compute prevent value.+pv :: Double       -- ^ Interest rate per period.+   -> Int          -- ^ Total number of periods.+   -> Double       -- ^ Payment per period.+   -> Maybe Double -- ^ Future value.+   -> Maybe Bool   -- ^ Whether payments are due at the beginning of each period.+   -> Double       -- ^ Present value.+pv rate nper pmt fv typ =+  if rate /= 0+    then - (fv' + pmt * (1 + rate * typ') * (((1 + rate)^nper) - 1) / rate) / (1 + rate)^nper+    else - (fv' + pmt * fromIntegral nper)+    where+      fv' = fromMaybe 0 fv+      typ' = if fromMaybe False typ then 1 else 0+++-- | Compute future value.+fv :: Double       -- ^ Interest rate per period.+   -> Int          -- ^ Total number of periods.+   -> Double       -- ^ Payment per period.+   -> Maybe Double -- ^ Present value.+   -> Maybe Bool   -- ^ Whether payments are due at the beginning of each period.+   -> Double       -- ^ Future value.+fv rate nper pmt pv typ =+  if rate /= 0+    then (pmt * (1 + rate * typ') * (1 - (1 + rate)^nper) / rate) - pv' * (1 + rate)^nper+    else - (pv' + pmt * fromIntegral nper)+    where+      pv' = fromMaybe 0 pv+      typ' = if fromMaybe False typ then 1 else 0
+ src/Data/Function/Finance.hs view
@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Function.Finance+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Financial functions.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Function.Finance (+-- * Financial functions+  netPresentValue+, internalRateOfReturn+, capitalRecoveryFactor+) where+++import Math.Roots (bracket)+import Math.Roots.Bisection (findRoot)+++-- | Compute the net present value of a series of values.+netPresentValue :: (Fractional a, Num a) =>+     a   -- ^ The rate per period.+  -> [a] -- ^ The values at the end of the periods.+  -> a   -- ^ The net present value.+netPresentValue _ [] = 0+netPresentValue rate (x : xs) = (x + netPresentValue rate xs) / (1 + rate)+++-- | Compute the internal rate of return for a series of values.+internalRateOfReturn :: (Fractional a, Num a, Ord a) =>+     [a]              -- ^ The values at the end of the periods.+  -> Either String a  -- ^ The rate per period that yields a zero net present value.+internalRateOfReturn x+  | null x                    = return 0+  | minimum x * maximum x > 0 = Left "Both negative and positive values must be present."+  | otherwise                 =+    do+      let+        f = flip netPresentValue x+      xs <- bracket 100 f (0, 10)+      findRoot 100 1e-8 f xs+++-- | Compute a capital recovery factor.+capitalRecoveryFactor :: (Floating a, Real b) =>+     a -- ^ The interest rate.+  -> b -- ^ The lifetime of the capital.+  -> a -- ^ The capital recovery factor.+capitalRecoveryFactor interestRate lifetime =+  interestRate+  * (1 + interestRate)**lifetime'+  / ((1 + interestRate)**lifetime' - 1)+    where+      lifetime' = fromRational $ toRational lifetime
+ src/Data/Function/Tabulated.hs view
@@ -0,0 +1,167 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Function.Tabulated+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Data tables that behave as functions.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Function.Tabulated {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- * One dimension+  DomainFunction1(..)+, TabulatedFunction1(..)+, TabulatedFunctionImpl1+-- * Two dimensions+, DomainFunction2(..)+, TabulatedFunction2(..)+, TabulatedFunctionImpl2+-- * Three dimensions+, DomainFunction3(..)+, TabulatedFunction3(..)+, TabulatedFunctionImpl3+) where+++import Data.List (nub, sort)+import Data.Tuple.Util (curry3, fst3, snd3, trd3)++import qualified Data.Map as M+++-- | Class for functions of one variable, supported on a particular domain.+class DomainFunction1 t where+  -- | The domain of the function.+  domain1 :: Ord a+          => t a   -- ^ The function.+          -> [a]   -- ^ The domain.+  -- | Evaluate the function.+  evaluate1 :: Ord a+            => t a          -- ^ The function.+            -> a            -- ^ The argument.+            -> Maybe Double -- ^ The result, if the function is defined for the argument.+++-- | Class for tabulated functions of one variable.+class DomainFunction1 t => TabulatedFunction1 t where+  -- | Make a tabulated function from a table.+  fromTable1 :: Ord a+             => [(a, Double)] -- The table.+             -> t a           -- The tabulated function.+  -- | Make a tabulated function for a generating function and a list of values.+  fromUnTable1 :: Ord a+               => (b -> (a, Double)) -- ^ The generating function.+               -> [b]                -- ^ The domain for tabulation.+               -> t a                -- ^ The tabulated function.+  fromUnTable1 = (fromTable1 .) . map+++-- | Implementation of a tabulated function of one variable.+data TabulatedFunctionImpl1 a = TabulatedFunctionImpl1 [a] (M.Map a Double)+  deriving Show++instance DomainFunction1 TabulatedFunctionImpl1 where+  domain1 (TabulatedFunctionImpl1 d _) = d+  evaluate1 (TabulatedFunctionImpl1 _ m) = flip M.lookup m++instance TabulatedFunction1 TabulatedFunctionImpl1 where+  fromTable1 x =+    TabulatedFunctionImpl1+      (sort $ nub $ map fst x)+      (M.fromList x)+++-- | Class for functions of two variables, supported on a particular domain.+class DomainFunction2 t where+  -- | The domain of the function.+  domain2 :: (Ord a, Ord b)+          => t a b          -- ^ The function.+          -> ([a], [b])     -- ^ The domain.+  -- | Evaluate the function.+  evaluate2 :: (Ord a, Ord b)+            => t a b          -- ^ The function.+            -> a              -- ^ The first argument.+            -> b              -- ^ The second argument.+            -> Maybe Double   -- ^ The result, if the function is defined for the arguments.+++-- | Class for tabulated functions of two variables.+class DomainFunction2 t => TabulatedFunction2 t where+  -- | Make a tabulated function from a table.+  fromTable2 :: (Ord a, Ord b)+             => [((a, b), Double)] -- ^ The table.+             -> t a b              -- ^ The tabulated function.+  -- | Make a tabulated function for a generating function and a list of values.+  fromUnTable2 :: (Ord a, Ord b)+               => (c -> ((a, b), Double)) -- ^ The generating function.+               -> [c]                     -- ^ The domain for tabulation.+               -> t a b                   -- ^ The tabulated function.+  fromUnTable2 = (fromTable2 .) . map+++-- | Implementation of a tabulated function of two variables.+data TabulatedFunctionImpl2 a b = TabulatedFunctionImpl2 ([a], [b]) (M.Map (a, b) Double)+  deriving Show++instance DomainFunction2 TabulatedFunctionImpl2 where+  domain2 (TabulatedFunctionImpl2 d _) = d+  evaluate2 (TabulatedFunctionImpl2 _ m) = curry (`M.lookup` m)++instance TabulatedFunction2 TabulatedFunctionImpl2 where+  fromTable2 x =+    TabulatedFunctionImpl2+      (sort $ nub $ map (fst . fst) x, sort $ nub $ map (snd . fst) x)+      (M.fromList x)+++-- | Class for functions of three variables, +class DomainFunction3 t where+  -- | The domain of the function.+  domain3 :: (Ord a, Ord b, Ord c)+          => t a b c               -- ^ The function.+          -> ([a], [b], [c])       -- ^ The domain.+  -- | Evaluate the function.+  evaluate3 :: (Ord a, Ord b, Ord c)+            => t a b c             -- ^ The function.+             -> a                  -- ^ The first argument.+             -> b                  -- ^ The second argument.+             -> c                  -- ^ The third argument.+             -> Maybe Double       -- ^ The result, if the function is defined for the arguments.+++-- | Class for tabulated functions of two variables.+class DomainFunction3 t => TabulatedFunction3 t where+  -- | Make a tabulated function from a table.+  fromTable3 :: (Ord a, Ord b, Ord c)+             => [((a, b, c), Double)] -- ^ The table.+             -> t a b c               -- ^ The tabulated function.+  -- | Make a tabulated function for a generating function and a list of values.+  fromUnTable3 :: (Ord a, Ord b, Ord c)+               => (d -> ((a, b, c), Double)) -- ^ The generating function.+               -> [d]                        -- ^ The domain for the tabulation.+               -> t a b c                    -- ^ THe tabulated function.+  fromUnTable3 = (fromTable3 .) . map+++-- | Implementation of a tabulated function of three variables.+data TabulatedFunctionImpl3 a b c = TabulatedFunctionImpl3 ([a], [b], [c]) (M.Map (a, b, c) Double)+  deriving Show++instance DomainFunction3 TabulatedFunctionImpl3 where+  domain3 (TabulatedFunctionImpl3 d _) = d+  evaluate3 (TabulatedFunctionImpl3 _ m) = curry3 (`M.lookup` m)++instance TabulatedFunction3 TabulatedFunctionImpl3 where+  fromTable3 x =+    TabulatedFunctionImpl3+      (sort $ nub $ map (fst3 . fst) x, sort $ nub $ map (snd3 . fst) x, sort $ nub $ map (trd3 . fst) x)+      (M.fromList x)
+ src/Data/Function/Util.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Function.Util+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Utilities related to "Data.Function".+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Function.Util (+-- * Constant boolean functions+  always+, never+-- * Functions on second entries in pairs+, sndNegater+, sndCounter+, sndSummer+) where+++import Control.Arrow (second)+++-- | Always true.+always :: a -> Bool+always = const True+++-- | Always false.+never :: a -> Bool+never = const False+++-- | Negate the second entry in a pair.+sndNegater :: Num b => (a, b) -> (a, b)+sndNegater = second negate+++-- | Measure the length of the second entry in a pair.+sndCounter :: (a, [b]) -> (a, Int)+sndCounter = second length+++-- | Sum the values of the second entry in a pair.+sndSummer :: Num b => (a, [b]) -> (a, b)+sndSummer = second sum
+ src/Data/Functor/Util.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Functor.Util+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Utilities related to "Data.Functor".+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Functor.Util (+-- * Utilities+  cast+) where+++-- | Apply 'Data.Functor.fmap' twice.+cast :: (Functor f, Functor g)+     => (a -> b) -- ^ The function to be applied.+     -> f (g a)  -- ^ The nested functors.+     -> f (g b)  -- ^ The resulting nested functors.+cast = fmap . fmap
+ src/Data/List/Util.hs view
@@ -0,0 +1,351 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.List.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Unstable+-- Portability :  Portable+--+-- | Miscellaneous functions for manipulating lists.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.List.Util (+-- * Subsets+  hasSubset+, disjoint+, replaceByFst+, noDuplicates+, sameElements+, notDuplicatedIn+, deleteOn+, maybeList+-- * Permutations+, elemPermutation+-- * Grouping and sorting+, groupOn+, nubOn+, sortOn+, sortedGroups+, sortedGroupsOn+, regroup+, regroupBy+-- * Bounded enumerations.+, domain+-- * Permutations.+, powerSet+, powerSetPermutations+, uniquePowerSetPermutations+, suffixes+-- * Monads.+, nest+-- * Mapping.+, map2+, zipf+-- * Lookups.+, lookupWithDefault+, lookupWithDefaultFunction+-- * Padding, stripping, and pruning.+, padHead+, padTail+, chunk+, stripHead+, discardEnds+, removeDuplicates+, removeDuplicatesBy+, extract+, rollback+-- * Splitting.+, splitAtMatches+, splitAround+) where+++import Control.Arrow ((&&&))+import Control.Monad (filterM)+import Data.Function (on)+import Data.List ((\\), deleteBy, deleteFirstsBy, elemIndex, groupBy, intersect, nub, nubBy, permutations, sort, sortBy, tails)+import Data.List.Split (chunksOf, wordsBy)+import Data.Maybe (fromMaybe)+++-- | Test for containment.+hasSubset :: Eq a+          => [a]  -- ^ The potential superset.+          -> [a]  -- ^ The potential subset+          -> Bool -- ^ Whether the first set has the second as a subset.+hasSubset x y = null $ y \\ x+++-- | Test for disjointness.+disjoint :: Eq a+         => [a]  -- ^ The first set.+         -> [a]  -- ^ The second set.+         -> Bool -- ^ Whether the sets are disjoint.+disjoint x y = null $ x `intersect` y+++-- | Replace the first occurrence in a lookup table.+replaceByFst :: Eq a+             => (a, b)   -- ^ The replacement key and value.+             -> [(a, b)] -- ^ The lookup table.+             -> [(a, b)] -- ^ The updated table.+replaceByFst x = (x :) . deleteBy ((==) `on` fst) x+++-- | Test for duplicates.+noDuplicates :: Eq a+             => [a]  -- ^ The list.+             -> Bool -- ^ Whether the list does not contain duplicates.+noDuplicates x = length x == length (nub x)+++-- | Test for same elements.+sameElements :: Ord a+             => [a]  -- ^ The first list.+             -> [a]  -- ^ The second list.+             -> Bool -- ^ Whether the lists have the same elements.+sameElements x y = sort x == sort y+++-- | Test for membership of an element in a list.+notDuplicatedIn :: Eq b+                => (a -> b) -- ^ The equality test.+                -> a        -- ^ The value.+                -> [a]      -- ^ The list.+                -> Bool     -- ^ Whether the value is in the list.+notDuplicatedIn f x ys = f x `notElem` map f ys+++-- | Delete using a function to extract values.+deleteOn :: Eq b => (a -> b) -> a -> [a] -> [a]+deleteOn f = deleteBy ((==) `on` f)+++-- | Lift a non-empty list.+maybeList :: [a] -> Maybe [a]+maybeList [] = Nothing+maybeList xs = Just xs+++-- | Find the permutation of one list relative to another.+elemPermutation :: Eq a => [a] -> [a] -> Maybe [Int]+elemPermutation = mapM . flip elemIndex+++-- | Group using a function to extract values.+groupOn :: Eq b => (a -> b) -> [a] -> [[a]]+groupOn f = groupBy ((==) `on` f) +++-- | Nub using a function to extract values.+nubOn :: Eq b => (a -> b) -> [a] -> [a]+nubOn f = nubBy ((==) `on` f)+++-- | Sort using a function to extract values.+sortOn :: Ord b => (a -> b) -> [a] -> [a]+sortOn f = sortBy (compare `on` f)+++-- | Sort and group.+sortedGroups :: Ord b => [(b, c)] -> [(b, [c])]+sortedGroups = sortedGroupsOn fst snd +++-- | Sort and group using a function to extract values.+sortedGroupsOn :: Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]+sortedGroupsOn f g =+  fmap ((f . head) &&& fmap g)+    . groupOn f+    . sortOn f+++-- | Ordered list of values in a bounded enumeration.+domain :: (Bounded a, Enum a) => [a]+domain = [minBound..maxBound]+++-- | Generate a power set.  The algorithm used here is from <http://evan-tech.livejournal.com/220036.html>.+powerSet :: [a] -> [[a]]+powerSet = filterM (const domain)+++-- | Generate a power set's permutations.+powerSetPermutations :: [a] -> [[a]]+powerSetPermutations = concatMap permutations . powerSet+++-- | Generate a power set's unique permutations.+uniquePowerSetPermutations :: Eq a => [a] -> [[a]]+uniquePowerSetPermutations = nub . powerSetPermutations+++-- | A list of suffixes of another list.+suffixes :: [a] -> [[a]]+suffixes = init . tails+++-- | Move a monad inside a list.+nest :: Monad m => [a] -> [m a]+nest = map return+++-- | Map at the second level.+map2 :: (a -> b) -> [[a]] -> [[b]]+map2 = map . map+++-- | The 'zipf' function applies a list of functions to corresponding elements in a list.+zipf :: [a -> b] -- ^ The list of functions to be applied+     -> [a]      -- ^ The list of elements to which the functions will be applied+     -> [b]      -- ^ The result of the function applications+zipf (f:fs) (x:xs) = f x : zipf fs xs+zipf _ _ = []+++-- | Look up a value in an association list.+lookupWithDefault :: Eq a =>+     b        -- ^ The default value.+  -> a        -- ^ The key.+  -> [(a, b)] -- ^ The associations.+  -> b        -- ^ The value for the key, or the default if the key is not present.+lookupWithDefault y = lookupWithDefaultFunction (const y)+++-- | Look up a value in an association list.+lookupWithDefaultFunction :: Eq a =>+     (a -> b) -- ^ The function for generating the default value.+  -> a        -- ^ The key.+  -> [(a, b)] -- ^ The associations.+  -> b        -- ^ The value for the key, or the default if the key is not present.+lookupWithDefaultFunction f x = fromMaybe (f x) . lookup x+++-- | Pad the head of a list.+padHead ::+     Int -- ^ Length of result.+  -> a   -- ^ Item to use for padding.+  -> [a] -- ^ The list.+  -> [a] -- ^ The padded list.+padHead n y xs =+  replicate (n - length xs) y ++ xs+++-- | Pad the tail of a list.+padTail ::+     Int -- ^ Length of the result.+  -> a   -- ^ Item to use for padding.+  -> [a] -- ^ The list.+  -> [a] -- ^ THe padded list.+padTail n y xs =+  xs ++ replicate (n - length xs) y+++-- | Break a list into equally sized chunks.+chunk ::+     Int   -- ^ Length of the chunks.+  -> [a]   -- ^ The list.+  -> [[a]] -- ^ The chunked list.+chunk = chunksOf+{-# DEPRECATED chunk "Use 'Data.List.Split.chunksOf' instead." #-}+++-- | Remove leading items from a list.+stripHead :: Eq a =>+     a   -- ^ The item to remove from the start of list.+  -> [a] -- ^ The list.+  -> [a] -- ^ The list without the leading items.+stripHead x y@(ye : ys)+  | x == ye   = stripHead x ys+  | otherwise = y+stripHead _ [] = []+++-- | The 'discard' function removes the first and last elements from a list. +discardEnds :: [a] -- ^ The list+            -> [a] -- ^ The interior of the list+discardEnds = init . tail+++-- | Remove duplicates from a list, maintaining its order.+removeDuplicates :: Eq a => [a] -> [a]+removeDuplicates = removeDuplicatesBy (==)+++-- | Remove duplicates from a list, maintaining its order.+removeDuplicatesBy ::+     (a -> a -> Bool) -- ^ Equality test function.+  -> [a]              -- ^ The list.+  -> [a]              -- ^ The list with duplicates removed.+removeDuplicatesBy equals x =+  let+    duplicates = nubBy equals (deleteFirstsBy equals x (nubBy equals x))+  in+    deleteFirstsBy equals (nubBy equals x) duplicates+++-- | Extract one element from a list.+extract :: (a -> Bool) -> [a] -> ([a], Maybe a)+extract _ [] = ([], Nothing)+extract p x =+  let+    extract' a @ (_, _, Just _) = a+    extract' a @ (_, [], Nothing) = a+    extract' (y', ze : zs, Nothing)+      | p ze = (y', zs, Just ze)+      | otherwise = extract' (ze : y', zs, Nothing)+    (y, z, w) = extract' ([], x, Nothing)+  in+    (rollback y z, w)+++-- | Reverse a first list and add it to a second one.+rollback ::+      [a] -- ^ The list to be reversed and prepended.+   -> [a] -- ^ The list to be appended.+   -> [a] -- ^ The resulting list+rollback = flip (foldl (flip (:)))+++-- | Split up a list at every match of a particular item.+splitAtMatches :: Eq a =>+     a     -- ^ The separatrix.+  -> [a]   -- ^ The list.+  -> [[a]] -- ^ The split list.+splitAtMatches = wordsBy . (==)+{-# DEPRECATED splitAtMatches "Use 'Data.List.Split.wordsBy' instead." #-}+++-- | Split a list around a particular element.+splitAround :: Int -> [a] -> ([a], a, [a])+splitAround n x =+  let+    (y, z) = splitAt (n + 1) x+  in+    (init y, last y, z)+++-- | Sort and regroup elements of an association using its keys.+regroup :: Ord a => [(a, b)] -> [(a, [b])]+regroup = regroupBy id+++-- | Sort and regroup elements of an association using its keys.+regroupBy :: Ord a =>+     ([b] -> c) -- ^ The function for summarizing the second element of pairs.+  -> [(a, b)]   -- ^ The associations.+  -> [(a, c)]   -- ^ The regrouped associations.+regroupBy f =+  let+    sorter (x, _) (y, _) = compare x y+    grouper x y = fst x == fst y+    crusher ys = (fst $ head ys, f $ map snd ys)+  in+    map crusher . groupBy grouper . sortBy sorter
+ src/Data/List/Util/Listable.hs view
@@ -0,0 +1,251 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.List.Util.Listable+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | For CSV-like and TSV-like data.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE Safe                   #-}+++module Data.List.Util.Listable (+-- * Tabbed Strings+  tab+, fromTabbed+, toTabbed+, fromTabbeds+, toTabbeds+-- * Converting to/from Lists+, Listable(..)+, fromStringList+, toStringList+, fromTabbedList+, toTabbedList+, fromStringLists+, toStringLists+, fromTabbedLists+, toTabbedLists+, fromTransposedTabbedLists+, toTransposedTabbedLists+-- * Dealing with Headers+, WithHeader(..)+, fromStringListsWithHeader+, toStringListsWithHeader+, fromTabbedListsWithHeader+, toTabbedListsWithHeader+, readTabbedListsWithHeader+, writeTabbedListsWithHeader+, fromTransposedTabbedListsWithHeader+, toTransposedTabbedListsWithHeader+, readTransposedTabbedListsWithHeader+, writeTransposedTabbedListsWithHeader+) where+++import Control.Applicative (liftA2)+import Control.Arrow ((&&&))+import Data.List (intercalate, transpose)+import Data.List.Split (splitOn)+import Data.String.Util (Stringy(..))+++-- | Tab character.+tab :: String+tab = "\t"+++-- | Separate a tabbed string.+fromTabbed :: String   -- ^ The tabbed strings.+           -> [String] -- ^ The strings between the tabs.+fromTabbed = splitOn tab+++-- | Intercalate tabs between strings.+toTabbed :: [String] -- ^ The strings.+         -> String   -- ^ The intercalated string.+toTabbed = intercalate tab+++-- | Separate lines and tabs.+fromTabbeds :: String     -- ^ The string.+            -> [[String]] -- ^ The lines and strings between tabs.+fromTabbeds = fmap fromTabbed . lines+++-- | Intercalte lines and tabs.+toTabbeds :: [[String]] -- ^ The lines and strings between tabs.+          -> String     -- ^ The intercalated string.+toTabbeds = unlines . fmap toTabbed+++-- | Class for conversion to/from lists.+class Listable a b | a -> b where+  -- | Convert from a list.+  fromList :: [b] -- ^ The list of values.+           -> a   -- ^ The combined value.+  -- | Convert to a list.+  toList :: a   -- ^ The value.+         -> [b] -- ^ THe list of values.+++-- | Convert from a list of strings.+fromStringList :: (Listable a b, Stringy b)+               => [String]                  -- ^ The strings.+               -> a                         -- ^ The value.+fromStringList = fromList . fmap fromString+++-- | Convert to a list of strings.+toStringList :: (Listable a b, Stringy b)+             => a                         -- ^ The value.+             -> [String]                  -- ^ The strings.+toStringList = fmap toString . toList+++-- | Convert from a tabbed lines.+fromTabbedList :: (Listable a b, Stringy b)+               => String                    -- ^ The tabbed list.+               -> a                         -- ^ The value.+fromTabbedList = fromStringList . fromTabbed+++-- | Convert to a tabbed lines.+toTabbedList :: (Listable a b, Stringy b)+             => a                         -- ^ The value.+             -> String                    -- ^ The tabbed string.+toTabbedList = toTabbed . toStringList+++-- | Convert from a list of strings.+fromStringLists :: (Listable a b, Listable b c, Stringy c)+                => [[String]]                              -- ^ The lists of strings.+                -> a                                       -- ^ The value.+fromStringLists = fromList . fmap fromStringList+++-- | Convert to a list of strings.+toStringLists :: (Listable a b, Listable b c, Stringy c)+              => a                                       -- ^ The value.+              -> [[String]]                              -- ^ The lists of strings.+toStringLists = fmap toStringList . toList+++-- | Convert from tabbed lines.+fromTabbedLists :: (Listable a b, Listable b c, Stringy c)+   => String                                               -- ^ The tabbed lines.+    -> a                                                   -- ^ The value.+fromTabbedLists = fromStringLists . fromTabbeds+++-- | Convert to tabbed lines.+toTabbedLists :: (Listable a b, Listable b c, Stringy c)+              => a                                       -- ^ The value.+              -> String                                  -- ^ The tabbed lines.+toTabbedLists = toTabbeds . toStringLists+++-- | Convert from transposed tabbed lines.+fromTransposedTabbedLists :: (Listable a b, Listable b c, Stringy c)+                          => String                                  -- ^ The tranposed tabbed lines.+                          -> a                                       -- ^ The value.+fromTransposedTabbedLists = fromStringLists . transpose . fromTabbeds+++-- | Convert to transposed tabbed lines.+toTransposedTabbedLists :: (Listable a b, Listable b c, Stringy c)+                        => a                                       -- ^ The value.+                        -> String                                  -- ^ The transposed tabbed lines.+toTransposedTabbedLists = toTabbeds . transpose . toStringLists+++-- | Class for lists of strings with a headers.+class WithHeader a b | a -> b where+  -- | Convert from a list of values with headers.+  fromHeaderLists :: ([String], [b]) -- ^ The headers and values.+                  -> a               -- ^ The combined value.+  -- | Convert to a list of values with headers.+  toHeaderLists :: a               -- ^ The combined value.+                -> ([String], [b]) -- ^ The headers and values.+++-- | Convert from lists of strings with a header.+fromStringListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                          => [[String]]                                -- ^ The lists of strings.+                          -> a                                         -- ^ The value.+fromStringListsWithHeader = fromHeaderLists . (head &&& fmap fromStringList . tail)+++-- | Convert to lists of strings with a header.+toStringListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                        => a                                         -- ^ The value.+                        -> [[String]]                                -- ^ The lists of strings.+toStringListsWithHeader = liftA2 (:) fst (fmap toStringList . snd) . toHeaderLists+++-- | Convert from lines with a header.+fromTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                          => String                                    -- ^ The  lines.+                          -> a                                         -- ^ The value.+fromTabbedListsWithHeader = fromStringListsWithHeader . fromTabbeds+++-- | Convert to  lines with a header.+toTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                        => a                                         -- ^ The value.+                        -> String                                    -- ^ The  lines.+toTabbedListsWithHeader = toTabbeds . toStringListsWithHeader+++-- | Read  lines with a header.+readTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                          => FilePath                                  -- ^ The file.+                          -> IO a                                      -- ^ Action for reading the value.+readTabbedListsWithHeader = fmap fromTabbedListsWithHeader . readFile+++-- | Write  lines with a header.+writeTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                           => FilePath                                  -- ^ The file path.+                           -> a                                         -- ^ The value.+                           -> IO ()                                     -- ^ The action for writing the value.+writeTabbedListsWithHeader = (. toTabbedListsWithHeader) . writeFile+++-- | Convert from tabbed lines with a header.+fromTransposedTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                                    => String                                    -- ^ The tabbed lines.+                                    -> a                                         -- ^ The value.+fromTransposedTabbedListsWithHeader = fromStringListsWithHeader . transpose . fromTabbeds+++-- | Convert to tabbed lines with a header.+toTransposedTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                                  => a                                         -- ^ The value.+                                  -> String                                    -- ^ The tabbed lines.+toTransposedTabbedListsWithHeader = toTabbeds . transpose . toStringListsWithHeader+++-- | Read tabbed lines with a header.+readTransposedTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                                    => FilePath                                  -- ^ The file path.+                                    -> IO a                                      -- ^ Action for reading the value.+readTransposedTabbedListsWithHeader = fmap fromTransposedTabbedListsWithHeader . readFile+++-- | Write tabbed lines with a header.+writeTransposedTabbedListsWithHeader :: (WithHeader a b, Listable b c, Stringy c)+                                     => FilePath                                  -- ^ The file path.+                                     -> a                                         -- ^ The value.+                                     -> IO ()                                     -- ^ The action for writing the value.+writeTransposedTabbedListsWithHeader = (. toTransposedTabbedListsWithHeader) . writeFile
+ src/Data/Maybe/Util.hs view
@@ -0,0 +1,32 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Maybe.Util+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Utility functions for 'Data.Maybe.Maybe'.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Maybe.Util (+-- * Utilities+  maybeRead+) where+++import Data.Maybe (listToMaybe)+++-- | Maybe read a value.+maybeRead :: Read a+          => String  -- ^ The string.+          -> Maybe a -- ^ The value, if it could be parsed.+maybeRead = fmap fst . listToMaybe . reads
+ src/Data/Relational.hs view
@@ -0,0 +1,80 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Relational+-- Copyright   :  (c) 2015-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Tuples and relations.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE UndecidableInstances   #-}++{-# OPTIONS_GHC -fno-warn-orphans   #-}+++module Data.Relational {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- * Classes+  Tuple(..)+, Relation(..)+) where+++import Control.Applicative (liftA2)+import Control.Arrow ((&&&))+import Data.List.Util.Listable (Listable(..), WithHeader(..))+import Data.Maybe (fromMaybe)+import Data.String.Util (Stringy(..))+++-- | Class for tuples.+class Tuple t where++  -- | Type for attributes.+  type Attribute t :: *++  -- | Make a tuple.+  makeTuple :: [Attribute t] -> t++  -- | Retrieve attributes.+  attributes :: t -> [Attribute t]++instance (Attribute t ~ a, Tuple t) => Listable t a where +  fromList = makeTuple+  toList = attributes+++-- | Class for relations.+class Tuple t => Relation n t r | r -> t, r -> n where++  -- | Names for tuples.+  names :: r -> [n]++  -- | An empty relation.+  empty :: [n] -> r++  -- | Make a relation.+  makeRelation :: [n] -> [t] -> r++  -- | Retrieve tuples.+  tuples :: r -> [t]++  -- | Lookup an attribute.+  attributeMaybe :: r -> n -> t -> Maybe (Attribute t)++  -- | Lookup an attribute.+  attribute :: r -> n -> t -> Attribute t+  attribute = ((fromMaybe (error "Attribute missing from relation.") .) .) . attributeMaybe++instance (Relation n t r, Stringy n) => WithHeader r t where+  fromHeaderLists = liftA2 makeRelation (fmap fromString . fst) snd+  toHeaderLists = (fmap toString . names) &&& tuples
+ src/Data/Relational/Lists.hs view
@@ -0,0 +1,151 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Relational.Lists+-- Copyright   :  (c) 2015-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Tuples and relations as lists.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UndecidableInstances      #-}++{-# OPTIONS_GHC -fno-warn-deprecations #-}+++module Data.Relational.Lists {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- * Types+  Tabulation+, Record(..)+, Table(..)+-- * Input/Output+, readTable+, writeTable+, makeTable+) where+++import Control.Monad (guard, msum)+import Data.Binary (Binary(..))+import Data.Default (Default(..))+import Data.List (union)+import Data.List.Util.Listable (readTabbedListsWithHeader, writeTabbedListsWithHeader)+import Data.String.Util (Stringy)+import Data.Relational (Relation(..), Tuple(..))+++-- | A tabulation.+type Tabulation a = Table (Record a)+++-- | A record.+newtype Record a = Record {unRecord :: [a]}+  deriving (Eq, Read, Show)++instance Tuple (Record a) where+  type Attribute (Record a) = a+  makeTuple = Record+  attributes = unRecord++instance Functor Record where+  fmap f = Record . fmap f . unRecord++instance Foldable Record where+  foldMap f = foldMap f . unRecord++instance Binary a => Binary (Record a) where+  put = put . unRecord +  get = Record <$> get+++-- | A table.+data Table r =+  Table+  {+    header  :: [String] -- ^ The header.+  , records :: [r]      -- ^ The records.+  }++instance Tuple r => Relation String r (Table r) where+  names = header+  empty = flip Table []+  makeRelation = Table+  tuples = records+  attributeMaybe Table{..} name =+    msum+      . zipWith (\n a -> guard (n == name) >> return a) header+      . attributes++instance Functor Table where+  fmap f Table{..} =+    Table header $ fmap f records++instance Foldable Table where+  foldMap f Table{..} =+    foldMap f records++instance (Monoid (Attribute r), Tuple r) => Monoid (Table r) where+  mempty = Table [] []+  mappend x y =+    let+      header' = header x `union` header y+      makePadder ns =+        let+          pattern = map (`elem` ns) header'+          pad (False : us)      vs  = mempty : pad us vs+          pad (True  : us) (v : vs) = v      : pad us vs+          pad []           _        = []+          pad _            []       = []+        in+          makeTuple . pad pattern . attributes+    in+      Table header' $ map (makePadder $ header x) (records x) ++ map (makePadder $ header y) (records y)++instance (Read (Attribute r), Tuple r) => Read (Table r) where+  readsPrec p =+    readParen (p > 10)+      $ \ r -> do+        ("fromLists", s) <- lex r+        (ns, t) <- reads s+        (rs, u) <- reads t+        return (Table ns $ map makeTuple rs, u)++instance (Show (Attribute r), Tuple r) => Show (Table r) where+  show Table{..} = "fromLists " ++ show header ++ " " ++ show (map attributes records)++instance Binary r => Binary (Table r) where+  put Table{..} = put (header, records)+  get = uncurry Table <$> get+++-- | Read a table.+readTable :: (Stringy (Attribute r), Tuple r)+          => FilePath                         -- ^ The file path.+          -> IO (Table r)                     -- ^ Action to read the table.+readTable = readTabbedListsWithHeader+++-- | Write a table.+writeTable :: (Stringy (Attribute r), Tuple r)+           => FilePath                         -- ^ The file path.+           -> Table r                          -- ^ The table.+           -> IO ()                            -- ^ Action to write the table.+writeTable = writeTabbedListsWithHeader+++-- | Make a table.+makeTable :: forall r . (Default (Table r), Tuple r)+          => [r]                                     -- ^ The records.+          -> Table r                                 -- ^ The table.+makeTable = makeRelation (header (def :: Table r))
+ src/Data/Relational/Value.hs view
@@ -0,0 +1,125 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Relational.Value+-- Copyright   :  (c) 2015-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | 'Data.Aeson.Types.Value' from <https://hackage.haskell.org/package/aeson aeson> for use in tuples and relations.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE TypeFamilies              #-}++{-# OPTIONS_GHC -fno-warn-deprecations #-}+++module Data.Relational.Value {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- Types+  Value(..)+-- Functions+, asValue+, valueAsRealFloat+, asRealFloat+, valueAsString+, string+, number+, number'+, enum+, valueAsEnum+, readTable+, writeTable+) where+++import Control.Applicative ((<|>))+import Data.Aeson.Types (ToJSON(..), Value(..))+import Data.Default.Util (nan)+import Data.Maybe (fromMaybe)+import Data.Maybe.Util (maybeRead)+import Data.Relational (Tuple(..))+import Data.Relational.Lists (Table(..), Tabulation)+import Data.Scientific (fromFloatDigits)+import Data.Text (pack, unpack)++import qualified Data.Relational.Lists as Lists (readTable, writeTable)+++-- | Read a value.+asValue :: String -- ^ The string.+        -> Value  -- ^ The value.+asValue s =+  let+    n = if null s then Just Null else Nothing+    b = toJSON <$> (maybeRead s :: Maybe Bool)+    x = toJSON <$> (maybeRead s :: Maybe Double) +  in+    fromMaybe (toJSON s) $ n <|> b <|> x+++-- | Convert a numeric value.+valueAsRealFloat :: RealFloat a => Value -> a+valueAsRealFloat (Number x) = realToFrac x+valueAsRealFloat _          = nan+++-- | Read a numeric value.+asRealFloat :: (RealFloat a, Read a) => String -> a+asRealFloat = fromMaybe nan . maybeRead+++-- | Convert to a string value.+valueAsString :: Value -> String+valueAsString Null       = ""+valueAsString (Bool b  ) = show b+valueAsString (Number x) = show x+valueAsString (String s) = unpack s+valueAsString x          = show x+++-- | Convert a string to a value.+string :: String -> Value+string = String . pack+++-- | Convert a number to a value.+number :: RealFloat a => a -> Value+number = Number . fromFloatDigits+++-- | Convert a number to a value.+number' :: String -> Value+number' = number . (read :: String -> Double)+++-- | Convert an enumeration to a value.+enum :: (Enum a, Show a) => a -> Value+enum = string . show+++-- | Convert a value to an enumeration.+valueAsEnum :: (Enum a, Read a) => Value -> a+valueAsEnum = read . valueAsString+++-- | Read a table.+readTable :: (Attribute r ~ Value, Tuple r)+          => FilePath                       -- ^ The file path.+          -> IO (Table r)                   -- ^ Action to read the table.+readTable path =+  fmap (makeTuple . fmap asValue . attributes) +    <$> (Lists.readTable path :: IO (Tabulation String))+++-- | Write a table.+writeTable :: (Attribute r ~ Value, Tuple r)+           => FilePath                       -- ^ The file path.+           -> Table r                        -- ^ The table.+           -> IO ()                          -- ^ Action to write the table.+writeTable path x =+  Lists.writeTable path+    (fmap (makeTuple . fmap valueAsString . attributes) x :: Tabulation String)
+ src/Data/String/Util.hs view
@@ -0,0 +1,93 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.String.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Unstable+-- Portability :  Portable+--+-- | Utilities related to 'Data.String.String'.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE EmptyDataDecls         #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverloadedStrings      #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE UndecidableInstances   #-}+++module Data.String.Util (+-- * Classes+  Stringy(..)+-- * Functions+, readExcept+, maybeString+) where+++import Control.Monad.Except (MonadError, throwError)+import Data.String (IsString)+import Data.String.ToString (ToString)++import qualified Data.String as S (IsString(..))+import qualified Data.String.ToString as S (ToString(..))+++-- | Read a string or return a message that it cannot be parsed.+readExcept :: (ToString s, IsString e, MonadError e m, Read a) => s -> m a+readExcept x =+  let+    x' = S.toString x+  in+    case reads x' of+      [(result, [])] -> return result+      _              -> throwError . S.fromString $ "failed to parse \"" ++ x' ++ "\""+++-- | Lift a non-empty string.+maybeString :: (Eq a, IsString a) => a -> Maybe a+maybeString s+  | s == ""   = Nothing+  | otherwise = Just s+++-- | Class for stringlike values that can be read and shown.+class (Read a, Show a) => Stringy a where+  -- | Convert to a string.+  toString   :: a      -- ^ The value.+             -> String -- ^ The string.+  -- | Convert from a string.+  fromString :: String -- ^ The string.+             -> a      -- ^ The value.++instance (Predicate a ~ flag, Printable flag a, Read a, Show a) => Stringy a where+  toString   = toString'   (undefined :: flag)+  fromString = fromString' (undefined :: flag)+++class Printable flag a where+  toString'   :: Show a => flag -> a -> String+  fromString' :: Read a => flag -> String -> a++instance Printable IsStringy String where+  toString'   _ = id+  fromString' _ = id+  +instance Printable NotStringy a where+  toString'   _ = show+  fromString' _ = read+++data IsStringy+data NotStringy+++type family Predicate a where+  Predicate String = IsStringy+  Predicate a      = NotStringy
+ src/Data/Table.hs view
@@ -0,0 +1,133 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Table+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Tables of data.+--+-----------------------------------------------------------------------------+++module Data.Table {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- * Tables+  Tabulatable(..)+, labels1+, tabulation1+, labels2+, tabulation2+, labels3+, tabulation3+) where+++import Codec.Compression.GZip (compress, decompress)+import Control.Monad (ap)+import Data.List (intercalate, transpose)+import Data.List.Split (splitOn)++import qualified Data.ByteString.Lazy.Char8 as BS (pack, readFile, unpack, writeFile)+++-- | Class for tables with headers and records of fields.+class Tabulatable a where+  -- | Retrieve the header.+  labels :: a -> [String]+  -- | Retrieve the fields for a record.+  tabulation :: a -> [String]+  -- | Retrieve the fields for records.+  tabulations :: [a] -> [[String]]+  tabulations = ap ((:) . labels . head) (map tabulation)+  -- | Retrieve and transpose the fields for records.+  tabulationsT :: [a] -> [[String]]+  tabulationsT = transpose . tabulations+  -- | Retrieve the fields for records as tabbed lines.+  tabulations' :: [a] -> String+  tabulations' = unlines . map (intercalate "\t") . tabulations+  -- | Retrieve the fields for records as transposed tabbed lines.+  tabulationsT' :: [a] -> String+  tabulationsT' = unlines . map (intercalate "\t") . tabulationsT+  -- | Make a record from a string for the fields.+  untabulation :: [String] -> a+  -- | Make records from strings for the fields.+  untabulations :: [[String]] -> [a]+  untabulations = map untabulation . tail+  -- | Make records from tabbed lines for the fields.+  untabulations' :: String -> [a]+  untabulations' = untabulations . map (splitOn "\t") . lines+  -- | Sort the tabulation.+  sorted :: [a] -> [a]+  sorted = undefined+  -- | Find a field in the tabulation.+  find :: a -> [a] -> Maybe a+  find = undefined+  -- | Read from a file.+  readUncompressed :: FilePath -> IO [a]+  readUncompressed = fmap untabulations' . readFile+  -- | Read from a compressed file.+  readCompressed :: FilePath -> IO [a]+  readCompressed = fmap (untabulations' . BS.unpack . decompress) . BS.readFile+  -- | Write to a file.+  writeUncompressed :: FilePath -> [a] -> IO ()+  writeUncompressed = (. tabulations') . writeFile+  -- | Write to a compressed file.+  writeCompressed :: FilePath -> [a] -> IO ()+  writeCompressed = (. compress . BS.pack . tabulations') . BS.writeFile+++-- | Collate the headers from a tabulation.+labels1 :: Tabulatable a+        => String        -- ^ An additional column label.+        -> a             -- ^ The first tabulation.+        -> [String]      -- ^ The collated header.+labels1 s x = labels x ++ [s]+++-- | Collate the headers from two tabulations.+labels2 :: (Tabulatable a, Tabulatable b)+        => String                         -- ^ An additional column label.+        -> a                              -- ^ The first tabulation.+        -> b                              -- ^ The second tabulation.+        -> [String]                       -- ^ The collated header.+labels2 s x y = concat [labels x, labels y, [s]]+++-- | Collate the headers from three tabulations.+labels3 :: (Tabulatable a, Tabulatable b, Tabulatable c)+        => String                                        -- ^ An additional column label.+        -> a                                             -- ^ The first tabulation.+        -> b                                             -- ^ The second tabulation.+        -> c                                             -- ^ The third tabulation.+        -> [String]                                      -- ^ The collated header.+labels3 s x y z = concat [labels x, labels y, labels z, [s]]+++-- | Collate and show a tabulation.+tabulation1 :: (Tabulatable a, Show e)+            => a                       -- ^ The tabulation.+            -> e                       -- ^ An additional column.+            -> [String]                -- ^ The list of string representations.+tabulation1 x s = tabulation x ++ [show s]+++-- | Collate and show two tabulations.+tabulation2 :: (Tabulatable a, Tabulatable b, Show e)+            => a                                      -- ^ The first tabulation.+            -> b                                      -- ^ The second tabulation.+            -> e                                      -- ^ An additional column.+            -> [String]                               -- ^ The list of string representations.+tabulation2 x y s = concat [tabulation x, tabulation y, [show s]]+++-- | Collate and show three tabulations.+tabulation3 :: (Tabulatable a, Tabulatable b, Tabulatable c, Show e)+            => a                                                     -- ^ The first tabulation.+            -> b                                                     -- ^ The second tabulation.+            -> c                                                     -- ^ The third tabulation.+            -> e                                                     -- ^ An additional column.+            -> [String]                                              -- ^ The list of string representations.+tabulation3 x y z s = concat [tabulation x, tabulation y, tabulation z, [show s]]
+ src/Data/Table/Identifier.hs view
@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Table.Identifier+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Identifier for use in tables.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleInstances         #-}++{-# OPTIONS_GHC -fno-warn-deprecations #-}+++module Data.Table.Identifier {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- * Types+  Id(..)+) where+++import Data.Table (Tabulatable(..))+++-- | An identifier for a table.+newtype Id a = Id {unId :: a}+  deriving (Read, Show)++instance Tabulatable (Id String) where+  labels = const ["ID"]+  tabulation = (: []) . unId+  untabulation = Id . head++instance (Read a, Show a) => Tabulatable (Id a) where+  labels = const ["ID"]+  tabulation = (: []) . show . unId+  untabulation = Id . read . head
+ src/Data/Tabular.hs view
@@ -0,0 +1,128 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Tabular+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Formatting and parsing data in tabular format.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE Safe                 #-}+{-# LANGUAGE TupleSections        #-}+{-# LANGUAGE UndecidableInstances #-}+++module Data.Tabular {-# DEPRECATED "This module will be replaced in a future release." #-} (+-- * Types+  Rows(..)+, Row(..)+, Cell(..)+, Tabular(..)+-- * Input/Output Functions+, readTabular+, writeTabular+) where+++import Control.Monad (ap, liftM)+import Data.List (intercalate)+import Data.List.Split (splitOn)+++-- | Rows of data.+newtype Rows = Rows {unRows :: [Row]}+  deriving Eq++instance Read Rows where+  readsPrec _ = return . (, "") . Rows . map read . lines++instance Show Rows where+  show = unlines . map show . unRows+++-- | A row of data.+newtype Row = Row {unRow :: [String]}+  deriving Eq++instance Read Row where+  readsPrec _ = return . (, "") . Row . splitOn tab++instance Show Row where+  show = intercalate tab . unRow+++-- | Tab character used for separating columns.+tab :: String+tab = "\t"+++-- | Class for data in tabular format.+class Tabular a where++  -- | Encode a row of data.+  toRow :: a -> Row++  -- | Decode a row of data.+  fromRow :: Row -> a++  -- | Encode rows, prefixing with header.+  withHeader :: [a] -> Rows+  withHeader = Rows . (Row ["<<UNDEFINED HEADER>>"] :) . map toRow++  -- | Decode rows, stripping a prefixed header.+  checkHeader :: Rows -> [a]+  checkHeader = map fromRow . tail . unRows++instance (Cell a, Monad ((->) [[a]])) => Tabular [a] where+  toRow = Row . map toCell+  fromRow = map fromCell . unRow+  withHeader = Rows . ap ((:) . Row . map (const "<<UNDEFINED COLUMN>>") . head) (map toRow)++instance (Cell a, Cell b) => Tabular (a, b) where+  toRow (x, y) = Row [toCell x, toCell y]+  fromRow (Row [x, y]) = (fromCell x, fromCell y)+  fromRow (Row t) = error $ "not a doublet" ++ show t++instance (Cell a, Cell b, Cell c) => Tabular (a, b, c) where+  toRow (x, y, z) = Row [toCell x, toCell y, toCell z]+  fromRow (Row [x, y, z]) = (fromCell x, fromCell y, fromCell z)+  fromRow (Row t) = error $ "not a triplet: " ++ show t++instance (Cell a, Cell b, Cell c, Cell d) => Tabular (a, b, c, d) where+  toRow (x, y, z, w) = Row [toCell x, toCell y, toCell z, toCell w]+  fromRow (Row [x, y, z, w]) = (fromCell x, fromCell y, fromCell z, fromCell w)+  fromRow (Row t) = error $ "not a quadruplet: " ++ show t+++-- | Class for formatting and parsing cells in a table.+class Cell a where+  -- | Encode a data cell.+  toCell :: a -> String+  -- | Decode a data cell.+  fromCell :: String -> a++instance (Read a, Show a) => Cell a where+  fromCell = read+  toCell = show+++-- | Read tabular data.+readTabular :: Tabular a+  => FilePath -- ^ The filename.+  -> IO [a]   -- ^ Action to read the data.+readTabular = liftM (checkHeader . read) . readFile+++-- | Write tabular data.+writeTabular :: Tabular a+  => FilePath -- ^ The filename.+  -> [a]      -- ^ The data.+  -> IO ()    -- ^ The action to write the data.+writeTabular = (. (show . withHeader)) . writeFile
+ src/Data/Time/Util.hs view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Time.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Some POSIX time functions.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Data.Time.Util (+-- Types+  SecondsPOSIX+-- Conversions+, toSecondsPOSIX+, fromSecondsPOSIX+, getSecondsPOSIX+) where+++import Control.Arrow (second)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)+import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeOrError)+import Data.Time.LocalTime (TimeZone, utcToZonedTime, zonedTimeToUTC)+++-- | POSIX seconds.+type SecondsPOSIX = Int+++theFormat :: String+theFormat = "%FT%X%z %Z"+++-- | Convert an ISO 8601 string to POSIX seconds.+toSecondsPOSIX :: String -> SecondsPOSIX+toSecondsPOSIX =+  truncate+    . utcTimeToPOSIXSeconds+    . zonedTimeToUTC+    . parseTimeOrError False defaultTimeLocale theFormat+++-- | Convert POSIX seconds to an ISO 8601 string.+fromSecondsPOSIX :: TimeZone -> SecondsPOSIX -> String+fromSecondsPOSIX zone =+  uncurry (++)+    . second (':' :)+    . splitAt 22+    . formatTime defaultTimeLocale theFormat+    . utcToZonedTime zone+    . posixSecondsToUTCTime+    . fromIntegral+++-- | Get the current time. +getSecondsPOSIX :: IO SecondsPOSIX+getSecondsPOSIX =+  truncate+    . utcTimeToPOSIXSeconds+    <$> getCurrentTime
+ src/Data/Tuple/Util.hs view
@@ -0,0 +1,171 @@+-----------------------------------------------------------------------------+--+-- Module      :  Data.Tuple.Util+-- Copyright   :  (c) 2012-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <b.w.bush@acm.org>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Functions for manipulating tuples, supplementing "Data.Tuple".+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe             #-}+++module Data.Tuple.Util (+-- * Functions on pairs.+  ($$)+-- * Functions on triplets.+, curry3+, uncurry3+, fst3+, snd3+, trd3+, first3+, second3+, third3+-- * Functions on quadruplets.+, curry4+, uncurry4+, fst4+, snd4+, trd4+, fth4+, first4+, second4+, third4+, fourth4+) where+++import Control.Arrow (Arrow, arr, first)+import Control.Category ((>>>))+import Control.Monad (liftM2)+++-- | Apply a pair of functions to a value.+($$) :: (Monad ((->) a)) => (a -> b, a -> c) -> a -> (b, c)+($$) = uncurry (liftM2 (,))+++-- | Curry a triplet.+curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d+curry3 f x y z = f (x, y, z)+++-- | Uncurry a triplet.+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uncurry3 f (x, y, z) = f x y z+++-- | Extract the first entry of a triplet.+fst3 :: (a, b, c) -> a+fst3 (x, _, _) = x+++-- | Extract the second entry of a triplet.+snd3 :: (a, b, c) -> b+snd3 (_, x, _) = x+++-- | Extract the third entry of a triplet.+trd3 :: (a, b, c) -> c+trd3 (_, _, x) = x+++-- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.+first3 :: Arrow a => a b c -> a (b, d, e) (c, d, e)+first3 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z) = (x, (y, z))+      unpack ~(x, (y, z)) = (x, y, z)+++-- | Send the second component of the input through the argument arrow, and copy the rest unchanged to the output.+second3 :: Arrow a => a b c -> a (d, b, e) (d, c, e)+second3 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z) = (y, (x, z))+      unpack ~(y, (x, z)) = (x, y, z)+++-- | Send the third component of the input through the argument arrow, and copy the rest unchanged to the output.+third3 :: Arrow a => a b c -> a (d, e, b) (d, e, c)+third3 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z) = (z, (x, y))+      unpack ~(z, (x, y)) = (x, y, z)+++-- | Curry a quadruplet.+curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e+curry4 f x y z w = f (x, y, z, w)+++-- | Uncurry a quadruplet.+uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e+uncurry4 f (x, y, z, w) = f x y z w+++-- | Extract the first entry of a quadruplet.+fst4 :: (a, b, c, d) -> a+fst4 (x, _, _, _) = x+++-- | Extract the second entry of a quadruplet.+snd4 :: (a, b, c, d) -> b+snd4 (_, x, _, _) = x+++-- | Extract the third entry of a quadruplet.+trd4 :: (a, b, c, d) -> c+trd4 (_, _, x, _) = x+++-- | Extract the fourth entry of a quadruplet.+fth4 :: (a, b, c, d) -> d+fth4 (_, _, _, x) = x+++-- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.+first4 :: Arrow a => a b c -> a (b, d, e, f) (c, d, e, f)+first4 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z, w) = (x, (y, z, w))+      unpack ~(x, (y, z, w)) = (x, y, z, w)+++-- | Send the second component of the input through the argument arrow, and copy the rest unchanged to the output.+second4 :: Arrow a => a b c -> a (d, b, e, f) (d, c, e, f)+second4 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z, w) = (y, (x, z, w))+      unpack ~(y, (x, z, w)) = (x, y, z, w)+++-- | Send the third component of the input through the argument arrow, and copy the rest unchanged to the output.+third4 :: Arrow a => a b c -> a (d, e, b, f) (d, e, c, f)+third4 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z, w) = (z, (x, y, w))+      unpack ~(z, (x, y, w)) = (x, y, z, w)+++-- | Send the fourth component of the input through the argument arrow, and copy the rest unchanged to the output.+fourth4 :: Arrow a => a b c -> a (d, e, f, b) (d, e, f, c)+fourth4 f =+  arr pack >>> first f >>> arr unpack+    where+      pack ~(x, y, z, w) = (w, (x, y, z))+      unpack ~(w, (x, y, z)) = (x, y, z, w)
+ src/Math/Fractions.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+--+-- Module      :  Math.Fractions+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Experimental+-- Portability :  Portable+--+-- | Some special operations with fractions.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Math.Fractions {-# DEPRECATED "This module will be removed in a future release." #-} (+-- * Functions+  fractions+, fractionsMaybe+) where+++import Control.Arrow (second)+import Data.List.Util (regroup)+import Data.Maybe (mapMaybe)+++-- | Apply a function to a list to extract keys with values that sum to unity.+fractions :: (Ord b, Fractional c) => (a -> (b, c)) -> [a] -> [(b, c)]+fractions extractor x =+  let+    x' = map (second sum) $ regroup $ map extractor x+    t = sum $ map snd x'+  in+    map (second (/ t)) x'+++-- | Apply a function to a list to extract keys with values that sum to unity.+fractionsMaybe :: (Ord b, Fractional c) => (a -> Maybe (b, c)) -> [a] -> [(b, c)]           +fractionsMaybe = (fractions id .) . mapMaybe
+ src/Math/GeometricSeries.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+--+-- Module      :  Math.GeometricSeries+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Geometric series.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Safe          #-}+++module Math.GeometricSeries (+-- * Types+  GeometricSeries(..)+-- * Functions+, asFunction+) where+++import GHC.Generics (Generic)+++-- | A geometric series.+data GeometricSeries a =+  GeometricSeries+    {+      independentStart :: a -- ^ The initial value of the independent variable.+    , dependentStart   :: a -- ^ The initial value of the dependent variable.+    , escalationRate   :: a -- ^ The escalation per unit of the independent variable.+    }+    deriving (Generic, Read, Show)+++-- | Convert to a function.+asFunction :: Floating a+           => GeometricSeries a -- ^ The geometric series.+          -> a                  -- ^ The independent variable.+          -> a                  -- ^ The dependent variable.+asFunction GeometricSeries{..} x = dependentStart * (1 + escalationRate)**(x - independentStart)
+ src/Math/Monad.hs view
@@ -0,0 +1,96 @@+-----------------------------------------------------------------------------+--+-- Module      :  Math.Monad+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Monadic mathematics.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Math.Monad (+-- Operators+  (?+?)+, (?+)+, (+?)+, (?-?)+, (?-)+, (-?)+, (?*?)+, (?*)+, (*?)+, (?/?)+, (?/)+, (/?)+) where+++import Control.Monad (liftM, liftM2)+++-- | Add monadic values.+(?+?) :: (Monad m, Num a) => m a -> m a -> m a+(?+?) = liftM2 (+)+++-- | Add a monadic value.+(?+) :: (Monad m, Num a) => m a -> a -> m a+(?+) = flip (+?)+++-- | Add to a monadic value.+(+?) :: (Monad m, Num a) => a -> m a -> m a+(+?) = liftM . (+)+++-- | Subtract monadic values.+(?-?) :: (Monad m, Num a) => m a -> m a -> m a+(?-?) = liftM2 (-)+++-- | Subtract a monadic value.+(?-) :: (Monad m, Num a) => m a -> a -> m a+(?-) = flip (+?)+++-- | Subtract to a monadic value.+(-?) :: (Monad m, Num a) => a -> m a -> m a+(-?) = liftM . (-)+++-- | Multiply monadic values.+(?*?) :: (Monad m, Num a) => m a -> m a -> m a+(?*?) = liftM2 (*)+++-- | Multiply  a monadic value.+(?*) :: (Monad m, Num a) => m a -> a -> m a+(?*) = flip (*?)+++-- | Multiply to a monadic value.+(*?) :: (Monad m, Num a) => a -> m a -> m a+(*?) = liftM . (*)+++-- | Divide monadic values.+(?/?) :: (Monad m, Fractional a) => m a -> m a -> m a+(?/?) = liftM2 (/)+++-- | Divide a monadic value.+(?/) :: (Monad m, Fractional a) => m a -> a -> m a+(?/) = flip (/?)+++-- | Divide by a monadic value.+(/?) :: (Monad m, Fractional a) => a -> m a -> m a+(/?) = liftM . (/)
+ src/Math/Roots.hs view
@@ -0,0 +1,97 @@+-----------------------------------------------------------------------------+--+-- Module      :  Math.Roots+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Root finding.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Math.Roots (+-- * Types.+  RootFinder+, Bracketer+-- * Functions.+, bracket+, bracketInward+, bracketOutward+) where+++import Control.Monad (ap)+++-- | A function for findng a root.+type RootFinder a =+     (a -> a)        -- ^ The function.+  -> (a, a)          -- ^ The interval bracketing the root.+  -> Either String a -- ^ The root, or an error message if it could not be found.+++-- | A function for bracketing a root.+type Bracketer a =+     (a -> a)             -- ^ The function.+  -> (a, a)               -- ^ A guess at the interval bracketing a root.+  -> Either String (a, a) -- ^ The bracketing of the root, or an error message if it could not be found.+++-- | Bracket a bracket around a root.+bracket :: (Fractional a, Num a, Ord a) =>+     Int         -- ^ The maximum number of function evaluations allowed.+  -> Bracketer a -- ^ The root bracketing function.+bracket n f xs =+  let+    inward = bracketInward n f xs+    outward = bracketOutward n f xs+  in+    either (const outward) Right inward+++-- | Search for a bracket around a root outside an interval.+-- |+-- | Reference: William H. Press, Saul A. Teukolsky, William T. Vetterling, and Brian P. Flannery, Numerical Recipes in C: The Art of Scientific Computing>, Second Edition (New York: Cambridge Univ. Press, 1992).+bracketOutward :: (Fractional a, Num a, Ord a) =>+     Int         -- ^ The maximum number of function evaluations allowed.+  -> Bracketer a -- ^ The root bracketing function.+bracketOutward 0 _ _ = Left "Reached maximum number of iterations."+bracketOutward ntry f (x1, x2)+ | x1 == x2  = Left "Invalid initial range."+ | otherwise =+  do+    let+      factor = 1.6+      f1 = f x1+      f2 = f x2+      dx = x2 - x1+    if f1 * f2 < 0+      then return (x1, x2)+      else bracketOutward (ntry - 1) f $+        if abs f1 < abs f2+          then (x1 - factor * dx, x2)+          else (x1, x2 + factor * dx)+++-- | Search for a bracket around a root inside an interval.+-- |+-- | Reference: William H. Press, Saul A. Teukolsky, William T. Vetterling, and Brian P. Flannery, Numerical Recipes in C: The Art of Scientific Computing>, Second Edition (New York: Cambridge Univ. Press, 1992).+bracketInward :: (Num a, Ord a) =>+     Int         -- ^ The maximum number of function evaluations allowed.+  -> Bracketer a -- ^ The root bracketing function.+bracketInward ntry f (x1, x2)+ | x1 == x2  = Left "Invalid initial range."+ | otherwise = bracketInward' $ map (ap (,) f . (x1 +) . ((x2 - x1) *) . fromIntegral) [0..ntry]+  where+    bracketInward' ((xa, fa) : zs@((xb, fb) : _)) =+      if fa * fb < 0+        then return (xa, xb)+        else bracketInward' zs+    bracketInward' _ = Left "Reached maximum number of iterations."
+ src/Math/Roots/Bisection.hs view
@@ -0,0 +1,57 @@+-----------------------------------------------------------------------------+--+-- Module      :  Math.Roots.Bisection+-- Copyright   :  (c) 2013-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Root finding using the bisection method.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Math.Roots.Bisection (+-- * Functions.+  findRoot+) where+++import Math.Roots (RootFinder)+++-- | Find a root using the bisection method.+-- |+-- | Reference: William H. Press, Saul A. Teukolsky, William T. Vetterling, and Brian P. Flannery, Numerical Recipes in C: The Art of Scientific Computing>, Second Edition (New York: Cambridge Univ. Press, 1992).+findRoot :: (Fractional a, Num a, Ord a) =>+     Int          -- ^ Maximum number of bisections.+  -> a            -- ^ Absolute error tolerance.+  -> RootFinder a -- ^ The root finder.+findRoot jmax xacc func (x1, x2)+  | x1 >= x2               = Left "The root is not bracketed by an interval."+  | func x1 * func x2 >= 0 = Left "The root is not bracketed by the interval."+  | otherwise              =+    findRoot' jmax $+      if func x1 < 0+        then (x2 - x1, x1)+        else (x1 - x2, x2)+      where+        findRoot' 0 _ = Left "The maximum number of bisections was reached."+        findRoot' j (dx, rtb) =+          do+            let+              dx' = dx / 2+              xmid = rtb + dx'+              fmid = func xmid+              rtb' =+                if fmid <= 0+                  then xmid+                  else rtb+            if abs dx < xacc || fmid == 0+              then return rtb'+              else findRoot' (j - 1) (dx', rtb')
+ src/Math/Series.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+--+-- Module      :  Math.Series+-- Copyright   :  (c) 2014-16 Brian W Bush+-- License     :  MIT+--+-- Maintainer  :  Brian W Bush <consult@brianwbush.info>+-- Stability   :  Stable+-- Portability :  Portable+--+-- | Numerical functions for lists.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE Safe #-}+++module Math.Series (+-- * Functions+  deltas+, sums+) where+++-- | Difference between values in a list.+deltas :: Num a => [a] -> [a]+deltas [] = []+deltas x = head x : zipWith (-) (tail x) (init x)+++-- | Summ of adjacent values in a list.+sums :: Num a => [a] -> [a]+sums [] = []+sums [x] = [x]+sums (x : x' : xs) = x : sums (x + x' : xs)+++