diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/alpino-tools.cabal b/alpino-tools.cabal new file mode 100644 --- /dev/null +++ b/alpino-tools.cabal @@ -0,0 +1,49 @@ +Name: alpino-tools +Version: 0.0.2 +License: OtherLicense +License-file: LICENSE +Copyright: Copyright 2010 Daniël de Kok +Author: Daniël de Kok +Maintainer: Daniël de Kok +Homepage: http://github.com/danieldk/alpino-tools +Category: Natural Language Processing, Data +Synopsis: Alpino data processing tools +Description: Tools for processing data of the Alpino parser/generator + for Dutch. +Cabal-Version: >= 1.2 +Build-Type: Simple + +Library + Exposed-Modules: Data.Alpino.Model, Data.Alpino.Model.Enumerator + Build-Depends: base >= 4 && < 5, bytestring >= 0.9.1.7, + utf8-string >= 0.3.6, bytestring-lexing >= 0.2.1, + enumerator >= 0.4.1, transformers >= 0.2.2.0, + containers >= 0.3.0.0, random >= 1.0.0.3, + random-shuffle >= 0.0.2 + HS-Source-Dirs: src + Ghc-Options: -O2 -Wall + +Executable at_model_rescore_data + HS-Source-Dirs: src + main-is: model_rescore_data.hs + Ghc-Options: -O2 + +Executable at_model_filter_data + HS-Source-Dirs: src + main-is: model_filter_data.hs + Ghc-Options: -O2 + +Executable at_model_oracle + HS-Source-Dirs: src + main-is: model_oracle.hs + Ghc-Options: -O2 + +Executable at_model_random_sample + HS-Source-Dirs: src + main-is: model_random_sample.hs + Ghc-Options: -O2 + +Executable at_model_statistics_data + HS-Source-Dirs: src + main-is: model_statistics_data.hs + Ghc-Options: -O2 diff --git a/src/Data/Alpino/Model.hs b/src/Data/Alpino/Model.hs new file mode 100644 --- /dev/null +++ b/src/Data/Alpino/Model.hs @@ -0,0 +1,211 @@ +-- | +-- Module : Data.Alpino.Model +-- Copyright : (c) 2010 Daniël de Kok +-- License : Apache 2 +-- +-- Maintainer : Daniël de Kok +-- Stability : experimental +-- +-- Data structures and functions to modify and process training data for +-- the Alpino parse disambiguation and fluency ranking components. +-- +-- Since the training data follows a very general format, this module and +-- submodules should also be usable for other parsers and generators. +-- Please refer to the description of `bsToTrainingInstance` for more +-- information about the format that is used. + +module Data.Alpino.Model ( FeatureValue(..), + TrainingInstance(..), + TrainingInstanceType(..), + bestScore, + bestScore', + bsToTrainingInstance, + filterFeatures, + filterFeaturesFunctor, + randomSample, + scoreToBinary, + scoreToBinaryNorm, + scoreToNorm, + trainingInstanceToBs + ) where + +import qualified Data.ByteString as B +import Data.ByteString.Internal (c2w) +import Data.ByteString.Lex.Double (readDouble) +import qualified Data.ByteString.UTF8 as BU +import Data.List (foldl') +import Data.Maybe (fromJust) +import qualified Data.Set as Set +import GHC.Word (Word8) +import System.Random (RandomGen) +import System.Random.Shuffle (shuffle') +import Text.Printf (printf) + +-- | A training instance. +data TrainingInstance = TrainingInstance { + instanceType :: TrainingInstanceType, -- ^ Type of training instance + instanceKey :: B.ByteString, -- ^ Training instance identifier + instanceN :: B.ByteString, + instanceScore :: Double, -- ^ Quality score + instanceFeatures :: Features -- ^ Features +} deriving (Show, Eq) + +-- | Type of training instance (parsing or generation). +data TrainingInstanceType = ParsingInstance + | GenerationInstance + deriving (Show, Eq) + +-- | Representation of features and values. +data Features = FeaturesString B.ByteString -- ^ Features as a ByteString. + | FeaturesList [FeatureValue] -- ^ Features as a list. + deriving (Show, Eq) + +-- | A feature and its corresponding value. +data FeatureValue = FeatureValue { + feature :: B.ByteString, + value :: Double +} deriving (Show, Eq) + +-- | Find the highest score of a context. +bestScore :: [TrainingInstance] -> Double +bestScore = foldl (\acc e -> max acc $ instanceScore e) 0.0 + +-- | Find the highest score of a context (strict). +bestScore' :: [TrainingInstance] -> Double +bestScore' = foldl' (\acc e -> max acc $ instanceScore e) 0.0 + +-- | +-- Read a training instance from a `BU.ByteString`. +-- +-- The bytestring is assumed to contain five fields separated by +-- the hash (/#/) character: +-- +-- 1. An indicator for the type of training instance (/P/ for parse +-- disambiguation, /G/ for fluency ranking). +-- +-- 2. The identifier of the context (usually the identifier of a +-- sentence of logircal form). +-- +-- 3. Parse/generation number. +-- +-- 4. A quality score for this training instance. +-- +-- 5. A list of features and values. List elements are separated by +-- the vertical bar (/|/), and have the following form: /value@feature/ +bsToTrainingInstance :: B.ByteString -> Maybe TrainingInstance +bsToTrainingInstance l + | length lineParts /= 5 = Nothing + | otherwise = Just $ TrainingInstance instType key n score features + where lineParts = B.split instanceFieldSep l + instType = bsToType $ lineParts !! 0 + key = lineParts !! 1 + n = lineParts !! 2 + score = fst . fromJust . readDouble $ lineParts !! 3 + features = FeaturesString $ lineParts !! 4 + +-- | Convert a training instance to a `B.ByteString`. +trainingInstanceToBs :: TrainingInstance -> B.ByteString +trainingInstanceToBs (TrainingInstance instType keyBS nBS sc fvals) = + B.intercalate fieldSep [typeBS, keyBS, nBS, scoreBS, fValsBS] + where typeBS = typeToBS instType + scoreBS = BU.fromString $ printf "%f" sc + fValsBS = featuresToBs fvals + fieldSep = BU.fromString "#" + +instanceFieldSep :: GHC.Word.Word8 +instanceFieldSep = c2w '#' + +bsToType :: B.ByteString -> TrainingInstanceType +bsToType bs + | bs == parseMarker = ParsingInstance + | bs == generationMarker = GenerationInstance + | otherwise = error "Unknown marker." + +typeToBS :: TrainingInstanceType -> B.ByteString +typeToBS ParsingInstance = parseMarker +typeToBS GenerationInstance = generationMarker + +parseMarker :: BU.ByteString +parseMarker = BU.fromString "P" + +generationMarker :: BU.ByteString +generationMarker = BU.fromString "G" + +-- | Parsed representation of features. +parsedFeatures :: Features -> [FeatureValue] +parsedFeatures (FeaturesList l) = l +parsedFeatures (FeaturesString s) = map fVal $ B.split fieldSep s + where fVal p = FeatureValue f (fst $ fromJust $ readDouble valBs) + where [valBs, f] = B.split fValSep p + fieldSep = c2w '|' + fValSep = c2w '@' + +-- | Convert features to a bytestring. +featuresToBs :: Features -> B.ByteString +featuresToBs (FeaturesString s) = s +featuresToBs (FeaturesList l) = B.intercalate fieldSep $ map toBs l + where toBs (FeatureValue f val) = B.intercalate fValSep + [BU.fromString $ printf "%f" val, f] + fieldSep = BU.fromString "|" + fValSep = BU.fromString "@" + +-- | +-- Filter features by exact names. A modifier function can be applied, +-- for instance, the `not` function would exclude the specified features. +filterFeatures :: (Bool -> Bool) -> Set.Set B.ByteString -> TrainingInstance -> + TrainingInstance +filterFeatures f keepFeatures i = + i { instanceFeatures = FeaturesList $ filter keep $ + parsedFeatures $ instanceFeatures i} + where keep fv = f $ Set.member (feature fv) keepFeatures + +-- | +-- Filter features by their functor. A modifier function can be applied, +-- for instance, the `not` function would exclude the specified features. +filterFeaturesFunctor :: (Bool -> Bool) -> Set.Set B.ByteString -> + TrainingInstance -> TrainingInstance +filterFeaturesFunctor f keepFeatures i = + i { instanceFeatures = FeaturesList $ filter keep $ parsedFeatures $ + instanceFeatures i} + where keep fv = f $ Set.member (functor $ feature fv) keepFeatures + functor func = B.split argOpen func !! 0 + argOpen = c2w '(' + +-- | Extract a random sample from a list of instances. +randomSample :: RandomGen g => g -> Int -> [TrainingInstance] -> + [TrainingInstance] +randomSample g n i + | instLen <= n = i + | otherwise = take n $ shuffle' i instLen g + where instLen = length i + +-- | +-- Convert the quality scores to binary scores. The instances +-- with the highest quality score get score /1.0/, other instances +-- get score /0.0/. +scoreToBinary :: [TrainingInstance] -> [TrainingInstance] +scoreToBinary ctx = map (rescoreEvt maxScore) ctx + where maxScore = bestScore ctx + rescoreEvt maxS evt + | instanceScore evt == maxS = evt { instanceScore = 1.0 } + | otherwise = evt { instanceScore = 0.0 } + +-- | +-- Divide a score of /1.0/ uniformly over instances with the highest +-- quality scores. +scoreToBinaryNorm :: [TrainingInstance] -> [TrainingInstance] +scoreToBinaryNorm ctx = map (rescoreEvt maxScore) ctx + where maxScore = bestScore ctx + numMax = length . filter (\e -> instanceScore e == maxScore) $ ctx + correctScore = 1.0 / fromIntegral numMax + rescoreEvt maxS evt + | instanceScore evt == maxS = + evt { instanceScore = correctScore } + | otherwise = evt { instanceScore = 0.0 } + +-- | Normalize scores over all training instances. +scoreToNorm :: [TrainingInstance] -> [TrainingInstance] +scoreToNorm ctx = map (rescoreEvt norm) ctx + where norm = sum $ map instanceScore ctx + rescoreEvt n evt = + evt { instanceScore = (instanceScore evt) / n } diff --git a/src/Data/Alpino/Model/Enumerator.hs b/src/Data/Alpino/Model/Enumerator.hs new file mode 100644 --- /dev/null +++ b/src/Data/Alpino/Model/Enumerator.hs @@ -0,0 +1,204 @@ +{-# OPTIONS_GHC -XDeriveDataTypeable #-} +-- | +-- Module : Data.Alpino.Model.Enumerator +-- Copyright : (c) 2010 Daniël de Kok +-- License : Apache 2 +-- +-- Maintainer : Daniël de Kok +-- Stability : experimental +-- +-- Enumerators derived from Data.Alpino.Model + +module Data.Alpino.Model.Enumerator ( bestScore, + concat, + groupBy, + groupByKey, + filter, + filterFeatures, + filterFeaturesFunctor, + instanceGenerator, + instanceParser, + lineEnum, + printByteString, + randomSample, + scoreToBinary, + scoreToBinaryNorm, + scoreToNorm + ) where + +import Prelude hiding (concat, filter, head, mapM) +import Control.Exception.Base (Exception) +import qualified Control.Monad as CM +import Control.Monad.IO.Class (MonadIO(..), liftIO) +import Control.Monad.Trans.Class (lift) +import qualified Data.Alpino.Model as AM +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BU +import qualified Data.Enumerator as E +import Data.Enumerator hiding (isEOF, length, map) +import qualified Data.List as L +import qualified Data.Set as Set +import Data.Typeable +import System.IO (isEOF) +import System.Random (getStdRandom, split) + +data InvalidDataException = InvalidDataException String + deriving Typeable + +instance Exception InvalidDataException + +instance Show InvalidDataException where + show (InvalidDataException e) = show e + +-- | Retrieve the best score from a list of training instances. +bestScore :: (Monad m) => + Enumeratee [AM.TrainingInstance] Double m b +bestScore = E.map AM.bestScore' + +-- | +-- Filter features by exact names. A modifier function can be applied, +-- for instance, the 'not' function would exclude the specified features. +filterFeatures :: (Monad m) => (Bool -> Bool) -> Set.Set B.ByteString -> + Enumeratee AM.TrainingInstance AM.TrainingInstance m b +filterFeatures f keepFeatures = E.map (AM.filterFeatures f keepFeatures) + +-- | +-- Filter features by their functor. A modifier function can be applied, +-- for instance, the 'not' function would exclude the specified features. +filterFeaturesFunctor :: (Monad m) => (Bool -> Bool) -> Set.Set B.ByteString -> + Enumeratee AM.TrainingInstance AM.TrainingInstance m b +filterFeaturesFunctor f keepFeatures = + E.map (AM.filterFeaturesFunctor f keepFeatures) + +-- | Enumeratee grouping chunks according to an equality function. +groupBy :: (Monad m, Eq a) => (a -> a -> Bool) -> + Enumeratee a [a] m b +groupBy f = loop + where loop (Continue k) = do + h <- peek + case h of + Nothing -> return $ Continue k + Just e -> do + xs <- E.span $ f e + newStep <- lift $ runIteratee $ k $ Chunks [xs] + loop newStep + loop step = return step + +-- | Group training instances by key. +groupByKey :: (Monad m) => + Enumeratee AM.TrainingInstance [AM.TrainingInstance] m b +groupByKey = groupBy keyEq + where keyEq i1 i2 = AM.instanceType i1 == AM.instanceType i2 && + AM.instanceKey i1 == AM.instanceKey i2 + +-- | Enumeratee that converts `BU.ByteString` to `AM.TrainingInstance`. +instanceParser :: (Monad m) => + Enumeratee BU.ByteString AM.TrainingInstance m b +instanceParser = mapMaybeEnum (InvalidDataException "Could not parse instance.") + AM.bsToTrainingInstance + +-- | Enumeratee that converts `AM.TrainingInstance` to `B.ByteString`. +instanceGenerator :: (Monad m) => + Enumeratee AM.TrainingInstance B.ByteString m b +instanceGenerator = E.map AM.trainingInstanceToBs + +-- | Enumerator of lines read from the standard input. +lineEnum :: MonadIO m => Enumerator B.ByteString m b +lineEnum = Iteratee . loop + where loop (Continue k) = do + eof <- liftIO isEOF + case eof of + True -> return $ Continue k + False -> do + line <- liftIO B.getLine + runIteratee (k (Chunks [line])) >>= loop + loop step = return step + +-- | Enumeratee that filters with a predicate. +filter :: (Monad m) => (a -> Bool) -> Enumeratee a a m b +filter f = loop + where loop = checkDone $ continue . step + step k EOF = yield (Continue k) EOF + step k (Chunks []) = continue $ step k + step k (Chunks xs) = do + newStep <- lift $ runIteratee $ k $ Chunks $ L.filter f xs + loop newStep + +-- | Enumeratee concatenating lists. +concat :: (Monad m) => + Enumeratee [a] a m b +concat = loop + where loop (Continue k) = do + h <- E.head + case h of + Nothing -> return $ Continue k + Just e -> do + newStep <- lift $ runIteratee $ k $ Chunks e + loop newStep + loop step = return step + + +mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b +mapM f = loop where + loop = checkDone $ continue . step + step k EOF = yield (Continue k) EOF + step k (Chunks []) = continue $ step k + step k (Chunks xs) = ( do + ys <- lift $ CM.mapM f xs + k $ Chunks ys + ) >>== loop + +mapMaybeEnum :: (Exception e, Monad m) => e -> (ao -> Maybe ai) -> + Enumeratee ao ai m b +mapMaybeEnum exception f = loop where + loop = checkDone $ continue . step + step k EOF = yield (Continue k) EOF + step k (Chunks []) = continue $ step k + step k (Chunks xs) = case mapMaybeMaybe f xs of + Just ys -> k (Chunks ys) >>== loop + Nothing -> throwError exception + +-- If one function application fails return Nothing, otherwise Just xs +mapMaybeMaybe :: (a -> Maybe b) -> [a] -> Maybe [b] +mapMaybeMaybe _ [] = Just [] +mapMaybeMaybe f (x:xs) = do + r <- f x + rs <- mapMaybeMaybe f xs + return $ r:rs + +-- | Iterator printing `B.ByteString` to the standard output. +printByteString :: MonadIO m => Iteratee B.ByteString m () +printByteString = continue step + where step (Chunks []) = continue step + step (Chunks xs) = liftIO (mapM_ B.putStrLn xs) >> continue step + step EOF = yield () EOF + +-- | Extract a random sample of @n@ instances from a context. +randomSample :: (MonadIO m) => Int -> + Enumeratee [AM.TrainingInstance] [AM.TrainingInstance] m b +randomSample n = mapM (liftIO . sampleFun) + where sampleFun :: [AM.TrainingInstance] -> IO [AM.TrainingInstance] + sampleFun i = do + gen <- getStdRandom split + return $ AM.randomSample gen n i + +-- | +-- Enumerator recaculating scores to binary scores (/1.0/ for best, +-- /0.0/ for the rest). +scoreToBinary :: (Monad m) => + Enumeratee [AM.TrainingInstance] [AM.TrainingInstance] m b +scoreToBinary = E.map AM.scoreToBinary + +-- | +-- Enumerator recalculating scores, dividing a score of /1.0/ uniformly +-- over instances with the highest quality score. +scoreToBinaryNorm :: (Monad m) => + Enumeratee [AM.TrainingInstance] [AM.TrainingInstance] m b +scoreToBinaryNorm = E.map AM.scoreToBinaryNorm + +-- | +-- Enumerator that normalized instance scores over all instances +-- in the list. +scoreToNorm :: (Monad m) => + Enumeratee [AM.TrainingInstance] [AM.TrainingInstance] m b +scoreToNorm = E.map AM.scoreToNorm diff --git a/src/model_filter_data.hs b/src/model_filter_data.hs new file mode 100644 --- /dev/null +++ b/src/model_filter_data.hs @@ -0,0 +1,61 @@ +module Main where + +import Prelude hiding (concat) + +import Control.Monad (unless) +import Data.Alpino.Model.Enumerator +import Data.ByteString.UTF8 (fromString) +import Data.Enumerator (($$), joinI, run_) +import Data.List as L +import qualified Data.Set as Set +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO + +main :: IO () +main = do + (options, args) <- getOptions + + let filter0 = if elem FilterFeatures options + then filterFeatures + else filterFeaturesFunctor + let filter = if elem InverseFilter options + then filter0 not + else filter0 id + + unless (not $ null args) $ do + name <- getProgName + hPutStrLn stderr $ usageInfo (usage name) optionInfo + exitFailure + + let keepFeatures = Set.fromList $ map fromString args + + run_ $ lineEnum $$ joinI $ instanceParser $$ + joinI $ filter keepFeatures $$ + joinI $ instanceGenerator $$ printByteString + +data Option = FilterFeatures | FilterFunctors | InverseFilter + deriving Eq + +optionInfo :: [OptDescr Option] +optionInfo = + [ Option ['f'] ["functor"] (NoArg FilterFunctors) "filter feature functors", + Option ['i'] ["inverse"] (NoArg InverseFilter) "exclude specified features"] + +usage :: String -> String +usage name = "Usage: " ++ name ++ "