git.iko.soy/grenade
on master help sign in
grenade/src/Grenade/Utils/OneHot.hs
94 lines 2.9 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE RankNTypes #-}
9module Grenade.Utils.OneHot (
10 oneHot
11 , hotMap
12 , makeHot
13 , unHot
14 , sample
15 ) where
17import qualified Control.Monad.Random as MR
19import Data.List ( group, sort )
21import Data.Map ( Map )
22import qualified Data.Map as M
24import Data.Proxy
26import Data.Vector ( Vector )
27import qualified Data.Vector as V
28import qualified Data.Vector.Storable as VS
30import Numeric.LinearAlgebra ( maxIndex )
31import Numeric.LinearAlgebra.Devel
32import Numeric.LinearAlgebra.Static
33import GHC.TypeLits
35import Grenade.Core.Shape
37-- | From an int which is hot, create a 1D Shape
38-- with one index hot (1) with the rest 0.
39-- Rerurns Nothing if the hot number is larger
40-- than the length of the vector.
41oneHot :: forall n. (KnownNat n)
42 => Int -> Maybe (S ('D1 n))
43oneHot hot =
44 let len = fromIntegral $ natVal (Proxy :: Proxy n)
45 in if hot < len
46 then
47 fmap S1D . create $ runSTVector $ do
48 vec <- newVector 0 len
49 writeVector vec hot 1
50 return vec
51 else Nothing
53-- | Create a one hot map from any enumerable.
54-- Returns a map, and the ordered list for the reverse transformation
55hotMap :: (Ord a, KnownNat n) => Proxy n -> [a] -> Either String (Map a Int, Vector a)
56hotMap n as =
57 let len = fromIntegral $ natVal n
58 uniq = [ c | (c:_) <- group $ sort as]
59 hotl = length uniq
60 in if hotl == len
61 then
62 Right (M.fromList $ zip uniq [0..], V.fromList uniq)
63 else
64 Left ("Couldn't create hotMap of size " ++ show len ++ " from vector with " ++ show hotl ++ " unique characters")
66-- | From a map and value, create a 1D Shape
67-- with one index hot (1) with the rest 0.
68-- Rerurns Nothing if the hot number is larger
69-- than the length of the vector or the map
70-- doesn't contain the value.
71makeHot :: forall a n. (Ord a, KnownNat n)
72 => Map a Int -> a -> Maybe (S ('D1 n))
73makeHot m x = do
74 hot <- M.lookup x m
75 let len = fromIntegral $ natVal (Proxy :: Proxy n)
76 if hot < len
77 then
78 fmap S1D . create $ runSTVector $ do
79 vec <- newVector 0 len
80 writeVector vec hot 1
81 return vec
82 else Nothing
84unHot :: forall a n. KnownNat n
85 => Vector a -> S ('D1 n) -> Maybe a
86unHot v (S1D xs)
87 = (V.!?) v
88 $ maxIndex (extract xs)
90sample :: forall a n m. (KnownNat n, MR.MonadRandom m)
91 => Double -> Vector a -> S ('D1 n) -> m a
92sample temperature v (S1D xs) = do
93 ix <- MR.fromList . zip [0..] . fmap (toRational . exp . (/ temperature) . log) . VS.toList . extract $ xs
94 return $ v V.! ix