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:
parent
00f88e540f
commit
5a8217f06b
30
src/RWS.hs
30
src/RWS.hs
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user