1 changed files with 24 additions and 17 deletions
@ -1,28 +1,35 @@ |
|||||
import qualified Control.Monad.Random as MR |
{-# LANGUAGE OverloadedStrings #-} |
||||
import Text.JSON |
|
||||
import qualified Data.Map as Dm |
|
||||
|
|
||||
fromJSRational (s, (JSRational _ r)) = (s,fromRational r) |
|
||||
|
|
||||
ngramp ngJSON = let (Ok (JSObject result)) = decode ngJSON :: Result JSValue |
import Control.Monad |
||||
in Dm.fromList $ map fromJSRational $ fromJSObject $ result |
import Control.Applicative |
||||
|
import qualified Control.Monad.Random as MR |
||||
|
import Data.Aeson |
||||
|
import Data.Aeson.Types |
||||
|
import Data.Map as Dm |
||||
|
import qualified Data.ByteString.Lazy as DB |
||||
|
import Data.Char |
||||
|
|
||||
frequencyMap [] ngmap = ngmap |
frequencyMap [] ngmap = ngmap |
||||
frequencyMap ((ng, p):ngs) ngmap = case Dm.lookup (head ng) ngmap of |
frequencyMap ((ng, p):ngs) ngmap = case Dm.lookup (DB.head ng) ngmap of |
||||
Nothing -> frequencyMap ngs (Dm.insert (head ng) [(ng, p)] ngmap) |
Nothing -> frequencyMap ngs (Dm.insert (DB.head ng) [(ng, p)] ngmap) |
||||
Just xs -> frequencyMap ngs (Dm.insert (head ng) ((ng, p) : xs) ngmap) |
Just xs -> frequencyMap ngs (Dm.insert (DB.head ng) ((ng, p) : xs) ngmap) |
||||
|
|
||||
|
nextChoice k xs = case k of |
||||
|
1 -> DB.pack [DB.head xs] |
||||
|
_ -> DB.take (k-1) xs |
||||
|
|
||||
|
|
||||
generateText n acc cur freqmap = do |
generateText k n acc cur freqmap = do |
||||
let (Just probabilities) = Dm.lookup cur freqmap |
let (Just probabilities) = Dm.lookup cur freqmap |
||||
choice <- MR.fromList probabilities |
choice <- MR.fromList probabilities |
||||
let next = (head $ tail choice) |
let next = DB.last choice |
||||
case n of |
case n of |
||||
0 -> return acc |
0 -> return acc |
||||
_ -> generateText (n-1) (acc++([head choice])) next freqmap |
_ -> generateText k (n-1) (DB.append acc (nextChoice k choice)) next freqmap |
||||
|
|
||||
gibberish n = do |
gibberish n = do |
||||
js <- readFile "./ngrams.json" |
js <- (DB.readFile "./quadgrams.json") |
||||
let pmap = ngramp js |
let (Just ngramPairs) = decode js :: Maybe (Dm.Map DB.ByteString Rational) |
||||
result <- generateText n [] 't' (frequencyMap (Dm.toList pmap) (Dm.singleton '' [])) |
result <- generateText 4 n "" 32 (frequencyMap (Dm.toList ngramPairs) (Dm.singleton 32 [])) |
||||
return result |
print result |
||||
|
main = gibberish 500 |
Reference in new issue