crf-chain2-tiers 0.5.0 → 0.6.0

raw patch · 2 files changed

+89/−27 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• crf-chain2-tiers.cabal +1/−1
• src/Data/CRF/Chain2/Tiers/DAG.hs +88/−26

@@ -1,5 +1,5 @@ name:               crf-chain2-tiers-version:            0.5.0+version:            0.6.0 synopsis:           Second-order, tiered, constrained, linear conditional random fields description:     The library provides implementation of the second-order, linear

@@ -32,7 +32,7 @@  import           Prelude hiding (Word) import           Control.Applicative ((<$>), (<*>))-import           Control.Monad (when)+import           Control.Monad (when, guard)  import           System.IO (hSetBuffering, stdout, BufferMode (..)) import           Data.Maybe (maybeToList)@@ -43,7 +43,7 @@ import qualified Data.Number.LogFloat as LogFloat import qualified Numeric.SGD.Momentum as SGD import qualified Numeric.SGD.LogSigned as L-import qualified Data.MemoCombinators as Memo+-- import qualified Data.MemoCombinators as Memo  import           Data.DAG (DAG) import qualified Data.DAG as DAG@@ -244,36 +244,98 @@ ------------------------------------------------------  --- | Compute the probability of the DAG, based on the probabilities assigned to--- different edges and their labels.-dagProb :: DAG a (X, Y) -> Double-dagProb dag = sum-  [ fromEdge edgeID-  | edgeID <- DAG.dagEdges dag-  , DAG.isInitialEdge edgeID dag ]-  where-    fromEdge =-      Memo.wrap DAG.EdgeID DAG.unEdgeID Memo.integral fromEdge'-    fromEdge' edgeID-      = edgeProb edgeID-      * fromNode (DAG.endsWith edgeID dag)-    edgeProb edgeID =-      let (_x, y) = DAG.edgeLabel edgeID dag-      in  sum . map (LogFloat.fromLogFloat . snd) $ Core.unY y-    fromNode nodeID =-      case DAG.outgoingEdges nodeID dag of-        [] -> 1-        xs -> sum (map fromEdge xs)+-- -- | Compute the probability of the DAG, based on the probabilities assigned to+-- -- different edges and their labels.+-- dagProb :: DAG a (X, Y) -> Double+-- dagProb dag = sum+--   [ fromEdge edgeID+--   | edgeID <- DAG.dagEdges dag+--   , DAG.isInitialEdge edgeID dag ]+--   where+--     fromEdge =+--       Memo.wrap DAG.EdgeID DAG.unEdgeID Memo.integral fromEdge'+--     fromEdge' edgeID+--       = edgeProb edgeID+--       * fromNode (DAG.endsWith edgeID dag)+--     edgeProb edgeID =+--       let (_x, y) = DAG.edgeLabel edgeID dag+--       in  sum . map (LogFloat.fromLogFloat . snd) $ Core.unY y+--     fromNode nodeID =+--       case DAG.outgoingEdges nodeID dag of+--         [] -> 1+--         xs -> sum (map fromEdge xs)+-- +-- +-- -- | Filter out sentences with `dagProb` different from 1.+-- verifyDataset :: [DAG a (X, Y)] -> [DAG a (X, Y)]+-- verifyDataset =+--   filter verify+--   where+--     verify dag =+--       let p = dagProb dag+--       in  p >= 1 - eps && p <= 1 + eps+--     eps = 1e-9  --- | Filter out sentences with `dagProb` different from 1.+-- | Filter incorrect sentences. verifyDataset :: [DAG a (X, Y)] -> [DAG a (X, Y)] verifyDataset =   filter verify   where-    verify dag =-      let p = dagProb dag-      in  p >= 1 - eps && p <= 1 + eps+    verify dag = verifyDAG dag == Nothing+++-- | Verification error.+data Error+  = Malformed+  | Cyclic+  | SeveralSources [DAG.NodeID]+  | SeveralTargets [DAG.NodeID]+  | WrongBalance [DAG.NodeID]+    -- ^ Nodes for which the total sum of the incoming probabilities does not+    -- equal the total sum of the outgoing probabilities+  deriving (Show, Eq, Ord)+++-- | Check if the DAG satisfies all the desirable properties.+-- TODO: lot's of code duplication with the `crf-chain1-constrained` library+-- (only `edgeProb` is different)+verifyDAG :: DAG a (X, Y) -> Maybe Error+verifyDAG dag+  | not (DAG.isOK dag) = Just Malformed+  | not (DAG.isDAG dag) = Just Cyclic+  | length sources /= 1 = Just $ SeveralSources sources+  | length targets /= 1 = Just $ SeveralTargets targets+  | length wrong > 1 = Just $ WrongBalance wrong+  | otherwise = Nothing+  where+    sources = do+      node <- DAG.dagNodes dag+      guard . null $ DAG.ingoingEdges node dag+      return node+    targets = do+      node <- DAG.dagNodes dag+      guard . null $ DAG.outgoingEdges node dag+      return node+    wrong = do+      node <- DAG.dagNodes dag+      let ing = DAG.ingoingEdges node dag+          out = DAG.outgoingEdges node dag+          ingBalance =+            if node `elem` sources+               then 1+               else sum (map edgeProb ing)+          outBalance =+            if node `elem` targets+               then 1+               else sum (map edgeProb out)+      guard . not $ equal ingBalance outBalance+      return node+    edgeProb edgeID =+      let (_x, y) = DAG.edgeLabel edgeID dag+      in  sum . map (LogFloat.fromLogFloat . snd) $ Core.unY y+    equal x y =+      x - eps <= y && x + eps >= y     eps = 1e-9