Vector.hs

{-# LANGUAGE FlexibleContexts , BangPatterns #-}
module Perceptron.Vector  
    ( SparseVector
    , LocalSparseVector
    , DenseVector
    , DenseVectorST
    , toSV
    , for_
    , plus_
    , minus_
    , plus
    , minus
    , scale
    , dot 
    , dot'
    )
where

import Data.Array.ST
import Data.Array.Unboxed
import Control.Monad.ST
import Data.STRef
import Control.Monad
import qualified Data.Map as Map
import Data.List (foldl',sort)
import Config
import qualified Data.Vector.Unboxed as V


type SparseVector i = Map.Map i Float
type LocalSparseVector y i = (y,V.Vector i)
type DenseVectorST s i = STUArray s i Float
type DenseVector i = UArray i Float



for_ xs f = mapM_ f xs

plus_ :: (Show i,Ix i) => DenseVectorST s i -> SparseVector i -> ST s ()
plus_ w v = do
  for_ (Map.toList v) $ \(i,vi) -> do
              wi <- readArray w i 
              writeArray w i (wi + vi)
minus_ w v = plus_ w (v `scale` (-1))

scale :: (Ix i)  => SparseVector i -> Float -> SparseVector i
scale v n = Map.map (*n) v

plus :: (Ix i)  => SparseVector i -> SparseVector i -> SparseVector i
plus u v = Map.unionWith (+) u v
minus :: (Ix i)  => SparseVector i -> SparseVector i -> SparseVector i
minus u v = u `plus` (v `scale` (-1))


dot :: DenseVector (Int,Int) -> LocalSparseVector Int Int -> Float
{-# INLINE dot #-}
dot w (!y,x) = V.foldl' (\ !z !i -> z + w ! (y,i)) 0 x
{-
dot w (!y,v) = go 0 v
    where go !s [] = s
          go !s (!i:v) = go (s + w ! (y,i)) v
-}

dot' :: (Float,DenseVector (Int,Int),DenseVector (Int,Int)) 
     -> LocalSparseVector Int Int 
     -> Float
{-# INLINE dot' #-}
dot' (!c,params,params_a) (!y,x) = V.foldl' (\ !z !i -> 
                                                 let e   = params   ! (y,i)
                                                     e_a = params_a ! (y,i)
                                                 in z + (e - (e_a * (1/c))))
                                            0
                                            x
{-
dot' (!c,params,params_a) (!y,x) = go 0 x
  where go !s [] = s
        go !s (!i:x) = 
            let e   = params   ! (y,i)
                e_a = params_a ! (y,i)
            in go (s + (e - (e_a * (1/c)))) x
-}

toSV :: (V.Unbox i, Ord y,Ord i) => LocalSparseVector y i -> SparseVector (y,i)
toSV (y,v) = Map.fromList [ ((y,i),1) | i <- V.toList v ]