text:
module DiscreteFourier (discreteFourier, inverseDiscreteFourier) where

import Data.Complex (Complex, cis, magnitude)
import Data.List (zipWith, length)

import ComplexUtils (toComplex, toComplexM)

getAngles :: Double -> Int -> [(Complex Double)]
getAngles pi2k n = map cis $ map (pi2k *) $ map fromIntegral [0..n-1]

discreteFourierStep :: [(Complex Double)] -> Int -> Int -> (Complex Double)
discreteFourierStep fs op k =
    let
        n = length fs
    in
        if k == 0
            then (foldl (+) (toComplex 0) fs)
            else
                let
                    pi2k = (2 * pi * (fromIntegral k) * (fromIntegral op)) / (fromIntegral n)
                    angles = getAngles pi2k n
                in
                    sum $ zipWith (*) fs angles

iterateDiscreteFourierStep :: Int -> [(Complex Double)] -> [(Complex Double)]
iterateDiscreteFourierStep op fs =
    let
        n = length fs
    in
        map (discreteFourierStep fs op) [0..n-1]

discreteFourier :: [Double] -> [(Complex Double)]
discreteFourier fs = iterateDiscreteFourierStep (-1) $ toComplexM fs

inverseDiscreteFourier :: [(Complex Double)] -> [Double]
inverseDiscreteFourier cs =
    let
        n = length cs
        nd = fromIntegral n
    in
        map magnitude $ map (/nd) $ iterateDiscreteFourierStep 1 cs

max_stars_repo_name: vined/fourier

max_issues_repo_name: vined/fourier

max_forks_repo_name: vined/fourier


text:
{-# LANGUAGE  ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module     : Data.Elem.LAPACK.Zomplex
-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
-- License    : BSD3
-- Maintainer : Patrick Perry <patperry@stanford.edu>
-- Stability  : experimental
--

module Data.Elem.LAPACK.Zomplex
    where

import Data.Complex( Complex )
import Foreign( Ptr )
import LAPACK.CTypes

type Zomplex = Complex Double

foreign import ccall unsafe "LAPACK.h lapack_zgeqrf"
    zgeqrf :: Int -> Int -> Ptr Zomplex -> Int -> Ptr Zomplex -> Ptr Zomplex -> Int -> IO Int

foreign import ccall unsafe "LAPACK.h lapack_zgelqf"
    zgelqf :: Int -> Int -> Ptr Zomplex -> Int -> Ptr Zomplex -> Ptr Zomplex -> Int -> IO Int

foreign import ccall unsafe "LAPACK.h lapack_zunmqr"
    zunmqr :: CBLASSide -> CBLASTrans -> Int -> Int -> Int -> Ptr Zomplex -> Int -> Ptr Zomplex
           -> Ptr Zomplex -> Int -> Ptr Zomplex -> Int -> IO Int

foreign import ccall unsafe "LAPACK.h lapack_zunmlq"
    zunmlq :: CBLASSide -> CBLASTrans -> Int -> Int -> Int -> Ptr Zomplex -> Int -> Ptr Zomplex
           -> Ptr Zomplex -> Int -> Ptr Zomplex -> Int -> IO Int

foreign import ccall unsafe "LAPACK.h lapack_zlarfg"
    zlarfg :: Int -> Ptr Zomplex -> Ptr Zomplex -> Int -> Ptr Zomplex -> IO ()

ext: hs

max_stars_repo_name: patperry/lapack

max_issues_repo_name: patperry/lapack

max_forks_repo_name: patperry/lapack


text:
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings,
    RecordWildCards #-}

-- |
-- Module    : Statistics.Resampling.Bootstrap
-- Copyright : (c) 2009, 2011 Bryan O'Sullivan
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- The bootstrap method for statistical inference.

module Statistics.Resampling.Bootstrap
    (
      Estimate(..)
    , bootstrapBCA
    , scale
    -- * References
    -- $references
    ) where

import Control.Applicative ((<$>), (<*>))
import Control.DeepSeq (NFData)
import Control.Exception (assert)
import Control.Monad.Par (parMap, runPar)
import Data.Aeson (FromJSON, ToJSON)
import Data.Binary (Binary)
import Data.Binary (put, get)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Vector.Unboxed ((!))
import GHC.Generics (Generic)
import Statistics.Distribution (cumulative, quantile)
import Statistics.Distribution.Normal
import Statistics.Resampling (Resample(..), jackknife)
import Statistics.Sample (mean)
import Statistics.Types (Estimator, Sample)
import qualified Data.Vector.Unboxed as U
import qualified Statistics.Resampling as R

-- | A point and interval estimate computed via an 'Estimator'.
data Estimate = Estimate {
      estPoint           :: {-# UNPACK #-} !Double
    -- ^ Point estimate.
    , estLowerBound      :: {-# UNPACK #-} !Double
    -- ^ Lower bound of the estimate interval (i.e. the lower bound of
    -- the confidence interval).
    , estUpperBound      :: {-# UNPACK #-} !Double
    -- ^ Upper bound of the estimate interval (i.e. the upper bound of
    -- the confidence interval).
    , estConfidenceLevel :: {-# UNPACK #-} !Double
    -- ^ Confidence level of the confidence intervals.
    } deriving (Eq, Read, Show, Typeable, Data, Generic)

instance FromJSON Estimate
instance ToJSON Estimate

instance Binary Estimate where
    put (Estimate w x y z) = put w >> put x >> put y >> put z
    get = Estimate <$> get <*> get <*> get <*> get
instance NFData Estimate

-- | Multiply the point, lower bound, and upper bound in an 'Estimate'
-- by the given value.
scale :: Double                 -- ^ Value to multiply by.
      -> Estimate -> Estimate
scale f e@Estimate{..} = e {
                           estPoint = f * estPoint
                         , estLowerBound = f * estLowerBound
                         , estUpperBound = f * estUpperBound
                         }

estimate :: Double -> Double -> Double -> Double -> Estimate
estimate pt lb ub cl =
    assert (lb <= ub) .
    assert (cl > 0 && cl < 1) $
    Estimate { estPoint = pt
             , estLowerBound = lb
             , estUpperBound = ub
             , estConfidenceLevel = cl
             }

data T = {-# UNPACK #-} !Double :< {-# UNPACK #-} !Double
infixl 2 :<

-- | Bias-corrected accelerated (BCA) bootstrap. This adjusts for both
-- bias and skewness in the resampled distribution.
bootstrapBCA :: Double          -- ^ Confidence level
             -> Sample          -- ^ Sample data
             -> [Estimator]     -- ^ Estimators
             -> [Resample]      -- ^ Resampled data
             -> [Estimate]
bootstrapBCA confidenceLevel sample estimators resamples
  | confidenceLevel > 0 && confidenceLevel < 1
      = runPar $ parMap (uncurry e) (zip estimators resamples)
  | otherwise = error "Statistics.Resampling.Bootstrap.bootstrapBCA: confidence level outside (0,1) range"
  where
    e est (Resample resample)
      | U.length sample == 1 || isInfinite bias =
          estimate pt pt pt confidenceLevel
      | otherwise =
          estimate pt (resample ! lo) (resample ! hi) confidenceLevel
      where
        pt    = R.estimate est sample
        lo    = max (cumn a1) 0
          where a1 = bias + b1 / (1 - accel * b1)
                b1 = bias + z1
        hi    = min (cumn a2) (ni - 1)
          where a2 = bias + b2 / (1 - accel * b2)
                b2 = bias - z1
        z1    = quantile standard ((1 - confidenceLevel) / 2)
        cumn  = round . (*n) . cumulative standard
        bias  = quantile standard (probN / n)
          where probN = fromIntegral . U.length . U.filter (<pt) $ resample
        ni    = U.length resample
        n     = fromIntegral ni
        accel = sumCubes / (6 * (sumSquares ** 1.5))
          where (sumSquares :< sumCubes) = U.foldl' f (0 :< 0) jack
                f (s :< c) j = s + d2 :< c + d2 * d
                    where d  = jackMean - j
                          d2 = d * d
                jackMean     = mean jack
        jack  = jackknife est sample

-- $references
--
-- * Davison, A.C; Hinkley, D.V. (1997) Bootstrap methods and their
--   application. <http://statwww.epfl.ch/davison/BMA/>

max_stars_repo_name: StefanHubner/statistics

max_issues_repo_name: StefanHubner/statistics

max_forks_repo_name: StefanHubner/statistics


text:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-| This module defines a version of `Representable` where the function
    tabulated/indexed returns a monadic result.

    In other words, instead of providing an isomorphism with `Reader`,
    we provide one with `ReaderT` for a fixed `Monad`.
-}

module Control.Monad.Rep (
  -- * Type class
    RepresentableM(..)

  -- * Functor
  , fmapRepM

  -- * Distributive
  , distributeRepM
  , collectRepM

  -- * DistributiveM
  , distributemRepM
  , collectmRepM

  -- * Apply/Applicative
  , apRepM
  , pureRepM
  , liftRM2
  , liftRM3

  -- * Bind/Monad
  , bindRepM

  -- * MonadFix
  , mfixRepM

  -- * MonadZip
  , mzipWithRepM
  , mzipRepM

  -- * MonadReader
  , fromReaderT
  , toReaderT
  , askRepM
  , asksRepM
  , mapRepM
  , withRepM
  , localRepM

  -- * Extend
  , duplicatedRepM
  , extendedRepM

  -- * Comonad
  , duplicateRepM
  , extendRepM
  , extractRepM

  -- * Comonad, with user-specified monoid
  , duplicateRepMBy
  , extendRepMBy
  , extractRepMBy

  -- * WithIndex
  , imapRepM
  , imapMRepM
  , ifoldMapRepM
  , itraverseRepM

  -- * MonadFree
  , wrapRepM

  -- * Lifting other operations
  , liftRepM
  , liftCallCC
  , liftCatch

  -- * Generics
  , gtabulateM
  , gindexM

  , GRepM
  , GRepM'
  , GTabulateM(..)
  , GIndexM(..)
  , WrappedRepM(..)

  , todo
  ) where

import Control.Comonad (Comonad(..))
import Control.Monad (liftM2, liftM3)
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Zip (MonadZip(..))
import Data.Bits (Bits, FiniteBits)
import Data.Complex (Complex)
import Data.Data (Data)
import Data.Distributive (Distributive(..))
import Data.Distributive.Monadic
import Data.Foldable (fold)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.Ix (Ix)
import Data.Profunctor.Unsafe (Profunctor(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Dual, Product, Semigroup(..), Sum)
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
import Foreign.Storable (Storable)
import GHC.Generics
  ( (:*:)(..)
  , (:.:)(..)
  , Generic
  , Generic1(..)
  , M1(..)
  , Par1(..)
  , Rec1(..)
  , U1(..)
  )
import GHC.TypeLits (ErrorMessage(..), TypeError)
import Text.Printf (PrintfArg)

-- There are a number of "boring", i.e. trivial, instances:
-- Monad m => RepresentableM m (WrappedMonad m) where
--   type RepM (WrappedMonad m) = ()
--   tabulateM f = WrappedMonad (f ())
--   indexM = const
-- ..

-- | A `Functor` @f@ is `RepresentableM` for a given `Monad` @m@ if `tabulateM`
-- and `indexM` witness an isomorphism to @`ReaderT` (`RepM` f) m@.
--
-- @
--  `tabulateM` . `indexM` == `id`
--  `indexM` . `tabulateM` == `id`
--  `tabulateM` . `return` . `return` == `return`
-- @
--
-- Every `RepresentableM` `Functor` whose base `Monad` is a right adjoint
-- is also a right adjoint.
--
-- Inuitively, a `RepresentableM` `Functor` is a `Representable` `Functor` on
-- the Kleisli category of the base `Monad`.
--
-- I'd expect some superclass requirement, but it ends up looking like just
-- @`Applicative` f@:
--
-- @
-- class `Applicative` f => DistributiveA f where
--   distributeM :: `Traversable` t => t (f a) -> f (t a)
--
-- instance `Applicative` m => DistributiveM (`ReaderT` a m) where
--   distributeM = `ReaderT` . `fmap` `sequenceA` . `distribute` . `fmap` `runReaderT`
-- @
--
class DistributiveM m f => RepresentableM m f | f -> m where
  -- | If no definition is provided, this will default to `GRepM`.
  type RepM f :: *
  type RepM f = GRepM f

  -- |
  -- @
  --  `fmap` (`fmap` f) . `tabulateM` == `tabulateM` . `fmap` f
  -- @
  --
  -- If no definition is provided, this will default to `gtabulateM`.
  tabulateM :: (RepM f -> m a) -> f a
  default tabulateM :: (Generic1 f, GRepM f ~ RepM f, GTabulateM m (Rep1 f)) => (RepM f -> m a) -> f a
  tabulateM = gtabulateM

  -- | If no definition is provided, this will default to 'gindexM'.
  indexM :: f a -> (RepM f -> m a)
  default indexM :: (Generic1 f, GRepM f ~ RepM f, GIndexM m (Rep1 f)) => f a -> (RepM f -> m a)
  indexM = gindexM

-- GHC.Generics instances

instance (RepresentableM m f, RepresentableM m g) =>
         RepresentableM m (f :*: g)

instance (RepresentableM m f, RepresentableM m g, Monad (f :.: g), Functor f) =>
         RepresentableM m (f :.: g)

instance (RepresentableM m f, RepresentableM m g, Monad (Compose f g), Functor f) =>
         RepresentableM m (Compose f g)

instance RepresentableM Identity Par1

instance RepresentableM m f => RepresentableM m (M1 i c f)

instance RepresentableM m f => RepresentableM m (Rec1 f)

instance RepresentableM Identity U1

-- Lifted instances

instance RepresentableM Identity Identity

instance RepresentableM Identity Complex

instance RepresentableM Identity Dual

instance RepresentableM Identity Sum

instance RepresentableM Identity Product

instance RepresentableM Identity Proxy

-- Interesting instances

instance Monad m => RepresentableM m (ReaderT a m) where
  type RepM (ReaderT a m) = a
  tabulateM = ReaderT
  indexM = runReaderT

-- instance Monad m => RepresentableM m (FoldM m a) where
--   type RepM (FoldM m a) = FoldableFree a
--   tabulateM = fromFunctionM
--   indexM = foldM

-- -- | Hmm, instead of `fromFunctionEM`, shouldn't we be able
-- -- to encode a function like `lineE` using it?
-- instance RepresentableM m (FoldEM m a) where
--   type RepM (FoldEM m a) = FoldableFree a
--   tabulateM = fromFunctionEM
--   indexM = foldEM

--   type RepM (CofreeM m) = Free Maybe (RepM f)
--   indexM (_ :< xs) (Pure k) = indexM xs k
--   indexM (x :< _ ) (Free Nothing) = return x
--   indexM (_ :< xs) (Free (Just k)) = xs >>= (`indexM` k)

--   tabulateM f = f Nothing :< _ f

-- Functor

-- | `fmap` inside the `Monad`ic result of a `RepresentableM`
fmapRepM :: RepresentableM m f => (a -> b) -> f a -> f b
fmapRepM f = tabulateM . fmap (fmap f) . indexM

-- Distributive

-- | `collect` after `indexM`ing
distributeRepM :: (RepresentableM m f, Distributive m, Functor w) => w (f a) -> f (w a)
distributeRepM wf = tabulateM $ \k -> collect (`indexM` k) wf

-- | `collect` after `indexM`ing the result of the provided function
collectRepM :: (RepresentableM m f, Distributive m, Functor w) => (a -> f b) -> w a -> f (w b)
collectRepM f w = tabulateM $ \k -> collect ((`indexM` k) . f) w

-- DistributiveM

-- | `distributem` for `RepresentableM`
distributemRepM :: RepresentableM m f => m (f a) -> f (m a)
distributemRepM = tabulateM . collect indexM

-- | `collect` for `RepresentableM`
collectmRepM :: RepresentableM m f => (a -> f b) -> m a -> f (m b)
collectmRepM f = tabulateM . collect indexM . fmap f

-- Apply/Applicative

-- | Uses the isomorphism
apRepM :: RepresentableM m f => f (a -> b) -> f a -> f b
apRepM f g = tabulateM $ liftM2 (<*>) (indexM f) (indexM g)

-- | `tabulateM` ignoring the index and `return`ing the value
pureRepM :: RepresentableM m f => a -> f a
pureRepM = tabulateM . const . return

-- | Uses the isomorphism
liftRM2 :: RepresentableM m f => (a -> b -> c) -> f a -> f b -> f c
liftRM2 f fa fb = tabulateM $ \k -> liftM2 f (indexM fa k) (indexM fb k)

-- | Uses the isomorphism
liftRM3 :: RepresentableM m f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftRM3 f fa fb fc = tabulateM $ \k -> liftM3 f (indexM fa k) (indexM fb k) (indexM fc k)

-- Bind/Monad

-- | Equivalent to:
--
-- @
--  \\m f -> `runReaderT` $ `toReaderT` m `>>=` `toReaderT` . f
-- @
--
bindRepM :: RepresentableM m f => f a -> (a -> f b) -> f b
bindRepM m f = tabulateM $ \k -> f <$> indexM m k >>= (`indexM` k)

-- MonadFix

-- | Equivalent to:
--
-- @
--  `runReaderT` . `mfix` . `fmap` `toReaderT`
-- @
--
mfixRepM :: (RepresentableM m f, MonadFix m) => (a -> f a) -> f a
mfixRepM = fromReaderT . mfix . fmap toReaderT

-- MonadZip

-- | `indexM`, `mzipWith`, then `tabulateM`
mzipWithRepM :: (RepresentableM m f, MonadZip m) => (a -> b -> c) -> f a -> f b -> f c
mzipWithRepM f as bs = tabulateM $ \k -> mzipWith f (indexM as k) (indexM bs k)

-- | `indexM`, `mzip`, then `tabulateM`
mzipRepM :: (RepresentableM m f, MonadZip m) => f a -> f b -> f (a, b)
mzipRepM as bs = tabulateM $ \k -> mzip (indexM as k) (indexM bs k)

-- MonadReader

-- | @`RepresentableM` m f@ is isomorphic to @`ReaderT` (`RepM` f) m a@:
--
-- @
--  `fromReaderT` . `toReaderT` == `id`
--  `toReaderT` . `fromReaderT` == `id`
-- @
--
fromReaderT :: RepresentableM m f => ReaderT (RepM f) m a -> f a
fromReaderT = tabulateM . runReaderT

-- | The other half of the isomorphism, see: `fromReaderT`
toReaderT :: RepresentableM m f => f a -> ReaderT (RepM f) m a
toReaderT = ReaderT . indexM

-- | Fetch the value of the environment.
--
-- (`ask` specialized to `RepresentableM`)
askRepM :: RepresentableM m f => f (RepM f)
askRepM = tabulateM return

-- | Retrieve a function of the current environment.
--
-- (`asks` specialized to `RepresentableM`)
asksRepM :: RepresentableM m f
         => (RepM f -> a)  -- ^ The selector function to apply to the environment.
         -> f a
asksRepM = tabulateM . fmap return

-- | Transform the computation inside a `RepresentableM`.
--
-- (`mapReaderT` specialized to `RepresentableM`)
mapRepM :: RepresentableM m f => (m a -> m b) -> f a -> f b
mapRepM f xs = tabulateM $ f . indexM xs

-- | Execute a computation in a modified environment.
--
-- (`withReaderT` specialized to `RepresentableM`)
withRepM :: RepresentableM m f
         => (RepM f -> RepM f)  -- ^ The function to modify the environment.
         -> f a                 -- ^ Computation to run in the modified environment.
         -> f a
withRepM f m = tabulateM $ indexM m . f

-- | Execute a computation in a modified environment.
--
-- (`local` specialized to `RepresentableM`)
localRepM :: RepresentableM m f
          => (RepM f -> RepM f) -- ^ The function to modify the environment.
          -> f a                -- ^ Computation to run in the modified environment.
          -> f a
localRepM = withRepM

-- Extend

-- | @`duplicateRepMBy` (`<>`)@
duplicatedRepM :: (RepresentableM m f, Semigroup (RepM f)) => f a -> f (f a)
duplicatedRepM = duplicateRepMBy (<>)

-- | @`extendRepMBy` (`<>`)@
extendedRepM :: (RepresentableM m f, Semigroup (RepM f)) => (f a -> b) -> f a -> f b
extendedRepM = extendRepMBy (<>)

-- Comonad

-- | @`duplicateRepMBy` `mappend`@
duplicateRepM :: (RepresentableM m f, Monoid (RepM f)) => f a -> f (f a)
duplicateRepM = duplicateRepMBy mappend

-- | @`extendRepMBy` `mappend`@
extendRepM :: (RepresentableM m f, Monoid (RepM f)) => (f a -> b) -> f a -> f b
extendRepM = extendRepMBy mappend

-- | @`extractRepMBy` `mempty`@
extractRepM :: (RepresentableM m f, Monoid (RepM f), Comonad m) => f a -> a
extractRepM = extractRepMBy mempty

-- Comonad, with user-specified monoid

-- | `indexM` then `tabulateM` twice and use the provided operation to
-- combine the keys
duplicateRepMBy :: RepresentableM m f => (RepM f -> RepM f -> RepM f) -> f a -> f (f a)
duplicateRepMBy plus w = tabulateM (\k -> return $ tabulateM (indexM w . plus k))

-- | `indexM` then `tabulateM` twice and use the provided operation to
-- combine the keys
extendRepMBy :: RepresentableM m f => (RepM f -> RepM f -> RepM f) -> (f a -> b) -> f a -> f b
extendRepMBy plus f w = tabulateM (\k -> return $ f (tabulateM (indexM w . plus k)))

-- | Since we need to return a raw value, @m@ must be a `Comonad`
extractRepMBy :: (RepresentableM m f, Comonad m) => RepM f -> f a -> a
extractRepMBy = fmap extract . flip indexM

-- WithIndex

-- | `tabulateM` to expose the `RepM` and then `fmap`
imapRepM :: RepresentableM m f => (RepM f -> a -> b) -> f a -> f b
imapRepM f xs = tabulateM $ \k -> f k <$> indexM xs k

-- | `tabulateM` to expose the `RepM` and then (`>>=`)
imapMRepM :: RepresentableM m f => (RepM f -> a -> m b) -> f a -> f b
imapMRepM f xs = tabulateM $ \k -> indexM xs k >>= f k

-- | Indexed `foldMap`
ifoldMapRepM :: forall m f a b. (RepresentableM m f, Foldable f, Monoid b) => (RepM f -> a -> b) -> f a -> b
ifoldMapRepM ix xs = fold ((tabulateM $ \(k :: RepM f) -> ix k <$> indexM xs k) :: f b)

-- | Indexed `traverse`
itraverseRepM :: (RepresentableM m f, Traversable f, Applicative g) => (RepM f -> a -> g b) -> f a -> g (f b)
itraverseRepM ix xs = sequenceA . tabulateM $ \k -> ix k <$> indexM xs k

-- MonadFree

-- | Wrap the base `Monad` of a `RepresentableM`
wrapRepM :: RepresentableM m f => m (f a) -> f a
wrapRepM m = tabulateM $ \k -> m >>= (`indexM` k)

-- Lifting other operations

-- | Lift the base `Monad` of a `RepresentableM`
liftRepM :: RepresentableM m f => m a -> f a
liftRepM = tabulateM . const

-- | Lift a @callCC@ operation to the base `Monad`.
liftCallCC :: RepresentableM m f
           => (((a -> m b) -> m a) -> m a) -- ^ @callCC@ on the base `Monad`.
           -> ((a -> f b) -> f a)
           -> f a
liftCallCC callCC f =
  tabulateM $ \k -> callCC $ \c -> indexM (f (tabulateM . const . c)) k

-- | Lift a @catchError@ operation to the base monad.
liftCatch :: RepresentableM m f
          => (m a -> (RepM f -> m a) -> m a) -- ^ @catch@ on the base monad.
          -> f a                             -- ^ Computation to attempt.
          -> (RepM f -> f a)                 -- ^ Exception handler.
          -> f a
liftCatch catch m handle =
  tabulateM $ \k -> indexM m k `catch` \e -> indexM (handle e) k

-- Generics

-- | A default implementation of `tabulateM` in terms of `GRepM`.
gtabulateM ::
     (Generic1 f, GRepM f ~ RepM f, GTabulateM m (Rep1 f))
  => (RepM f -> m a)
  -> f a
gtabulateM = to1 . gtabulateM'

-- | A default implementation of `indexM` in terms of `GRepM`.
gindexM ::
     (Generic1 f, GRepM f ~ RepM f, GIndexM m (Rep1 f))
  => f a
  -> (RepM f -> m a)
gindexM = gindexM' . from1

-- | A convenient composition of `GRepM'` and `Rep1`
type GRepM f = GRepM' (Rep1 f)

-- | Generic `RepM`, with a customer `TypeError` for unsupported types.
type family GRepM' (f :: * -> *) :: * where
  GRepM' (f :*: g) = Either (GRepM' f) (GRepM' g)
  GRepM' Par1 = ()
  GRepM' (M1 i c f) = GRepM' f
  GRepM' (f :.: g) = (WrappedRepM f, GRepM' g)
  GRepM' (Rec1 f) = WrappedRepM f
  GRepM' U1 = Void
  GRepM' x = TypeError (
      'Text "The type " ':<>:
      'ShowType x ':<>:
      'Text " is not one of (:*:), (:.:), Par1, M1, Rec1, or U1."
    )

-- | The typeclass implementing `gtabulateM` (as `gtabulateM'`)
-- for `Generic` types
class Monad m => GTabulateM (m :: * -> *) (f :: * -> *) | f -> m where
  gtabulateM' :: (GRepM' f -> m a) -> f a

instance (GTabulateM m f, GTabulateM m g) => GTabulateM m (f :*: g) where
  gtabulateM' f = gtabulateM' (f . Left) :*: gtabulateM' (f . Right)

instance GTabulateM Identity Par1 where
  gtabulateM' = Par1 . runIdentity . extract

instance GTabulateM m f => GTabulateM m (M1 i c f) where
  gtabulateM' = M1 #. gtabulateM'

instance (RepresentableM m f, GTabulateM m g) => GTabulateM m (f :.: g) where
  gtabulateM' f =
    Comp1 $ tabulateM $ fmap (return . gtabulateM') $ fmap (curry f) WrapRepM

instance RepresentableM m f => GTabulateM m (Rec1 f) where
  gtabulateM' = Rec1 #. tabulateM .# (. WrapRepM)

-- | The monadic side-effects must be thrown out,
-- so the `Monad` must be `Identity`
instance GTabulateM Identity U1 where
  gtabulateM' _ = U1

-- | The typeclass implementing `gindexM` (as `gindexM'`)
-- for `Generic` types
class Monad m => GIndexM (m :: * -> *) (f :: * -> *) | f -> m where
  gindexM' :: f a -> (GRepM' f -> m a)

instance (GIndexM m f, GIndexM m g) => GIndexM m (f :*: g) where
  gindexM' ~(a :*: _)  (Left  i) = gindexM' a i
  gindexM' ~(_ :*: b) ~(Right j) = gindexM' b j

instance GIndexM Identity Par1 where
  gindexM' (Par1 a) () = Identity a

instance GIndexM m f => GIndexM m (M1 i c f) where
  gindexM' = gindexM' .# unM1

instance (RepresentableM m f, GIndexM m g) => GIndexM m (f :.: g) where
  gindexM' (Comp1 fg) ~(i, j) = (indexM fg .# unwrapRepM) i >>= (`gindexM'` j)

instance RepresentableM m f => GIndexM m (Rec1 f) where
  gindexM' = (. unwrapRepM) #. indexM .# unRec1

-- `absurd`
instance GIndexM Identity U1 where
  gindexM' U1 = absurd

-- | `WrappedRepM` prevents generic `RepresentableM` instances for
-- recursive types from sending the typechecker into an infinite loop.
--
-- See `WrappedRep`.
newtype WrappedRepM f = WrapRepM { unwrapRepM :: RepM f }

deriving instance Bits (RepM f) => Bits (WrappedRepM f)

deriving instance Bounded (RepM f) => Bounded (WrappedRepM f)

deriving instance (Data (RepM f), Typeable f) => Data (WrappedRepM f)

deriving instance Enum (RepM f) => Enum (WrappedRepM f)

deriving instance Eq (RepM f) => Eq (WrappedRepM f)

deriving instance FiniteBits (RepM f) => FiniteBits (WrappedRepM f)

deriving instance Floating (RepM f) => Floating (WrappedRepM f)

deriving instance Fractional (RepM f) => Fractional (WrappedRepM f)

deriving instance Generic (RepM f) => Generic (WrappedRepM f)

deriving instance Ix (RepM f) => Ix (WrappedRepM f)

deriving instance Monoid (RepM f) => Monoid (WrappedRepM f)

deriving instance Num (RepM f) => Num (WrappedRepM f)

deriving instance Ord (RepM f) => Ord (WrappedRepM f)

deriving instance PrintfArg (RepM f) => PrintfArg (WrappedRepM f)

deriving instance Read (RepM f) => Read (WrappedRepM f)

deriving instance Real (RepM f) => Real (WrappedRepM f)

deriving instance RealFloat (RepM f) => RealFloat (WrappedRepM f)

deriving instance RealFrac (RepM f) => RealFrac (WrappedRepM f)

deriving instance Semigroup (RepM f) => Semigroup (WrappedRepM f)

deriving instance Show (RepM f) => Show (WrappedRepM f)

deriving instance Storable (RepM f) => Storable (WrappedRepM f)

deriving instance Typeable (RepM f) => Typeable (WrappedRepM f)

-- | `Cofree`, `CofreeT` instances
todo :: ()
todo = ()

max_stars_repo_name: michaeljklein/algebraic-foldl

max_issues_repo_name: michaeljklein/algebraic-foldl

max_forks_repo_name: michaeljklein/algebraic-foldl


text:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}

module Arpack.Options where

import Data.Complex

data Which :: * -> * where
  LM :: Which a
  SM :: Which a
  LR :: Which a
  SR :: Which a
  LI :: Which (Complex a)
  SI :: Which (Complex a)

showWhich :: Which a -> String
showWhich LM = "LM"
showWhich SM = "SM"
showWhich LR = "LR"
showWhich SR = "SR"
showWhich LI = "LI"
showWhich SI = "SI"

data Options a = Options { which :: !(Which a)
                         , number :: {-# UNPACK #-} !Int
                         , maxIterations :: !(Maybe Int)
                         }

max_stars_repo_name: ttuegel/arpack

max_issues_repo_name: ttuegel/arpack

max_forks_repo_name: ttuegel/arpack


text:
-- |
-- Module    : Statistics.Test.WilcoxonT
-- Copyright : (c) 2010 Neil Brown
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- The Wilcoxon matched-pairs signed-rank test is non-parametric test
-- which could be used to whether two related samples have different
-- means.
--
-- WARNING: current implementation contain serious bug and couldn't be
-- used with samples larger than 1023.
-- <https://github.com/bos/statistics/issues/18>
module Statistics.Test.WilcoxonT (
    -- * Wilcoxon signed-rank matched-pair test
    wilcoxonMatchedPairTest
  , wilcoxonMatchedPairSignedRank
  , wilcoxonMatchedPairSignificant
  , wilcoxonMatchedPairSignificance
  , wilcoxonMatchedPairCriticalValue
    -- * Data types
  , TestType(..)
  , TestResult(..)
  ) where

--
--
--
-- Note that: wilcoxonMatchedPairSignedRank == (\(x, y) -> (y, x)) . flip wilcoxonMatchedPairSignedRank
-- The samples are zipped together: if one is longer than the other, both are truncated
-- The value returned is the pair (T+, T-).  T+ is the sum of positive ranks (the
-- These values mean little by themselves, and should be combined with the 'wilcoxonSignificant'
-- function in this module to get a meaningful result.
-- ranks of the differences where the first parameter is higher) whereas T- is
-- the sum of negative ranks (the ranks of the differences where the second parameter is higher).
-- to the the length of the shorter sample.

import Control.Applicative ((<$>))
import Data.Function (on)
import Data.List (findIndex)
import Data.Ord (comparing)
import Prelude hiding (sum)
import Statistics.Function (sortBy)
import Statistics.Sample.Internal (sum)
import Statistics.Test.Internal (rank, splitByTags)
import Statistics.Test.Types (TestResult(..), TestType(..), significant)
import Statistics.Types (Sample)
import qualified Data.Vector.Unboxed as U

wilcoxonMatchedPairSignedRank :: Sample -> Sample -> (Double, Double)
wilcoxonMatchedPairSignedRank a b = (sum ranks1, negate (sum ranks2))
  where
    (ranks1, ranks2) = splitByTags
                     $ U.zip tags (rank ((==) `on` abs) diffs)
    (tags,diffs) = U.unzip
                 $ U.map (\x -> (x>0 , x))   -- Attack tags to distribution elements
                 $ U.filter  (/= 0.0)        -- Remove equal elements
                 $ sortBy (comparing abs)    -- Sort the differences by absolute difference
                 $ U.zipWith (-) a b         -- Work out differences

-- | The coefficients for x^0, x^1, x^2, etc, in the expression
-- \prod_{r=1}^s (1 + x^r).  See the Mitic paper for details.
--
-- We can define:
-- f(1) = 1 + x
-- f(r) = (1 + x^r)*f(r-1)
--      = f(r-1) + x^r * f(r-1)
-- The effect of multiplying the equation by x^r is to shift
-- all the coefficients by r down the list.
--
-- This list will be processed lazily from the head.
coefficients :: Int -> [Integer]
coefficients 1 = [1, 1] -- 1 + x
coefficients r = let coeffs = coefficients (r-1)
                     (firstR, rest) = splitAt r coeffs
  in firstR ++ add rest coeffs
  where
    add (x:xs) (y:ys) = x + y : add xs ys
    add xs [] = xs
    add [] ys = ys

-- This list will be processed lazily from the head.
summedCoefficients :: Int -> [Double]
summedCoefficients n
  | n < 1     = error "Statistics.Test.WilcoxonT.summedCoefficients: nonpositive sample size"
  | n > 1023  = error "Statistics.Test.WilcoxonT.summedCoefficients: sample is too large (see bug #18)"
  | otherwise = map fromIntegral $ scanl1 (+) $ coefficients n

-- | Tests whether a given result from a Wilcoxon signed-rank matched-pairs test
-- is significant at the given level.
--
-- This function can perform a one-tailed or two-tailed test.  If the first
-- parameter to this function is 'TwoTailed', the test is performed two-tailed to
-- check if the two samples differ significantly.  If the first parameter is
-- 'OneTailed', the check is performed one-tailed to decide whether the first sample
-- (i.e. the first sample you passed to 'wilcoxonMatchedPairSignedRank') is
-- greater than the second sample (i.e. the second sample you passed to
-- 'wilcoxonMatchedPairSignedRank').  If you wish to perform a one-tailed test
-- in the opposite direction, you can either pass the parameters in a different
-- order to 'wilcoxonMatchedPairSignedRank', or simply swap the values in the resulting
-- pair before passing them to this function.
wilcoxonMatchedPairSignificant ::
     TestType            -- ^ Perform one- or two-tailed test (see description below).
  -> Int                 -- ^ The sample size from which the (T+,T-) values were derived.
  -> Double              -- ^ The p-value at which to test (e.g. 0.05)
  -> (Double, Double)    -- ^ The (T+, T-) values from 'wilcoxonMatchedPairSignedRank'.
  -> Maybe TestResult    -- ^ Return 'Nothing' if the sample was too
                         --   small to make a decision.
wilcoxonMatchedPairSignificant test sampleSize p (tPlus, tMinus) =
  case test of
    -- According to my nearest book (Understanding Research Methods and Statistics
    -- by Gary W. Heiman, p590), to check that the first sample is bigger you must
    -- use the absolute value of T- for a one-tailed check:
    OneTailed -> (significant . (abs tMinus <=) . fromIntegral) <$> wilcoxonMatchedPairCriticalValue sampleSize p
    -- Otherwise you must use the value of T+ and T- with the smallest absolute value:
    TwoTailed -> (significant . (t <=) . fromIntegral) <$> wilcoxonMatchedPairCriticalValue sampleSize (p/2)
  where
    t = min (abs tPlus) (abs tMinus)

-- | Obtains the critical value of T to compare against, given a sample size
-- and a p-value (significance level).  Your T value must be less than or
-- equal to the return of this function in order for the test to work out
-- significant.  If there is a Nothing return, the sample size is too small to
-- make a decision.
--
-- 'wilcoxonSignificant' tests the return value of 'wilcoxonMatchedPairSignedRank'
-- for you, so you should use 'wilcoxonSignificant' for determining test results.
--  However, this function is useful, for example, for generating lookup tables
-- for Wilcoxon signed rank critical values.
--
-- The return values of this function are generated using the method detailed in
-- the paper \"Critical Values for the Wilcoxon Signed Rank Statistic\", Peter
-- Mitic, The Mathematica Journal, volume 6, issue 3, 1996, which can be found
-- here: <http://www.mathematica-journal.com/issue/v6i3/article/mitic/contents/63mitic.pdf>.
-- According to that paper, the results may differ from other published lookup tables, but
-- (Mitic claims) the values obtained by this function will be the correct ones.
wilcoxonMatchedPairCriticalValue ::
     Int                -- ^ The sample size
  -> Double             -- ^ The p-value (e.g. 0.05) for which you want the critical value.
  -> Maybe Int          -- ^ The critical value (of T), or Nothing if
                        --   the sample is too small to make a decision.
wilcoxonMatchedPairCriticalValue sampleSize p
  = case critical of
      Just n | n < 0 -> Nothing
             | otherwise -> Just n
      Nothing -> Just maxBound -- shouldn't happen: beyond end of list
  where
    m = (2 ** fromIntegral sampleSize) * p
    critical = subtract 1 <$> findIndex (> m) (summedCoefficients sampleSize)

-- | Works out the significance level (p-value) of a T value, given a sample
-- size and a T value from the Wilcoxon signed-rank matched-pairs test.
--
-- See the notes on 'wilcoxonCriticalValue' for how this is calculated.
wilcoxonMatchedPairSignificance :: Int    -- ^ The sample size
                                -> Double -- ^ The value of T for which you want the significance.
                                -> Double -- ^ The significance (p-value).
wilcoxonMatchedPairSignificance sampleSize rnk
  = (summedCoefficients sampleSize !! floor rnk) / 2 ** fromIntegral sampleSize

-- | The Wilcoxon matched-pairs signed-rank test. The samples are
-- zipped together: if one is longer than the other, both are
-- truncated to the the length of the shorter sample.
--
-- For one-tailed test it tests whether first sample is significantly
-- greater than the second. For two-tailed it checks whether they
-- significantly differ
--
-- Check 'wilcoxonMatchedPairSignedRank' and
-- 'wilcoxonMatchedPairSignificant' for additional information.
wilcoxonMatchedPairTest :: TestType   -- ^ Perform one-tailed test.
                        -> Double     -- ^ The p-value at which to test (e.g. 0.05)
                        -> Sample     -- ^ First sample
                        -> Sample     -- ^ Second sample
                        -> Maybe TestResult
                        -- ^ Return 'Nothing' if the sample was too
                        --   small to make a decision.
wilcoxonMatchedPairTest test p smp1 smp2 =
    wilcoxonMatchedPairSignificant test (min n1 n2) p
  $ wilcoxonMatchedPairSignedRank smp1 smp2
  where
    n1 = U.length smp1
    n2 = U.length smp2


text:
module Main where

import Criterion.Main

import Data.List as L
import Data.Set as Set

testlist :: [Int]
testlist = [0..9]

naiveSubseq :: Int -> [Int] -> [[Int]]
naiveSubseq n = L.filter ((==n) . length) . subsequences

yanaiveSubseq :: Int -> [Int] -> [[Int]]
yanaiveSubseq n []
  | n == 0    = [[]]
  | otherwise = []
yanaiveSubseq 0 (_:_) = [[]]
yanaiveSubseq n (x:xs) = yanaiveSubseq n xs ++ fmap (x:) (yanaiveSubseq (n-1) xs)

setSubseq :: Int -> [Int] -> [[Int]]
setSubseq n = Set.toList . Set.mapMonotonic Set.toList . Set.filter ((==n) . Set.size) . powerSet . fromList

main :: IO ()
main = defaultMain [
  bgroup "subseq" [
      bench "L.subsequences" $ nf (naiveSubseq 5) testlist,
      bench "yanaiveSubseq" $ nf (yanaiveSubseq 5) testlist,
      bench "Set.powerSet" $ nf (setSubseq 5) testlist] ]

{-- Benchmark for matrix normal forms.
import Data.List as L
import Data.Matrix as Mat

import Numeric.LinearAlgebra

import Numeric.Algebra.FreeModule
import Numeric.Algebra.Frobenius
import qualified Numeric.Algebra.IntMatrix.HNFLLL as HASKHNF
import qualified Numeric.Algebra.IntMatrix.NormalForms as FFIHNF

import qualified Numeric.Algebra.IntMatrix.SmithNF as HASKSMITH

testmat1 = (100 >< 100) $ cycle [-2,-1,0,1,2,3,4]

hasIntersection :: Eq a => [a] -> [a] -> Bool
hasIntersection x y = not $ L.null (x `L.intersect` y)

testSL2B :: Int -> [(Int,SL2B)]
testSL2B n = zip [1..n] (cycle [SLI,SLI,SLX])

divides :: Int -> Int -> Bool
divides m n = n `rem` m == 0

main :: IO ()
main = defaultMain [
  bgroup "hermiteNF" [
      bench "pure Haskell" $ nf HASKHNF.hnfLLL testmat1,
      bench "ffi" $ nf FFIHNF.hermiteNF testmat1 ],
  bgroup "smithNF" [
      bench "Haskell" $ nf HASKSMITH.smithNF testmat1,
      bench "ffi" $ nf FFIHNF.smithNF testmat1 ],
  bgroup "TQFT operation" [
      bench "tqftZ" $ nf (genMatrixAR (tqftZ divides (testSL2B 200))) (subsequences [1..11]) ] ]
--}

max_stars_repo_name: Junology/linkedgram

max_issues_repo_name: Junology/linkedgram

max_forks_repo_name: Junology/linkedgram


text:
{-# LANGUAGE ForeignFunctionInterface #-}

-- $ ghc -O2 --make wrappers.hs functions.c

import Numeric.LinearAlgebra
import Data.Packed.Development
import Foreign(Ptr,unsafePerformIO)
import Foreign.C.Types(CInt)

-----------------------------------------------------

main = do
    print $ myDiag $ (3><5) [1..]

-----------------------------------------------------
-- arbitrary data order

foreign import ccall unsafe "c_diag"
    cDiag :: CInt                        -- matrix order
          -> CInt -> CInt -> Ptr Double  -- argument
          -> CInt -> Ptr Double          -- result1
          -> CInt -> CInt -> Ptr Double  -- result2
          -> IO CInt                     -- exit code

myDiag m = unsafePerformIO $ do
    y <- createVector (min r c)
    z <- createMatrix (orderOf m) r c
    app3 (cDiag o) mat m vec y mat z "cDiag"
    return (y,z)
  where r = rows m
        c = cols m
        o = if orderOf m == RowMajor then 1 else 0

max_stars_repo_name: curiousleo/liquidhaskell

max_issues_repo_name: curiousleo/liquidhaskell

max_forks_repo_name: curiousleo/liquidhaskell


text:
module MarkovChain
    (
    markov
    ) where

import Numeric.LinearAlgebra
import Text.ParserCombinators.Parsec

matParse = sepBy line (char ';')
line = sepBy cell (char ',' )
cell = many ( noneOf ",\n;" )

stringToTranstionMatrix :: String -> Either ParseError [[String]]
stringToTranstionMatrix str = parse matParse "unknown" str

markov matStr = stringToTranstionMatrix matStr

max_stars_repo_name: dilawar/MarkovChains

max_issues_repo_name: dilawar/MarkovChains

max_forks_repo_name: dilawar/MarkovChains


text:
{-# LANGUAGE ViewPatterns #-}
import Numeric.GSL.ODE
import Numeric.LinearAlgebra
import Graphics.Plot
import Debug.Trace(trace)
debug x = trace (show x) x

vanderpol mu = do
    let xdot mu t [x,v] = [v, -x + mu * v * (1-x^2)]
        ts = linspace 1000 (0,50)
        sol = toColumns $ odeSolve (xdot mu) [1,0] ts
    mplot (ts : sol)
    mplot sol

harmonic w d = do
    let xdot w d t [x,v] = [v, a*x + b*v] where a = -w^2; b = -2*d*w
        ts = linspace 100 (0,20)
        sol = odeSolve (xdot w d) [1,0] ts
    mplot (ts : toColumns sol)

kepler v a = mplot (take 2 $ toColumns sol) where
    xdot t [x,y,vx,vy] = [vx,vy,x*k,y*k]
        where g=1
              k=(-g)*(x*x+y*y)**(-1.5)
    ts = linspace 100 (0,30)
    sol = odeSolve xdot [4, 0, v * cos (a*degree), v * sin (a*degree)] ts
    degree = pi/180

main = do
    vanderpol 2
    harmonic 1 0
    harmonic 1 0.1
    kepler 0.3 60
    kepler 0.4 70
    vanderpol' 2

-- example of odeSolveV with jacobian
vanderpol' mu = do
    let xdot mu t (toList->[x,v]) = fromList [v, -x + mu * v * (1-x^2)]
        jac t (toList->[x,v]) = (2><2) [ 0          ,          1
                                       , -1-2*x*v*mu, mu*(1-x**2) ]
        ts = linspace 1000 (0,50)
        hi = (ts@>1 - ts@>0)/100
        sol = toColumns $ odeSolveV (MSBDF jac) hi 1E-8 1E-8 (xdot mu) (fromList [1,0]) ts
    mplot sol


text:
{-# LANGUAGE ViewPatterns, MagicHash, BangPatterns #-}

module CVUtils where

import Codec.Image.DevIL
import Data.Array.Unboxed
import Math.Probably.MCMC
import Math.Probably.Sampler
import Math.Probably.FoldingStats
import Control.Monad.State.Strict
import System.Cmd
import System.Environment
import Data.Array.IO
import System.IO

import Data.Array.Unboxed
import Numeric.LinearAlgebra hiding (find)
import qualified Math.Probably.PDF as PDF
import Data.List
import Data.Maybe
import Control.Applicative
import Data.Ord

import Data.IORef
import System.IO.Unsafe
import Data.BitArray

import GHC.Exts
import GHC.Word

type R = Double

type Pos = (R,R)
type Image = UArray (Int, Int, Int) Word8
type MImage = IOUArray (Int, Int, Int) Word8
data BitImage = BitImage Int BitArray

mkBitImage :: Int -> Int -> (Int -> Int -> Bool) -> BitImage
mkBitImage hix hiy f = BitImage hiy $ bitArray (0,(hix)*(hiy)-1) [ (x*hiy+y, f x y) | x<- [0..hix-1], y<- [0..hiy-1]]

readBitImage :: BitImage -> Int -> Int -> Bool
readBitImage (BitImage hiy im) x y = unsafeLookupBit im (x*hiy+y)

{-track1 :: Image -> [Obj] -> Image -> Sampler Obj
track1 bgIm objs im =
   samplingImportanceResampling $ particleLike bgIm im objs -}

type Square = (Pos,Pos)

within ((lox,loy), (hix,hiy)) ox oy
       =    ox > min lox hix
         && ox < max lox hix
         && oy > min loy hiy
         && oy < max loy hiy

data Obj =
  Obj {vellen :: !R,
       sideDisp :: !R,
       objlen:: !R,
       posx :: !R,
       posy :: !R,
       rot :: !R  } deriving Show

fileroot = reverse . takeWhile (/='/') . reverse . takeWhile (/='.')

print2 x y = putStrLn $ x ++show y

smallest ws = foldl1' (min) $ map snd ws
largest ws = map snd $ sortBy (comparing snd) ws
sumWeights ws = sum $ map ( (subtr (smallest ws)) . snd) ws
cummWeightedSamples ws=
   let least = smallest ws
   in scanl (\(_,csum) (x,w) -> (x,csum+ (w-least))) (fst $ head ws ,0) ws

dropLosers ws =
  let topW = foldl1' (max) $ map snd ws
      p (x,w) = w>topW-100
  in sortBy (comparing snd) $ filter p ws

subtr x y = y - x

maxOn f xs = ceiling $ foldl1' max $ map f xs
minOn f xs = floor $ foldl1' min $ map f xs

data StaticParams = SP {noise :: !R,
                        wlength :: !R,
                        eccentric :: !R } deriving Show

dist :: R -> R -> Int ->Int -> R
dist  !cx !cy !x !y  = let !dx = cx-(unround x+0.5)
                           !dy = cy-(unround y+0.5)
                       in sqrt(dx*dx + dy*dy)

dist' :: R -> R -> Int ->Int -> R
dist' (D# cx) (D# cy) (I# x) (I# y)
       = let !dx = cx -## (int2Double# x+##half)
             !dy = cy -## (int2Double# y+##half)
             !(D# half) = 0.5
         in  D# (sqrtDouble# (dx*##dx +## dy*##dy))

gaussW8 :: R -> Word8 -> Word8 -> R
gaussW8 tau muw8 = lpdf . word8ToR
   where lpdf x = log (sqrt (tau/2.0*pi)) + (0.0-((x-mu)*(x-mu)*tau))
         mu = word8ToR  muw8
gaussR :: R-> R -> Word8 -> R
gaussR tau mu = lpdf . word8ToR
   where lpdf :: R -> R
         lpdf x = log (sqrt (tau/2.0*pi)) + (0.0-((x-mu)*(x-mu)*tau))

--no-noise versions
gaussW8nn :: R -> Word8 -> Word8 -> R
gaussW8nn tau muw8 = lpdf . word8ToR
   where lpdf x = let y = x - mu in negate $ y*y
         mu = word8ToR  muw8
gaussRnn :: R-> R -> Word8 -> R
gaussRnn tau mu = lpdf . word8ToR
   where lpdf :: R -> R
         lpdf x = let y = x - mu in negate $ y*y

word8ToR :: Word8 -> R
--word8ToR (W8# whash) = (/256) $ F# $ int2Float# $ word2Int# whash
word8ToR (W8# whash) = (/256) $ D# $ int2Double# $ word2Int# whash
realToW8 :: R -> Word8
realToW8 =  round . (*256)

unround :: Int -> R
--word8ToR (W8# whash) = (/256) $ F# $ int2Float# $ word2Int# whash
unround (I# whash) = D# $ int2Double# whash

markObjsOnImage :: [Obj] -> Image -> IO (Image)
markObjsOnImage objs im = do
    mutIm <- thaw im
    forM_ objs $ \(Obj _ _ _ cx cy _) -> do
          writeArray mutIm (round cy, round cx, 2) 255
          writeArray mutIm (round cy, round cx, 0) 0
          writeArray mutIm (round cy, round cx, 1) 0

    freeze (mutIm::MImage)

--updateBgIm :: Image ->

mkRed arr cx cy = do
          writeArray arr ( cy,
                             cx, 0) 255
--          writeArray arr ( cy,
--                             cx, 1) 0
--          writeArray arr ( cy,
--                             cx, 2) 0

markEllipse :: StaticParams -> Obj -> Image -> IO (Image)
markEllipse sp@(SP noise _ ecc) (Obj _ _ len px py rot) im = do
    mutIm <- thaw im

    let cx = round px
    let cy = round py
        f1x = px+(len*ecc)*cos rot
        f1y = py+(len*ecc)*sin rot
        f2x = px-(len*ecc)*cos rot
        f2y = py-(len*ecc)*sin rot
    let f x y = do -- print2 "f at" (x,y,dist (f1x,f1y) (x, y) + dist (f2x,f2y) (x, y) )
                   when (dist  f1x f1y   x  y  + dist  f2x f2y   x  y  < 2 * len) $ do
                      --print2 "red at " (x,y)
                      mkRed mutIm x y
                      return ()
    sequence_ [ f x y  |
                   x <- [ (cx::Int) -50.. cx +50],
                   y <- [ cy -50.. cy +50]]
    freeze (mutIm::MImage)

uniformLogPdf :: R -> R-> R-> R
uniformLogPdf from to = \x-> if x>=from && x <=to
                               then log $ realToFrac $ 1/(to-from )
                               else -1e20

max_stars_repo_name: glutamate/cvutils

max_issues_repo_name: glutamate/cvutils

max_forks_repo_name: glutamate/cvutils


text:
module Statistics.Information.Continuous.MutualInfo where

import Data.Matrix
import Numeric.SpecFunctions
import Statistics.Information.Utils.KNN
import Statistics.Information.Utils.Random
import System.Random

mi :: RandomGen g => g -> Int -> Int -> Matrix Double -> Matrix Double -> Double
mi g k base xs ys | (k < nrows xs) && (nrows xs == nrows ys) =
  (-a - b + c + d) / (log $ fromIntegral base)
  where
    (g1, g2) = split g
    noisyxs = noisy g1 xs
    noisyys = noisy g2 ys
    joint = noisyxs <|> noisyys
    distances = knnDistances chebyshevDistance (toLists joint) k
    a = avgdigamma chebyshevDistance noisyxs distances
    b = avgdigamma chebyshevDistance noisyys distances
    c = digamma (fromIntegral k)
    d = digamma . fromIntegral . nrows $ xs

cmi :: RandomGen g => g -> Int -> Int -> Matrix Double -> Matrix Double ->
       Matrix Double -> Double
cmi g k base xs ys zs | (k < nrows xs) && (nrows xs == nrows ys) =
  (-a - b + c + d) / (log $ fromIntegral base)
  where
    [g1, g2, g3] = splitN 3 g
    noisyxs = noisy g1 xs
    noisyys = noisy g2 ys
    noisyzs = noisy g3 zs
    joint = noisyxs <|> noisyys <|> noisyzs
    distances = knnDistances chebyshevDistance (toLists joint) k
    a = avgdigamma chebyshevDistance (noisyxs <|> noisyzs) distances
    b = avgdigamma chebyshevDistance (noisyys <|> noisyzs) distances
    c = avgdigamma chebyshevDistance noisyzs distances
    d = digamma (fromIntegral k)

max_stars_repo_name: eligottlieb/Shannon

max_issues_repo_name: eligottlieb/Shannon

max_forks_repo_name: eligottlieb/Shannon


text:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses, RankNTypes #-}
-----------------------------------------------------------------------------
--
-- Module      :  AI.Network.RNN.Types
-- Copyright   :  (c) JP Moresmau
-- License     :  BSD3
--
-- Maintainer  :  JP Moresmau <jp@moresmau.fr>
-- Stability   :  experimental
-- Portability :
--
-- | Types and some basic functions on them
--
-----------------------------------------------------------------------------

module AI.Network.RNN.Types where

import Control.DeepSeq
import Control.Monad.Random
import Data.List
import Data.Tuple
import Numeric.LinearAlgebra.HMatrix as M

import AI.Network.RNN.Util

import Debug.Trace

-- | Class for RNN evaluation
class (NFData a) => RNNEval a where
    type Size a
    -- | Eval one step
    evalStep   :: a -> Vector Double -> (a,Vector Double)
    -- | Transform to vector
    toVector   :: a -> Vector Double
    -- | Build from vector representation
    fromVector :: Size a -> Vector Double -> a
    -- | Transform to vector
    toDList   :: a -> [Double]
    toDList = toList . toVector
    -- | Build from vector representation
    fromDList :: Size a -> [Double] -> a
    fromDList sz = fromVector sz . M.fromList
    -- | Get the size
    rnnsize    :: a -> Size a
    -- | full size
    fullSize   :: a -> Int

instance (RNNEval a) => RNNEval [a] where
    type Size [a]   = [Size a]
    evalStep xs v = swap $ mapAccumL e v xs
        where e v1 x1 =
                let (x2,v2) = evalStep x1 v1
                in (v2,x2)
    toVector = vjoin . map toVector
    fromVector sz vs = snd $ mapAccumL e vs sz
        where e v1 s1 =
                let x1 = fromVector s1 v1
                    fs1 = fullSize x1
                in (subVector fs1 (size v1 - fs1) v1,x1)
    rnnsize = map rnnsize
    fullSize = sum . map fullSize

-- | Full size of a network: the total number of weights required
type FullSize sz = Size sz -> Int

-- | Eval several steps
evalSteps :: (Traversable t,RNNEval a) => a -> t (Vector Double) -> (a,t (Vector Double))
evalSteps = mapAccumL evalStep

-- | Cost function: lower is better
cost :: (RNNEval a) => a -> TrainData b -> Double
cost rnn td =
    let (_,res) = evalSteps rnn $ tdInputs td
    in (sum $ zipWith err (tdOutputs td) res)
    where
      err ::  Vector Double -> Vector Double -> Double
      --err tgt res =let
      --  norm = cmap (\x->if x>=0.5 then 1 else 0) res
      --  in euclidian  tgt norm
      err = euclidian
       --sum ( zipWith (\c d -> (c- d)**2 ) (toList a) (toList b)) / fromIntegral (size a)
      errsf a b = sum ( zipWith (\c d -> if c==1 then (c- d) else 0) (toList a) (softmax $ toList b))
      sf :: Vector Double -> Vector Double -> Double
      --sf a b = sum ( zipWith (\c d -> if c==1 then log d else 0 ) (toList a) (softmax $ toList b))
      sf a b = log $ (softmaxV b) ! (maxIndex a)
       -- sum ( zipWith (\c d -> if c==1 then log d else 0 ) (toList a) (softmax $ toList b))

-- | Build a random network of a given size, with weights uniformly between 0 and 1
randomNetwork
    :: (RNNEval a,Monad m,RandomGen g)
    => Size a
    -> FullSize a
    -> RandT g m a
randomNetwork sz fsz = do
    s <- getRandom
    return $ fromVector sz $ randomVector s Uniform $ fsz sz

startNetwork :: (RNNEval a)
    => Size a
    -> FullSize a
    -> a
startNetwork sz fsz = fromVector sz $ konst 0.1 (fsz sz)

-- | Training data
data TrainData a = TrainData
    { tdInputs  :: ![Vector Double]
    , tdOutputs :: ![Vector Double]
    , tdRecSize :: !Int
    , tdData    :: a}

class Contains a where
    type ContainsSize a
    buildContains :: ContainsSize a -> a
    toCList :: a -> [Int]

--data Training a c = Training (ContainsSize a) c
--
--randomContains :: (Contains a) => ContainsSize a -> a
--randomContains = buildContains
--
--fromTraining :: (Contains a)=>Training a c -> a
--fromTraining (Training sz d)= buildContains sz
--
--fromTrainingToList :: (Contains a)=>Training a c -> [Int]
--fromTrainingToList (Training sz d)=toCList $ buildContains sz

max_stars_repo_name: JPMoresmau/rnn

max_issues_repo_name: JPMoresmau/rnn

max_forks_repo_name: JPMoresmau/rnn


text:
{-# LANGUAGE FlexibleContexts #-}

module Learn
  ( newManager
  , defaultManagerSettings
  , initNN
  , hotone
  , convertTrains
  , convertTests
  , trainingSimple
  , chunksOf
  ) where

import           Data.Bifunctor
import           Data.List
import           Data.List.Split
import           Debug.Trace
import           Layers
import           Mnist
import           Network.HTTP.Client
import           Numeric.LinearAlgebra

normalAffine :: Int -> Int -> IO (ForwardLayer R)
normalAffine nIn nOut = do
  weights <- rand nIn nOut
  bias <- flatten <$> rand nOut 1
  return $ AffineForward weights bias

initNN :: ForwardLayer R -> [Int] -> IO (ForwardNN R)
initNN eoa ns = do
  (lastAffine:affines) <- mapM (uncurry normalAffine) $ spans [] ns
  let layers = foldl' (\b a -> a ~> eoa ~> b) lastAffine affines
  return $ ForwardNN layers SoftmaxWithCrossForward
  where
    spans rs [a, b]   = (a, b) : rs
    spans rs (a:b:xs) = spans ((a, b) : rs) (b : xs)

convertTrains :: Int -> MnistData -> [TrainBatch R]
convertTrains batchSize (MnistData src) =
  map (mkTrainer . unzip) $ chunksOf batchSize vectors
  where
    vectors = map (bimap (hotone 10) flatten) src
    mkTrainer (a, b) = TrainBatch (fromRows a, fromZ (fromRows b) / 255)

hotone :: (Integral v, NElement a) => Int -> v -> Vector a
hotone n' v = fromList $ map fromIntegral list
  where
    n = if i < n' then n' else error ("Too large value: " ++ show i)
    list = replicate i 0 ++ 1 : replicate (n - i - 1) 0
    i = fromIntegral v

convertTests :: MnistData -> [(Int, Vector R)]
convertTests (MnistData src) =
  map (bimap fromIntegral $ (/ 255) . flatten . fromZ) src

trainingSimple ::
     Double
  -> Int
  -> Int
  -> ForwardNN R
  -> MnistData
  -> MnistData
  -> ([Double], Double)
trainingSimple rate batchSize nReplicate nn trainData testData =
  (losses, evaluate layers $ convertTests testData)
  where
    trainBatches = convertTrains batchSize trainData
    batches = concat $ replicate nReplicate trainBatches
    (ForwardNN layers _, losses) = learnAll rate nn batches


text:
{-# LANGUAGE OverloadedStrings #-}
module Lisp.EvalSpec (spec) where

import           Test.Hspec
import           Test.QuickCheck

import           Data.Complex
import           Data.Ratio
import           Data.Text

import           Lisp
import           Lisp.LispVal    (h2l)

spec :: Spec

spec = do
  describe "Basic primitives self-eval" $ do
    it "Ints self-eval" $
      property $ \i -> let l = Int i in eval l == l

    it "Reals self-eval" $
      property $ \r -> let l = Real r in eval l == l

    it "Rationals self-eval" $
      property $ \q -> let l = Rational q in eval l == l

    it "Complex numbers self-eval" $
      property $ \c -> let l = Complex c in eval l == l

    it "Strings self-eval" $
      property $ \s -> let l = String (pack s) in eval l == l

    it "Bools self-eval" $
      property $ \b -> let l = Bool b in eval l == l

  describe "quoted forms return their contents" $ do
    let quoted v = Pair (Symbol "quote") (Pair v Nil)
    let foo = Symbol "foo"
    let bar = Symbol "bar"
    let foobar = Pair foo bar
    it "'foo evaluates to foo" $
      eval (quoted foo) `shouldBe` foo
    it "'(foo . bar) evaluates to (foo . bar)" $
      eval (quoted foobar) `shouldBe` foobar

  describe "basic primitives" $ do
    it "Can add two Ints" $
      eval (h2l [Symbol "+", Int 5, Int 5]) `shouldBe` Int 10
    it "Can add two Reals" $
      eval (h2l [Symbol "+", Real 5.0, Real 5.0]) `shouldBe` Real 10.0
    it "Can add Ints and Reals" $
      eval (h2l [Symbol "+", Int 5, Real 5.0]) `shouldBe` Real 10.0
    it "Can add Rationals and Complex" $
      eval (h2l [Symbol "+", Rational (5%2), Complex (2.4:+3.1)]) `shouldBe` Complex (4.9:+3.1)

max_stars_repo_name: blaisepascal/Haskell-LiSP

max_issues_repo_name: blaisepascal/Haskell-LiSP

max_forks_repo_name: blaisepascal/Haskell-LiSP


text:
module Numeric.LinearAlgebra.Matrix
( module C
, module M44
, module M33
, Mat44
, Mat33
) where

import Numeric.LinearAlgebra.Matrix.Class as C
import Numeric.LinearAlgebra.Matrix.Mat44 as M44 hiding (Mat44(..))
import Numeric.LinearAlgebra.Matrix.Mat44 (Mat44)
import Numeric.LinearAlgebra.Matrix.Mat33 as M33 hiding (Mat33(..))
import Numeric.LinearAlgebra.Matrix.Mat33 (Mat33)

max_stars_repo_name: dagit/lin-alg

max_issues_repo_name: dagit/lin-alg

max_forks_repo_name: dagit/lin-alg


text:
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if MIN_VERSION_base(4,9,0)
{-# LANGUAGE TypeApplications    #-}
#endif

{-# OPTIONS_GHC -Wall #-}

{- | This module contains a bunch of pre-defined proxies
     so that users don't /always/ have to write @(Proxy :: Proxy Word8)@,
     etc.

     It is recommended that you import this module qualified to avoid
     naming conflicts.
-}

module Proxy
  ( Proxy1(..)
  , Proxy2(..)
  , bool
  , char
#if MIN_VERSION_base(4,7,0)
  , complex
#endif
#if MIN_VERSION_base(4,9,0)
  , compose
#endif
#if MIN_VERSION_base(4,7,0)
  , const
#endif
  , constr
#if MIN_VERSION_base(4,9,0)
  , constraint
#endif
  , datarep
  , datatype
  , dynamic
  , e0
  , e1
  , e2
  , e3
  , e6
  , e9
  , e12
#if MIN_VERSION_base(4,7,0)
  , either
#endif
#if MIN_VERSION_base(4,7,0)
  , fixed
#endif
  , fixity
#if MIN_VERSION_base(4,10,0)
  , hrefl
#endif
#if MIN_VERSION_base(4,8,0)
  , identity
#endif
#if MIN_VERSION_base(4,7,0)
  , ioref
#endif
  , int
  , int8
  , int16
  , int32
  , int64
  , ordering
#if MIN_VERSION_base(4,9,0)
  , functorproduct
#endif
#if MIN_VERSION_base(4,7,0)
  , refl
#endif
  , string
#if MIN_VERSION_base(4,9,0)
  , functorsum
#endif
  , word
  , word8
  , word16
  , word32
  , word64
  , unique
  , version
#if MIN_VERSION_base(4,8,0)
  , void
#endif

#if MIN_VERSION_base(4,9,0)
  , mkProxy1
  , mkProxy2
#endif
  ) where

import Data.Complex (Complex)
import Data.Data (Constr, DataType, DataRep, Fixity)
import Data.Dynamic (Dynamic)
#if MIN_VERSION_base(4,7,0)
import Data.Fixed (Fixed, E0, E1, E2, E3, E6, E9, E12)
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Functor.Compose (Compose)
#endif
#if MIN_VERSION_base(4,7,0)
import Data.Functor.Const (Const)
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity
#endif
#if MIN_VERSION_base(4,9,0)
import qualified Data.Functor.Product as Functor
#endif
#if MIN_VERSION_base(4,9,0)
import qualified Data.Functor.Sum as Functor
#endif
#if MIN_VERSION_base(4,7,0)
import Data.IORef (IORef)
#endif
import Data.Int (Int8, Int16, Int32, Int64)
#if MIN_VERSION_base(4,9,0)
import Data.Kind (Constraint)
#endif
import Data.Proxy (Proxy(..))
import Data.Word (Word8, Word16, Word32, Word64)
#if MIN_VERSION_base(4,7,0)
import Data.Type.Equality
  ( (:~:)
#if MIN_VERSION_base(4,10,0)
  , (:~~:)
#endif
  )
#endif
import Data.Unique (Unique)
import Data.Version (Version)
#if MIN_VERSION_base(4,8,0)
import Data.Void (Void)
#endif

import Prelude hiding (const, either, product, sum)

-- | In older versions of GHC, Proxy is not poly-kinded,
--   so we provide Proxy1.
data Proxy1 (f :: * -> *) = Proxy1

-- | In older versions of GHC, Proxy is not poly-kinded,
--   so we provide Proxy2.
data Proxy2 (f :: * -> * -> *) = Proxy2

bool :: Proxy Bool
bool = Proxy

char :: Proxy Char
char = Proxy

#if MIN_VERSION_base(4,7,0)
complex :: Proxy Complex
complex = Proxy
#endif

#if MIN_VERSION_base(4,9,0)
compose :: Proxy Compose
compose = Proxy
#endif

#if MIN_VERSION_base(4,7,0)
const :: Proxy Const
const = Proxy
#endif

constr :: Proxy Constr
constr = Proxy

#if MIN_VERSION_base(4,9,0)
constraint :: Proxy Constraint
constraint = Proxy
#endif

datarep :: Proxy DataRep
datarep = Proxy

datatype :: Proxy DataType
datatype = Proxy

dynamic :: Proxy Dynamic
dynamic = Proxy

#if MIN_VERSION_base(4,7,0)
either :: Proxy Either
either = Proxy
#endif

#if MIN_VERSION_base(4,7,0)
fixed :: Proxy Fixed
fixed = Proxy
#endif

e0 :: Proxy E0
e0 = Proxy

e1 :: Proxy E1
e1 = Proxy

e2 :: Proxy E2
e2 = Proxy

e3 :: Proxy E3
e3 = Proxy

e6 :: Proxy E6
e6 = Proxy

e9 :: Proxy E9
e9 = Proxy

e12 :: Proxy E12
e12 = Proxy

fixity :: Proxy Fixity
fixity = Proxy

#if MIN_VERSION_base(4,10,0)
hrefl :: Proxy (:~~:)
hrefl = Proxy
#endif

#if MIN_VERSION_base(4,8,0)
identity :: Proxy Identity
identity = Proxy
#endif

#if MIN_VERSION_base(4,7,0)
ioref :: Proxy IORef
ioref = Proxy
#endif

int :: Proxy Int
int = Proxy

int8 :: Proxy Int8
int8 = Proxy

int16 :: Proxy Int16
int16 = Proxy

int32 :: Proxy Int32
int32 = Proxy

int64 :: Proxy Int64
int64 = Proxy

#if MIN_VERSION_base(4,9,0)
functorproduct :: Proxy Functor.Product
functorproduct = Proxy
#endif

#if MIN_VERSION_base(4,7,0)
refl :: Proxy (:~:)
refl = Proxy
#endif

string :: Proxy String
string = Proxy

#if MIN_VERSION_base(4,9,0)
functorsum :: Proxy Functor.Sum
functorsum = Proxy
#endif

word :: Proxy Word
word = Proxy

word8 :: Proxy Word8
word8 = Proxy

word16 :: Proxy Word16
word16 = Proxy

word32 :: Proxy Word32
word32 = Proxy

word64 :: Proxy Word64
word64 = Proxy

ordering :: Proxy Ordering
ordering = Proxy

unique :: Proxy Unique
unique = Proxy

version :: Proxy Version
version = Proxy

#if MIN_VERSION_base(4,8,0)
void :: Proxy Void
void = Proxy
#endif

#if MIN_VERSION_base(4,9,0)
mkProxy1 :: forall f a. Proxy (f a)
mkProxy1 = Proxy @(f a)

mkProxy2 :: forall f a b. Proxy (f a b)
mkProxy2 = Proxy @(f a b)
#endif

max_stars_repo_name: chessai/proxy

max_issues_repo_name: chessai/proxy

max_forks_repo_name: chessai/proxy


text:
module FinancialTimeseries.Optimize.Optimize where

import Data.Function (on)
import Data.Distributive (Distributive)

import qualified Data.List as List

import qualified Data.Vector as Vec

import Data.Maybe (catMaybes)

import qualified Statistics.Test.StudentT as StudentT
import qualified Statistics.Test.Types as TTypes
import qualified Statistics.Types as Types

import FinancialTimeseries.Algorithm.Evaluate (Profit, long)

import FinancialTimeseries.Statistics.Statistics (tradeStatistics, trMeanYield, moments, sampleSize, yield)

import FinancialTimeseries.Type.Long (Long(..))
import qualified FinancialTimeseries.Type.Strategy as Strategy
import FinancialTimeseries.Type.Strategy (Strategy(Strategy))
import FinancialTimeseries.Type.Timeseries (TimeseriesRaw, slice)
import FinancialTimeseries.Type.Types (TradeYield(..), Invested(..), partitionInvested)

data Metrics a = Metrics {
  name :: String
  , metrics :: a
  } deriving (Show, Eq, Ord)

data Config optParams price a = Config {
  strategy :: [Strategy optParams price a]
  , evaluationMetrics :: Vec.Vector a -> Metrics a
  }

timeseriesYield :: (Real a, Floating a) => Vec.Vector a -> Metrics a
timeseriesYield vs =
  let stats = tradeStatistics vs
  in Metrics {
    name = "timeseriesYield"
    , metrics = trMeanYield (moments stats) ** fromIntegral (sampleSize stats)
    }

tradeMeanYield :: (Real a, Floating a) => Vec.Vector a -> Metrics a
tradeMeanYield vs =
  let stats = tradeStatistics vs
  in Metrics {
    name = "tradeMeanYield"
    , metrics = trMeanYield (moments stats)
    }

evalStrategy ::
  (Distributive price, Profit price, Fractional a) =>
  TimeseriesRaw price a
  -> Strategy optParams price a
  -> Long (TradeYield (Invested (Vec.Vector a)))
evalStrategy ts (Strategy _ ps stgy) =
  let t = stgy ps ts
      lg = long (partitionInvested (slice t))
      k = fmap (Vec.fromList . map (yield . Vec.map snd))
  in fmap (fmap (snd . fmap k)) lg

equalDistribution ::
  (Real a) =>
  Int -> Types.PValue Double -> Long (TradeYield (Invested (Vec.Vector a))) -> Bool
equalDistribution n pval (Long (TradeYield (Invested vs))) =
  let x = ceiling ((fromIntegral (Vec.length vs) / fromIntegral n) :: Double)

      f xs | Vec.length xs == 0 = []
      f xs = chunk xs

      chunk = (\(as, bs) -> as : f bs) . Vec.splitAt x
      cs = chunk (Vec.map realToFrac vs)

      ds = catMaybes (zipWith (StudentT.studentTTest TTypes.SamplesDiffer) cs (tail cs))
      es = map (TTypes.isSignificant pval) ds

  in all (==TTypes.NotSignificant) es

optimize ::
  (Distributive price, Profit price, Fractional a, Real a, Floating a) =>
  Config optParams price a -> TimeseriesRaw price a -> [(optParams, Metrics a)]
optimize (Config strgies metr) ts =
  let ss = map (\stgy -> (Strategy.parameters stgy, evalStrategy ts stgy)) strgies

      n = 10
      pval = Types.mkPValue 0.05

      bs = filter (equalDistribution n pval . snd) ss

      f (Long (TradeYield (Invested vs))) = metr vs
      cs = map (fmap f) bs

      ds = List.sortBy (compare `on` snd) cs
  in ds

max_stars_repo_name: fphh/financial-timeseries

max_issues_repo_name: fphh/financial-timeseries

max_forks_repo_name: fphh/financial-timeseries