language-guess (empty) → 0.1

raw patch · 6 files changed

+183/−0 lines, 6 filesdep +basedep +bytestringdep +cerealsetup-changedbinary-added

Dependencies added: base, bytestring, cereal, containers, utility-ht

Files

• LICENSE +30/−0
• Language/Guess.hs +89/−0
• Setup.hs +2/−0
• lang.dat binary
• language-guess.cabal +27/−0
• php2hs.php +35/−0

@@ -0,0 +1,30 @@+Copyright (c)2012, Tingtun AS++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tingtun nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,89 @@+{-# LANGUAGE UnicodeSyntax #-}+-- | Example usage:+--+-- >>> dat <- loadData'+-- >>> head $ guess dat "this is a teststring"+-- ("en",0.49421052631578954)+-- >>> take 2 $ guess dat "dette er en teststreng"+-- [("no",0.5703030303030303),("da",0.5096969696969698)]+-- >>> head $ guess dat "lorem ipsum dolor sit amet"+-- ("la",0.34199999999999997)+module Language.Guess where++import Control.Applicative ((<$>))+import Data.Char+import Data.Function (on)+import qualified Data.Map as M+import Data.Map (Map)+import Data.Maybe (fromMaybe)++#if MIN_VERSION_base(4,3,0)+import Data.Tuple (swap)+#else+import Data.Tuple.HT (swap)+#endif++import Data.List (sort, sortBy)++import qualified Data.ByteString.Char8 as BS+import Data.Serialize++import Paths_language_guess++type Trigram   = (Char, Char, Char)+type Frequency = Int+type Rank      = Int+type Language  = String++threshold ∷ Int+threshold = 300++-- | Load a cerealized file.+loadData ∷ FilePath → IO (Map Language (Map Trigram Rank))+loadData f = (\(Right x) → x) . decode <$> BS.readFile f++-- | Load the default cerealized file.+loadData' ∷ IO (Map Language (Map Trigram Rank))+loadData' = loadData =<< getDataFileName "lang.dat"++-- | Guess the language of a string.+guess ∷ Map Language (Map Trigram Rank) → String → [(Language, Double)]+guess langData = sortBy (flip compare `on` swap) . M.toList . f . rank . parse+  where f x = M.map (flip distance x) langData++-- | Calculate distance between ranked trigram sets.+-- Cavnar & Trenkle (1994)+distance ∷ Map Trigram Rank → Map Trigram Rank → Double+distance x y = norm $ M.foldrWithKey f 0 y+  where f k n m = m + fromMaybe threshold (abs . (n-) <$> M.lookup k x)+        norm z = 1 - fromIntegral z / fromIntegral (M.size y)+                                    / fromIntegral (M.size x)++-- | Convert a set of trigram frequencies to ranks.+-- Maximum of 'threshold', uses alphabetical sort to break ties.+rank ∷ Map Trigram Frequency → M.Map Trigram Rank+rank = M.fromList . flip zip [1..] . map snd . take threshold . sortBy c+                  . map swap . M.toList+  where (r, k) `c` (r', k') = if r == r' then compare k k'+                                         else compare r' r++-- | Make a trigram frequency map out of a string.+parse ∷ String → Map (Char, Char, Char) Frequency+parse x = go M.empty $ clean (' ':x)+  where go m (x:y:z:xs) = go (M.alter f (x,y,z) m) (y:z:xs)+        go m _ = m+        f Nothing = Just 1+        f (Just a) = Just (a+1)++-- | Clean a string, removing punctiation, lowering cases, and collapsing+-- adjacent spaces.+clean ∷ String → String+clean (x:y:xs)+    | isWhite x && isWhite y = clean (' ':xs)+    | isPunctuation y || isNumber y = clean (x:' ':xs)+    | isUpper y = clean (x:toLower y:xs)+    | otherwise = x:clean (y:xs)+      where isWhite x = isSpace x || isSeparator x+clean (' ':[]) = " "+clean (x:[]) = x:" "+clean _ = ""

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

binary file changed (absent → 187706 bytes)

@@ -0,0 +1,27 @@+Name:                language-guess+Version:             0.1+Synopsis:            Guess at which human language a text is written in.+Description:         Guess at which human language a text is written in,+                     based on the PEAR module Text_LanguageDetect.+License:             BSD3+License-file:        LICENSE+Author:              Christian Rødli Amble+Maintainer:          cra+code@cra.no+Category:            Language+Build-type:          Simple+Extra-Source-Files:  php2hs.php+Data-files:          lang.dat+Cabal-version:       >=1.6++Source-Repository head+  Type:              git+  Location:          git://egovmon.no/language-guess++Library+  Other-Modules:     Paths_language_guess+  Exposed-modules:   Language.Guess+  Build-depends:     base ==4.*, cereal ==0.3.*, bytestring ==0.9.*,+                     containers+  if impl(ghc < 7.0.0)+    Build-depends:     utility-ht -any+  Extensions:        CPP

@@ -0,0 +1,35 @@+<?php+// Take the data/lang.dat file distributed with Text_LanguageDetect (which is+// assumed installed) and print a haskell program on stdout which will make the+// serialized file used by this module.++require 'Text/LanguageDetect.php';+$ld = new Text_LanguageDetect();+$x = unserialize(file_get_contents($ld->_get_data_loc('lang.dat')));++$iso = new Text_LanguageDetect_ISO639();++mb_internal_encoding("utf8");++function f($trigram, $n) {+    return str_replace("'", "\\'", mb_substr($trigram, $n, 1));+}++echo "import Data.Map\nimport Data.Serialize\nimport Data.ByteString.Char8 as B\nmain=B.writeFile \"lang.dat\"\$encode langData\nlangData :: Map String (Map (Char, Char, Char) Int)\nlangData=fromList [";+$out = "";+foreach ($x["trigram"] as $lang => $ranks) {+    if (($tmp = $iso->nameToCode2($lang)) !== null ) {+	    $lang = $tmp;+    } else {+	    $lang = $iso->nameToCode3($lang);+    }+    $out .= "(\"".$lang."\",fromList [";+    foreach ($ranks as $trigram => $rank) {+        $out .= "(('".f($trigram, 0)."','".+                      f($trigram, 1)."','".+                      f($trigram, 2)."'),".$rank."),";+    }+    $out = substr($out, 0, -1)."]),";+}+$out = substr($out, 0, -1)."]";+echo $out;