maxent-learner-hw 0.2.0 → 0.2.1

raw patch · 2 files changed

+18/−8 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• maxent-learner-hw.cabal +1/−1
• src/Text/PhonotacticLearner.hs +17/−7

@@ -1,5 +1,5 @@ name:                maxent-learner-hw-version:             0.2.0+version:             0.2.1 synopsis:            Hayes and Wilson's maxent learning algorithm for phonotactic grammars. description:         Provides an implementation of Hayes and Wilson's machine learning algorithm for maxent phonotactic grammars, as both a command-line tool and a function library.  The learner takes in a lexicon and produces a list of weighted constraints penalizing certain sound sequemces in an attempt to produce a probability distribution of words which maximizes the probability of the lexicon. Once such a set of constraints is generated, it can be tested by using it to generate random pronounceable text.                      .

@@ -30,6 +30,7 @@ import Data.Array.IArray import System.IO import Control.Exception+import Control.Parallel   stopsigint :: AsyncException -> IO ()@@ -39,6 +40,13 @@         return ()     _ -> throw e +parzip :: [b] -> [a] -> [a]+parzip _ [] = []+parzip [] xs = xs+parzip (y:ys) (x:xs) = (y `par` x):(parzip ys xs)++parAhead :: Int -> [a] -> [a]+parAhead n xs = parzip (drop n xs) xs {-| Infer a phonotactic grammar from a list of candidate constraints and a corpus of texts. @@ -85,6 +93,9 @@         lendist = lengthCdf lwfs         lenarr = lengthFreqs lwfs         pwfs = packMultiText cbound (wordFreqs lwfs)+        violcand (cl,cdfa) = let o = fromIntegral $ transducePackedShort cdfa pwfs+                             in o `seq` (cl,cdfa,o)+        vcands = parAhead 16 (fmap violcand candidates)      passctr :: IORef Int <- newIORef 0     candctr :: IORef Int <- newIORef 0@@ -111,17 +122,16 @@             salad <- getStdRandom . runState $ sampleWordSalad (fmap (maxentProb weights) (unpackDFA dfa)) lendist samplesize             evaluate . packMultiText cbound . wordFreqs . sortLexicon . fmap (\x -> (x,1)) $ salad -        processcand :: Double -> (PackedText sigma, [clabel], MulticountDFST sigma, Vec) -> (clabel, ShortDFST sigma) -> IO (PackedText sigma, [clabel], MulticountDFST sigma, Vec)-        processcand thresh grammar@(salad,rules,dfa,ws) (cl,cdfa) = do+        processcand :: Double -> (PackedText sigma, [clabel], MulticountDFST sigma, Vec) -> (clabel, ShortDFST sigma, Int) -> IO (PackedText sigma, [clabel], MulticountDFST sigma, Vec)+        processcand thresh grammar@(salad,rules,dfa,ws) (cl,cdfa,o) = do             markcand-            let o = fromIntegral $ transducePackedShort cdfa pwfs-                o' = fromIntegral $ transducePackedShort cdfa salad+            let o' = fromIntegral $ transducePackedShort cdfa salad                 e = o' * fromIntegral (totalWords lwfs) / fromIntegral samplesize-            score <- evaluate $ upperConfidenceOE o e+            score <- evaluate $ upperConfidenceOE (fromIntegral o) e             if score < thresh && cl `notElem` rules then do                 markprg                 hPutStrLn stderr ""-                putStrLn $ "\nSelected Constraint " ++ show cl ++  " (score=" ++ showFFloat (Just 4) score [] ++ ", o=" ++ showFFloat (Just 1) o [] ++ ", e=" ++ showFFloat (Just 1) e [] ++ ")."+                putStrLn $ "\nSelected Constraint " ++ show cl ++  " (score=" ++ showFFloat (Just 4) score [] ++ ", o=" ++ show o ++ ", e=" ++ showFFloat (Just 1) e [] ++ ")."                  let rules' = cl:rules                 dfa' <- evaluate . pruneAndPack $ rawIntersection consMC (unpackDFA cdfa) (unpackDFA dfa)@@ -138,7 +148,7 @@         processpass grammar thresh = do             markpass             putStrLn $ "\n\n\nStarting pass with threshold " ++ showFFloat (Just 3) thresh ""-            foldlM (processcand thresh) grammar candidates+            foldlM (processcand thresh) grammar vcands      initsalad <- genSalad blankdfa zero     let initgrammar = (initsalad,[],blankdfa,zero)