{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module NLP.Concraft.DAG.Morphosyntax.Ambiguous
( identifyAmbiguousSegments
) where
import qualified Data.MemoCombinators as Memo
import qualified Data.DAG as DAG
identifyAmbiguousSegments :: DAG.DAG a b -> DAG.DAG a Bool
identifyAmbiguousSegments dag =
flip DAG.mapE dag $ \edgeID _ ->
incoming edgeID * outgoing edgeID < totalPathNum
where
incoming = inComingNum dag
outgoing = outGoingNum dag
totalPathNum = sum
[ outgoing edgeID
| edgeID <- DAG.dagEdges dag
, DAG.isInitialEdge edgeID dag ]
inComingNum :: DAG.DAG a b -> DAG.EdgeID -> Int
inComingNum dag =
incoming
where
incoming =
Memo.wrap DAG.EdgeID DAG.unEdgeID Memo.integral incoming'
incoming' edgeID
| DAG.isInitialEdge edgeID dag = 1
| otherwise = sum $ do
prevID <- DAG.prevEdges edgeID dag
return $ incoming prevID
outGoingNum :: DAG.DAG a b -> DAG.EdgeID -> Int
outGoingNum dag =
outgoing
where
outgoing =
Memo.wrap DAG.EdgeID DAG.unEdgeID Memo.integral outgoing'
outgoing' edgeID
| DAG.isFinalEdge edgeID dag = 1
| otherwise = sum $ do
nextID <- DAG.nextEdges edgeID dag
return $ outgoing nextID