You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
64 lines
2.4 KiB
64 lines
2.4 KiB
import Data.List.Split
|
|
import Data.Char
|
|
import qualified Data.Map as Dm
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
|
|
ngrams' n len xs = let next = (take n xs)
|
|
in case len == n of
|
|
False -> (toLower <$> next) : (ngrams' n (len - 1) $ drop 1 xs)
|
|
_ -> return xs
|
|
ngrams n xs = ngrams' n (length xs) xs
|
|
|
|
digrams = ngrams 2
|
|
trigrams = ngrams 3
|
|
-- start out by choosing a random unigram
|
|
|
|
-- then choose another letter with the conditional probability that it follows the first one
|
|
-- will have to calculate the conditional probability that any letter follows any other letter
|
|
|
|
-- see how many digrams start with that letter
|
|
startsP' :: Char -> [String] -> (Int, Int)
|
|
startsP' letter dgs = foldr check (0, 0) dgs where
|
|
check (first:second:[]) (a, n) = case (first == letter) of
|
|
True -> (a + 1, n + 1)
|
|
_ -> (a, n + 1)
|
|
check (first:[]) (a, n) = (a, n + 1)
|
|
|
|
startsP letter dgs = let (n, k) = startsP' letter (digrams dgs)
|
|
in (fromIntegral n) / (fromIntegral k)
|
|
|
|
|
|
select [] = []
|
|
select (x : xs) = (x, xs) : map (fmap (x :)) (select xs)
|
|
|
|
perm2 ks = [[x,y] | (x, ys) <- select ks, y <- ys]
|
|
|
|
permute 2 xs = perm2 xs
|
|
permute n xs = join [[x : p | p <- (permute (n-1) ys)] | (x,ys) <- select xs]
|
|
|
|
alphabet = ((map return ".,\" :;?![]()") ++ (map return ['a'..'z'])) ++ (map (\x -> [x,x]) ['a'..'z'])
|
|
|
|
englishDigrams = permute 2 alphabet
|
|
|
|
englishTrigrams = permute 3 alphabet
|
|
|
|
out fname n (d, k) = appendFile fname $ (show d) ++ ":" ++ (show $ k/n) ++ ","
|
|
|
|
digramProbs :: (Num a, Num t, Ord k) => t -> Dm.Map k a -> [k] -> (t, Dm.Map k a)
|
|
-- first argument is tokenized digrams
|
|
-- seconds argument is all possible digrams
|
|
digramProbs n ds [] = (n, ds)
|
|
digramProbs n digrams (d:ds) = case (Dm.lookup d digrams) of
|
|
Nothing -> digramProbs n digrams ds
|
|
(Just count) -> let digrams' = Dm.insert d (count+1) digrams
|
|
in digramProbs (n+1) digrams' ds
|
|
|
|
buildProbabilities :: (Fractional a, Ord k) => [k] -> Dm.Map k a
|
|
buildProbabilities digrams = Dm.fromList [(digram, 0.0) | digram <- digrams]
|
|
|
|
-- main = do
|
|
-- corpus <- readFile "./xab"
|
|
-- let (n, digramMap) = digramProbs 0 (buildProbabilities englishTrigrams) (trigrams corpus)
|
|
-- mapM_ (out "./test2.json" n) $ Dm.toList digramMap
|
|
|