\int_{0}^{1}\frac{x^{4}\left(1-x\right)^{4}}{1+x^{2}}dx
=\frac{22}{7}-\pi
You know, I think I won't delete this. It's a celebration of my having embedded some TeX using the advice at Bot Cyborg.
\int_{0}^{1}\frac{x^{4}\left(1-x\right)^{4}}{1+x^{2}}dx
=\frac{22}{7}-\pi
Δf(x,y) = (f(x)-f(y))/(x-y)
Δ(fg)(x,y) = (f(x)g(x)-f(y)g(y))/(x-y)
= (f(x)g(x)-f(x)g(y)+f(x)g(y)-f(y)g(y))/(x-y)
= f(x)Δg(x,y)+g(y)Δf(x,y)
f(x) = 1+x f(x)
Δf(x,y) = x Δf(x,y)+f(y)
Δf(x,y) = (x^{N}-y^{N})/(x-y) = x^{N-1}+x^{N-2}y+x^{N-3}y^{2}+...+y^{N-1}
right :: p j + (Δp c j , c) → (j , Δp c j ) + p c
ΔT(X,Y) = 1/(1-(T(X)+T(Y))
right
, defined above, a massaged version of the definition of finite difference? (Hint: define d=((f(x)-f(y))/(x-y). In this equation, eliminate the division by a suitable multiplication and eliminate the subtraction by a suitable addition. And remember that (,)
is Haskell notation for the product of types.)
> {-# LANGUAGE NoMonomorphismRestriction,GeneralizedNewtypeDeriving #-}
> import Control.Arrow
> import Control.Monad
> import Control.Monad.Instances
> import Control.Monad.State
> import Data.Either
> import Data.Function
> import Random
> import qualified Data.List as L
> import qualified Data.Map as M
> data Search c a = Leaf { lb::c, leaf::a}
> | Choice { lb::c, choices::[Search c a] } deriving Show
> ex1 = Choice 0 [
> Choice (-log 0.1) [
> Leaf (-log 0.5) 'A',
> Leaf (-log 0.5) 'B'],
> Choice (-log 0.2) [
> Leaf (-log 0.6) 'C',
> Leaf (-log 0.4) 'D']]
> instance Functor (Search c) where
> fmap f (Leaf c a ) = Leaf c $ f a
> fmap f (Choice c as) = Choice c $ map (fmap f) as
> instance Num c => Monad (Search c) where
> return = Leaf 0
> a >>= f = join $ fmap f a where
> join (Leaf c a ) = Choice c [a]
> join (Choice c as) = Choice c $ map join as
> instance Num c => MonadPlus (Search c) where
> mzero = Choice 0 []
> a `mplus` b = Choice 0 [a,b]
> data Ord a => Tree a = Null | Fork a (Tree a) (Tree a) deriving Show
> isEmpty :: Ord a => Tree a -> Bool
> isEmpty Null = True
> isEmpty (Fork x a b) = False
> minElem :: Ord a => Tree a -> a
> minElem (Fork x a b) = x
> deleteMin :: Ord a => Tree a -> Tree a
> deleteMin (Fork x a b) = merge a b
> insert :: Ord a => a -> Tree a -> Tree a
> insert x a = merge (Fork x Null Null) a
> merge :: Ord a => Tree a -> Tree a -> Tree a
> merge a Null = a
> merge Null b = b
> merge a b
> | minElem a <= minElem b = connect a b
> | otherwise = connect b a
> connect (Fork x a b) c = Fork x b (merge a c)
> instance (Num c) => Eq (Search c a) where
> (==) = (==) `on` lb
> instance (Num c,Ord c) => Ord (Search c a) where
> compare = compare `on` lb
> bumpUp delta (Leaf c a) = Leaf (delta+c) a
> bumpUp delta (Choice c as) = Choice (delta+c) as
> runSearch :: (Num c,Ord c) => Tree (Search c a) -> [Either c a]
> runSearch Null = []
> runSearch queue = let
> m = minElem queue
> queue' = deleteMin queue
> in case m of
> Leaf c a -> Left c : Right a : runSearch queue'
> Choice c as -> Left c : (runSearch $ foldl (flip insert) queue' $ map (bumpUp c) as)
> integers m = Choice 1 [Leaf 0 m,integers (m+1)]
> test = do
> a <- integers 1
> b <- integers 1
> c <- integers 1
> guard $ a*a+b*b==c*c
> return (a,b,c)
> test1 = runSearch (insert test Null)
> reduce [] = []
> reduce (Left a : Left b : bs) = reduce (Left b : bs)
> reduce (Left a : bs) = Left (exp (-a)) : reduce bs
> reduce (Right a : bs) = Right a : reduce bs
> test2 = reduce test1
> data Noun = Noun String deriving (Show,Eq,Ord)
> data Verb = Verb String deriving (Show,Eq,Ord)
> data Adj = Adj String deriving (Show,Eq,Ord)
> data Prep = Prep String deriving (Show,Eq,Ord)
> data NP = NP [Adj] Noun deriving (Show,Eq,Ord)
> data PP = PP Prep Noun deriving (Show,Eq,Ord)
> data Sentence = Sentence [NP] Verb [NP] [PP] deriving (Show,Eq,Ord)
> class UnParse a where
> unParse :: a -> String
> instance UnParse Noun where
> unParse (Noun a) = a
> instance UnParse Verb where
> unParse (Verb a) = a
> instance UnParse Adj where
> unParse (Adj a) = a
> instance UnParse Prep where
> unParse (Prep a) = a
> instance UnParse NP where
> unParse (NP a b) = concatMap unParse a ++ unParse b
> instance UnParse PP where
> unParse (PP a b) = unParse a ++ unParse b
> instance UnParse Sentence where
> unParse (Sentence a b c d) = concatMap unParse a ++ unParse b ++ concatMap unParse c ++ concatMap unParse d
> class Transducer t where
> char :: Char -> t Char
> choose :: [(Float,t a)] -> t a
> string :: (Monad t, Transducer t) => [Char] -> t [Char]
> string "" = return ""
> string (c:cs) = do {char c; string cs; return (c:cs)}
> noun :: (Monad t, Transducer t) => t Noun
> noun = do
> a <- choose [(0.5,string "ab"),(0.5,string "ba")]
> return $ Noun a
> verb :: (Monad t, Transducer t) => t Verb
> verb = do
> a <- choose [(0.5,string "aa"),(0.5,string "b")]
> return $ Verb a
> adjective :: (Monad t, Transducer t) => t Adj
> adjective = do
> a <- choose [(0.5,string "ab"),(0.5,string "aa")]
> return $ Adj a
> parsePrep = do
> a <- choose [(0.5,string "a"),(0.5,string "b")]
> return $ Prep a
> many :: (Monad t, Transducer t) => Float -> t a -> t [a]
> many p t = choose [
> (p,return []),
> (1-p,do
> a <- t
> as <- many p t
> return $ a:as)]
> many1 p t = do
> a <- t
> as <- many p t
> return (a:as)
> parseNP = do
> a <- many 0.5 adjective
> b <- noun
> return $ NP a b
> parsePP = do
> a <- parsePrep
> b <- noun
> return $ PP a b
> sentence = do
> a <- many 0.5 parseNP
> b <- verb
> c <- many 0.5 parseNP
> d <- many 0.5 parsePP
> return $ Sentence a b c d
> newtype Generator a = Generator { unGen :: State StdGen a } deriving Monad
> newtype Parser a = Parser { runParse :: (String -> Search Float (a,String)) }
> instance Transducer Generator where
> char a = return a
> choose p = do
> r <- Generator (State random)
> case (L.find ((>=r) . fst) $ zip (scanl1 (+) (map fst p)) (map snd p)) of
> Just opt -> snd opt
> gen = mkStdGen 12343210
> generate n partOfSpeech = (unGen $ sequence (replicate n partOfSpeech)) `evalState` gen
> test3 = mapM_ print $ generate 10 sentence
> generateAndTest n partOfSpeech chars = do
> a <- generate n sentence
> guard $ unParse a == chars
> return a
> collectResults n partOfSpeech chars = M.fromListWith (+) $ map (flip (,) 1) $
> generateAndTest n partOfSpeech chars
> countResults n partOfSpeech chars = mapM_ print $ L.sortBy (flip compare `on` snd) $
> M.toList $ collectResults n partOfSpeech chars
> test4 = countResults 100000 (noun :: Parser Noun) "abab"
> instance Monad Parser where
> return a = Parser (\cs -> return (a,cs))
> p >>= f = Parser (\cs -> do
> (a,cs') <- runParse p cs
> runParse (f a) cs')
> instance MonadPlus Parser where
> mzero = Parser (\cs -> mzero)
> p `mplus` q = Parser (\cs -> runParse p cs `mplus` runParse q cs)
> instance Transducer Parser where
> char c = Parser $ char' where
> char' "" = mzero
> char' (a:as) = if a==c then return (a,as) else mzero
> choose p = foldl1 mplus $ map (\(p,x) -> prob p >> x) p where
> prob p = Parser (\cs -> Leaf (-log p) ((),cs))
> goParse (Parser f) x = runSearch $ insert (f x) Null
> end = Parser (\cs -> if cs=="" then return ((),"") else mzero)
> withEnd g = do
> a <- g
> end
> return a
> normalise results = let total = last (lefts results)
> in map (\x -> case x of
> Left a -> a / total
> Right b -> b
> ) results
> findParse chars = mapM_ print $ reduce $ runSearch $
> insert (runParse (withEnd sentence) chars) Null
> main = do
> let string = "ababbbab"
> findParse string
> print "-------------------"
> countResults 1000000 (sentence :: Parser Sentence) string