1
1
mirror of https://github.com/github/semantic.git synced 2025-01-03 13:02:37 +03:00

Revert "Memoize feature vectors by hashes."

This reverts commit cd4b4adb967edd1d8c2a97f3f6b68f37e40f28b0.
This commit is contained in:
Rob Rix 2017-02-03 14:27:02 -05:00
parent f0c469233b
commit cdb01ce3a1

View File

@ -21,7 +21,6 @@ import Control.Monad.State
import Data.Align.Generic
import Data.Array
import Data.Functor.Both hiding (fst, snd)
import Data.Functor.Foldable
import Data.Functor.Listable
import Data.Hashable
import qualified Data.IntMap as IntMap
@ -244,36 +243,18 @@ defaultFeatureVectorDecorator
-> Term f (Record (FeatureVector ': fields))
defaultFeatureVectorDecorator getLabel = featureVectorDecorator getLabel defaultP defaultQ defaultD
type VState = State (IntMap.IntMap FeatureVector)
-- | Annotates a term with a feature vector at each node, parameterized by stem length, base width, and feature vector dimensions.
featureVectorDecorator :: forall f label fields . (Hashable label, Traversable f) => Label f fields label -> Int -> Int -> Int -> Term f (Record fields) -> Term f (Record (FeatureVector ': fields))
featureVectorDecorator :: (Hashable label, Traversable f) => Label f fields label -> Int -> Int -> Int -> Term f (Record fields) -> Term f (Record (FeatureVector ': fields))
featureVectorDecorator getLabel p q d
= (`evalState` IntMap.empty) . cata collect . pqGramDecorator getLabel p q
where collect :: CofreeF f (Record (Gram label ': fields)) (VState (Term f (Record (FeatureVector ': fields)))) -> VState (Term f (Record (FeatureVector ': fields)))
collect ((gram :. rest) :< functorState) = do
featureVector <- foldl' addSubtermVector (unitVector' d (hash gram)) functorState
functor <- sequenceA functorState
pure $! cofree ((featureVector :. rest) :< functor)
addSubtermVector :: VState FeatureVector -> VState (Term f (Record (FeatureVector ': fields))) -> VState FeatureVector
addSubtermVector accumState termState = do
accum <- accumState
term <- termState
pure $! addVectors accum (rhead (extract term))
= cata collect
. pqGramDecorator getLabel p q
where collect ((gram :. rest) :< functor) = cofree ((foldl' addSubtermVector (unitVector d (hash gram)) functor :. rest) :< functor)
addSubtermVector :: FeatureVector -> Term f (Record (FeatureVector ': fields)) -> FeatureVector
addSubtermVector = flip $ addVectors . rhead . headF . runCofree
addVectors :: Num a => Array Int a -> Array Int a -> Array Int a
addVectors as bs = listArray (0, d - 1) (fmap (\ i -> as ! i + bs ! i) [0..(d - 1)])
unitVector' :: Int -> Int -> State (IntMap.IntMap FeatureVector) FeatureVector
unitVector' d hash = do
map <- get
case IntMap.lookup hash map of
Just v -> pure v
_ -> do
let v = unitVector d hash
put (IntMap.insert hash v map)
pure v
-- | Annotates a term with the corresponding p,q-gram at each node.
pqGramDecorator
:: Traversable f