1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00

Revert to foldl

This commit is contained in:
joshvera 2017-04-11 17:10:25 -04:00
parent 00f88e540f
commit 5a8217f06b

View File

@ -96,7 +96,7 @@ run :: (Eq1 f, Functor f, HasField fields Category, HasField fields (Maybe Featu
run editDistance canCompare as bs = relay pure (\m k -> case m of run editDistance canCompare as bs = relay pure (\m k -> case m of
SES -> k $ ses (gliftEq (==) `on` fmap category) as bs SES -> k $ ses (gliftEq (==) `on` fmap category) as bs
(GenFeaturizedTermsAndDiffs sesDiffs) -> (GenFeaturizedTermsAndDiffs sesDiffs) ->
k $ evalState (genFeaturizedTermsAndDiffs sesDiffs) (0, 0) k $ genFeaturizedTermsAndDiffs sesDiffs
(FindNearestNeighoursToDiff allDiffs featureAs featureBs) -> (FindNearestNeighoursToDiff allDiffs featureAs featureBs) ->
k $ findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs k $ findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs
(DeleteRemaining allDiffs remainingDiffs) -> (DeleteRemaining allDiffs remainingDiffs) ->
@ -233,24 +233,18 @@ insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
put (previous, unmappedA, IntMap.delete j unmappedB) put (previous, unmappedA, IntMap.delete j unmappedB)
pure (That j, That b) pure (That j, That b)
genFeaturizedTermsAndDiffs :: (Functor f, HasField fields (Maybe FeatureVector)) => RWSEditScript f fields -> State (Int, Int) ([UnmappedTerm f fields], [UnmappedTerm f fields], [(These Int Int, These (Term f (Record fields)) (Term f (Record fields)))], [TermOrIndexOrNone (UnmappedTerm f fields)]) genFeaturizedTermsAndDiffs :: (Functor f, HasField fields (Maybe FeatureVector)) => RWSEditScript f fields -> ([UnmappedTerm f fields], [UnmappedTerm f fields], [(These Int Int, These (Term f (Record fields)) (Term f (Record fields)))], [TermOrIndexOrNone (UnmappedTerm f fields)])
genFeaturizedTermsAndDiffs sesDiffs = case sesDiffs of genFeaturizedTermsAndDiffs sesDiffs = pure (featurizedAs, featurizedBs, countersAndDiffs, allDiffs)
[] -> pure ([], [], [], []) where
(diff : diffs) -> do (featurizedAs, featurizedBs, _, _, countersAndDiffs, allDiffs) = foldl' (\(as, bs, counterA, counterB, diffs, allDiffs) diff ->
(counterA, counterB) <- get
case diff of case diff of
This term -> do This term ->
put (succ counterA, counterB) (as <> pure (featurize counterA term), bs, succ counterA, counterB, diffs, allDiffs <> pure None)
(as, bs, mappedDiffs, allDiffs) <- genFeaturizedTermsAndDiffs diffs That term ->
pure (as <> pure (featurize counterA term), bs, mappedDiffs, allDiffs <> pure None) (as, bs <> pure (featurize counterB term), counterA, succ counterB, diffs, allDiffs <> pure (Term (featurize counterB term)))
That term -> do These a b ->
put (counterA, succ counterB) (as, bs, succ counterA, succ counterB, diffs <> pure (These counterA counterB, These a b), allDiffs <> pure (Index counterA))
(as, bs, mappedDiffs, allDiffs) <- genFeaturizedTermsAndDiffs diffs ) ([], [], 0, 0, [], []) sesDiffs
pure (as, bs <> pure (featurize counterB term), mappedDiffs, allDiffs <> pure (Term (featurize counterB term)))
These a b -> do
put (succ counterA, succ counterB)
(as, bs, mappedDiffs, allDiffs) <- genFeaturizedTermsAndDiffs diffs
pure (as, bs, mappedDiffs <> pure (These counterA counterB, These a b), allDiffs <> pure (Index counterA))
featurize :: (HasField fields (Maybe FeatureVector), Functor f) => Int -> Term f (Record fields) -> UnmappedTerm f fields featurize :: (HasField fields (Maybe FeatureVector), Functor f) => Int -> Term f (Record fields) -> UnmappedTerm f fields
featurize index term = UnmappedTerm index (let Just v = getField (extract term) in v) (eraseFeatureVector term) featurize index term = UnmappedTerm index (let Just v = getField (extract term) in v) (eraseFeatureVector term)