<commit_before>{-# LANGUAGE TypeFamilies, Rank2Types, FlexibleContexts #-}
{-# OPTIONS -W #-}

module Tests.Syntax(allTests) where

import Prelude hiding (Real)
import Language.Hakaru.Syntax (Real, Prob, Measure,
       Order(..), Base(..), ununit, and_, fst_, snd_, swap_, min_,
       Mochastic(..), Lambda(..), bind_, liftM, factor, beta, bern, lam)
import Language.Hakaru.Util.Pretty (Pretty (pretty), prettyPair)
-- import Language.Hakaru.Sample(Sample(unSample))
import Language.Hakaru.Disintegrate

import Control.Monad (zipWithM_, replicateM)
import Control.Applicative (Const(Const))
import Text.PrettyPrint (text, (<>), ($$), nest)

-- import qualified Data.Number.LogFloat as LF
-- import qualified System.Random.MWC as MWC

import Test.HUnit
import Tests.TestTools


allTests :: Test
allTests = test [
    "pair1fst" ~: testS pair1fst,
    "pair1snd" ~: testS pair1snd,
    "pair2fst" ~: testS pair2fst,
    "pair2snd" ~: testS pair2snd,
    -- "pair2'fst" ~: testS $ pair2'fst 10,
    -- "pair2'snd" ~: testS $ pair2'snd 10,
    -- "replicateH" ~: testS $ replicateH 10,
    "pair3fst" ~: testS $ pair3fst 1 [true,true,true],
    "pair3snd" ~: testS $ pair3snd 1 [true,true,true],
    "pair3trd" ~: testS $ pair3trd 1 [true,true,true],
    "pair4fst" ~: testS $ pair4fst,
    "pair4transition" ~: testS $ pair4transition $ pair true 1,
    "pair4'transition" ~: testS $ pair4'transition $ pair true 1,
    -- "transitionTest" ~: ignore $ transitionTest,
    --"testDistWithSample" ~: ignore $ do x <- testDistWithSample
    --                                    mapM_ assertJust x,
    "testLinregSimp" ~: ignore $ testS linregSimp, -- too long?
    "testdistLinregSimp" ~: testS distLinregSimp,
    "testLinreg" ~: ignore $ testS distLinreg,
    "prog1s" ~: testD prog1s,
    "prog2s" ~: testD prog2s,
    "prog3s" ~: testD prog3s,
    "pair1fstD" ~: testD (\u -> ununit u $ pair1fst),
    "pair1fstDswap" ~: testD (\u -> ununit u $ liftM swap_ pair1fst)
    ]


-- pair1fst and pair1snd are equivalent
pair1fst :: (Mochastic repr) => repr (Measure (Bool, Prob))
pair1fst =  beta 1 1 `bind` \bias ->
            bern bias `bind` \coin ->
            dirac (pair coin bias)
pair1snd :: (Mochastic repr) => repr (Measure (Bool, Prob))
pair1snd =  bern (1/2) `bind` \coin ->
            if_ coin (beta 2 1) (beta 1 2) `bind` \bias ->
            dirac (pair coin bias)

-- pair2fst and pair2snd are equivalent
pair2fst :: (Mochastic repr) => repr (Measure ((Bool, Bool), Prob))
pair2fst =  beta 1 1 `bind` \bias ->
            bern bias `bind` \coin1 ->
            bern bias `bind` \coin2 ->
            dirac (pair (pair coin1 coin2) bias)<commit_msg>pair1 test now an SS test<commit_after>{-# LANGUAGE TypeFamilies, Rank2Types, FlexibleContexts #-}
{-# OPTIONS -W #-}

module Tests.Syntax(allTests) where

import Prelude hiding (Real)
import Language.Hakaru.Syntax (Real, Prob, Measure,
       Order(..), Base(..), ununit, and_, fst_, snd_, swap_, min_,
       Mochastic(..), Lambda(..), bind_, liftM, factor, beta, bern, lam)
import Language.Hakaru.Util.Pretty (Pretty (pretty), prettyPair)
-- import Language.Hakaru.Sample(Sample(unSample))
import Language.Hakaru.Disintegrate

import Control.Monad (zipWithM_, replicateM)
import Control.Applicative (Const(Const))
import Text.PrettyPrint (text, (<>), ($$), nest)

-- import qualified Data.Number.LogFloat as LF
-- import qualified System.Random.MWC as MWC

import Test.HUnit
import Tests.TestTools


allTests :: Test
allTests = test [
    "pair1fst/snd" ~: testSS [pair1fst, pair1snd] pair1same,
    "pair2fst" ~: testS pair2fst,
    "pair2snd" ~: testS pair2snd,
    -- "pair2'fst" ~: testS $ pair2'fst 10,
    -- "pair2'snd" ~: testS $ pair2'snd 10,
    -- "replicateH" ~: testS $ replicateH 10,
    "pair3fst" ~: testS $ pair3fst 1 [true,true,true],
    "pair3snd" ~: testS $ pair3snd 1 [true,true,true],
    "pair3trd" ~: testS $ pair3trd 1 [true,true,true],
    "pair4fst" ~: testS $ pair4fst,
    "pair4transition" ~: testS $ pair4transition $ pair true 1,
    "pair4'transition" ~: testS $ pair4'transition $ pair true 1,
    -- "transitionTest" ~: ignore $ transitionTest,
    --"testDistWithSample" ~: ignore $ do x <- testDistWithSample
    --                                    mapM_ assertJust x,
    "testLinregSimp" ~: ignore $ testS linregSimp, -- too long?
    "testdistLinregSimp" ~: testS distLinregSimp,
    "testLinreg" ~: ignore $ testS distLinreg,
    "prog1s" ~: testD prog1s,
    "prog2s" ~: testD prog2s,
    "prog3s" ~: testD prog3s,
    "pair1fstD" ~: testD (\u -> ununit u $ pair1fst),
    "pair1fstDswap" ~: testD (\u -> ununit u $ liftM swap_ pair1fst)
    ]


-- pair1fst and pair1snd are equivalent
pair1fst :: (Mochastic repr) => repr (Measure (Bool, Prob))
pair1fst =  beta 1 1 `bind` \bias ->
            bern bias `bind` \coin ->
            dirac (pair coin bias)
pair1snd :: (Mochastic repr) => repr (Measure (Bool, Prob))
pair1snd =  bern (1/2) `bind` \coin ->
            if_ coin (beta 2 1) (beta 1 2) `bind` \bias ->
            dirac (pair coin bias)

pair1same :: (Mochastic repr) => repr (Measure (Bool, Prob))
pair1same = (uniform  0 1) `bind` \x3 -> 
  superpose [((unsafeProb x3),(dirac (pair true (unsafeProb x3)))),
             ((unsafeProb (1+(x3*(-1)))),(dirac (pair false (unsafeProb x3))))]

-- pair2fst and pair2snd are equivalent
pair2fst :: (Mochastic repr) => repr (Measure ((Bool, Bool), Prob))
pair2fst =  beta 1 1 `bind` \bias ->
            bern bias `bind` \coin1 ->
            bern bias `bind` \coin2 ->
            dirac (pair (pair coin1 coin2) bias)
{'fraction_non_alphanumeric': 0.14753804834377798, 'fraction_numerical': 0.027215756490599822, 'mean_word_length': 3.0773722627737228, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1015826', 'n_tokens_mistral': 2137, 'n_tokens_neox': 2011, 'n_words': 547}