2cfe4069bb
Add a new "speech" generator module, with the beginnings of the vague definition of the phonotactics of the language (there's one in here for English based on the wikipedia article for English phonology, but it's less than ideal as it has generated words like "sprurlkt") and the ability to generate random syllables of a language by picking an onset, nucleus, and coda from the list for that language (within a range of the number of allowed of each syllable part). This will be used down the road to automatically generate utterances from various non-english-speaking creatures (so the accuracy is less important, just that it "feels real"). Change-Id: I7b81375ec595239c05c5c800cbde1a2a900e38ac Reviewed-on: https://cl.tvl.fyi/c/depot/+/3202 Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
45 lines
1.7 KiB
Haskell
45 lines
1.7 KiB
Haskell
--------------------------------------------------------------------------------
|
|
module Xanthous.RandomSpec (main, test) where
|
|
--------------------------------------------------------------------------------
|
|
import Test.Prelude
|
|
--------------------------------------------------------------------------------
|
|
import Control.Monad.Random
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Random
|
|
import Xanthous.Orphans ()
|
|
import qualified Data.Interval as Interval
|
|
import Data.Interval (Interval, Extended (Finite), (<=..<=))
|
|
--------------------------------------------------------------------------------
|
|
|
|
main :: IO ()
|
|
main = defaultMain test
|
|
|
|
test :: TestTree
|
|
test = testGroup "Xanthous.Random"
|
|
[ testGroup "chooseSubset"
|
|
[ testProperty "chooses a subset"
|
|
$ \(l :: [Int]) (Positive (r :: Double)) -> randomTest $ do
|
|
ss <- chooseSubset r l
|
|
pure $ all (`elem` l) ss
|
|
]
|
|
, testGroup "chooseRange"
|
|
[ testProperty "chooses in the range"
|
|
$ \(rng :: Interval Int) ->
|
|
not (Interval.null rng)
|
|
==> randomTest ( do
|
|
chooseRange rng >>= \case
|
|
Just r -> pure
|
|
. counterexample (show r)
|
|
$ r `Interval.member` rng
|
|
Nothing -> pure $ property Discard
|
|
)
|
|
, testProperty "nonEmpty range is never empty"
|
|
$ \ (lower :: Int) (NonZero diff) -> randomTest $ do
|
|
let upper = lower + diff
|
|
r <- chooseRange (Finite lower <=..<= Finite upper)
|
|
pure $ isJust r
|
|
|
|
]
|
|
]
|
|
where
|
|
randomTest prop = evalRandT prop . mkStdGen =<< arbitrary
|