feat(xanthous): Add a generator for random english syllables

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
This commit is contained in:
Griffin Smith 2021-06-12 21:11:58 -04:00 committed by grfn
parent 006e5231e5
commit 2cfe4069bb
7 changed files with 216 additions and 26 deletions

View file

@ -11,9 +11,10 @@ module Xanthous.Random
, subRand
, chance
, chooseSubset
, chooseRange
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Xanthous.Prelude
--------------------------------------------------------------------------------
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom))
@ -25,6 +26,9 @@ import Data.Random.Distribution.Uniform
import Data.Random.Distribution.Uniform.Exclusive
import Data.Random.Sample
import qualified Data.Random.Source as DRS
import Data.Interval ( Interval, lowerBound', Extended (Finite)
, upperBound', Boundary (Closed)
)
--------------------------------------------------------------------------------
instance {-# INCOHERENT #-} (Monad m, MonadRandom m) => DRS.MonadRandom m where
@ -81,11 +85,13 @@ evenlyWeighted = Weighted . itoList
weightedBy :: Functor t => (a -> w) -> t a -> Weighted w t a
weightedBy weighting xs = Weighted $ (weighting &&& id) <$> xs
instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighted w [] a) where
instance (Num w, Ord w, Distribution Uniform w, Excludable w)
=> Choose (Weighted w [] a) where
type RandomResult (Weighted w [] a) = Maybe a
choose (Weighted ws) = sample $ headMay <$> weightedSample 1 ws
instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighted w NonEmpty a) where
instance (Num w, Ord w, Distribution Uniform w, Excludable w)
=> Choose (Weighted w NonEmpty a) where
type RandomResult (Weighted w NonEmpty a) = a
choose (Weighted ws) =
sample
@ -112,6 +118,33 @@ chooseSubset :: ( Num w, Ord w, Distribution Uniform w, Excludable w
) => w -> t a -> m (t a)
chooseSubset = filterA . const . chance
-- | Choose a random @n@ in the given interval
chooseRange
:: ( MonadRandom m
, Distribution Uniform n
, Enum n
, Bounded n, Show n, Ord n)
=> Interval n
-> m (Maybe n)
chooseRange int = traverse sample distribution
where
(lower, lowerBoundary) = lowerBound' int
lowerR = case lower of
Finite x -> if lowerBoundary == Closed
then x
else succ x
_ -> minBound
(upper, upperBoundary) = upperBound' int
upperR = case upper of
Finite x -> if upperBoundary == Closed
then x
else pred x
_ -> maxBound
distribution
| lowerR <= upperR = Just $ Uniform lowerR upperR
| otherwise = Nothing
--------------------------------------------------------------------------------
bools :: NonEmpty Bool