Generate random names based on a lexicon.
Parses a Lexicon from a multi-line string
The function takes:
and returns a random generator for the specified entry.
The filler string is used when some definition references a key that does not exist in the Lexicon.
The filler function is also used to break possible infinite recursions caused by a key.
nameGenerator =
LexicalRandom.generator "-" englishGibberishLexicon "properNoun"
( name, seed ) =
Random.step nameGenerator seed
You need to understand this stuff only if you want to dynamically add entries to the lexicon.
The Lexicon is a Dict mapping an entry identifier to an Array of all the alternative Definitions that can be used to generate a name.
A fragment is used to generate a part of a name. It can either be a constant String, either a reference to an lexicon entry.
A Definition is a List of Fragments used to generate a single name
module LexicalRandom
exposing
( Lexicon
, Fragment(..)
, Definition
, generator
, fromString
)
{-| Generate random names based on a lexicon.
# Basics
@docs fromString, generator
# Advanced
You need to understand this stuff only if you want to dynamically add entries
to the lexicon.
@docs Lexicon, Fragment, Definition
-}
import Array exposing (Array)
import Dict exposing (Dict)
import Random exposing (Generator)
import Random.Array
import Random.Extra
import String
import Regex exposing (regex)
-- types
{-| A fragment is used to generate a part of a name.
It can either be a constant String, either a reference to an lexicon entry.
-}
type Fragment
= Constant String
| Key String
{-| A Definition is a List of Fragments used to generate a single name
-}
type alias Definition =
List Fragment
{-| The Lexicon is a Dict mapping an entry identifier to an Array of all the
alternative Definitions that can be used to generate a name.
-}
type alias Lexicon =
Dict String (Array Definition)
-- Random helpers
choices : Generator a -> Array (Generator a) -> Generator a
choices default array =
Random.Array.sample array
|> Random.andThen (Maybe.withDefault default)
{-| The function takes:
- A filler String
- A Lexicon
- The name of an entry in the Lexicon
and returns a random generator for the specified entry.
The filler string is used when some definition references a key
that does not exist in the Lexicon.
The filler function is also used to break possible infinite recursions caused by a key.
nameGenerator =
LexicalRandom.generator "-" englishGibberishLexicon "properNoun"
( name, seed ) =
Random.step nameGenerator seed
-}
generator : String -> Lexicon -> String -> Generator String
generator filler lexicon key =
case Dict.get key lexicon of
Nothing ->
-- either the key is plain invalid, or it is stuck in a loop
Random.Extra.constant filler
Just definitions ->
let
-- Remove used keys to prevent infinite recursion
reducedLexicon =
Dict.remove key lexicon
fragmentToGenerator fragment =
case fragment of
Key key ->
generator filler reducedLexicon key
Constant string ->
Random.Extra.constant string
definitionToGenerator definition =
List.map fragmentToGenerator definition
|> Random.Extra.combine
|> Random.map (String.join "")
in
Array.map definitionToGenerator definitions
|> choices (Random.Extra.constant "")
{-| Parses a Lexicon from a multi-line string
-}
fromString : String -> Lexicon
fromString stringLexicon =
let
stringToDefinition stringDefinition =
let
chunkToFrags chunk =
case String.split "}" chunk of
key :: constant :: [] ->
[ Key key, Constant constant ]
_ ->
[ Constant chunk ]
in
stringDefinition
|> String.split "{"
|> List.map chunkToFrags
|> List.concat
addToLexiconKey key line lexicon =
let
newDefinitions =
line
|> String.split ","
|> List.map String.trim
|> List.filter ((/=) "")
|> List.map stringToDefinition
|> Array.fromList
existingDefinitions =
Dict.get key lexicon
|> Maybe.withDefault Array.empty
in
Dict.insert key (Array.append existingDefinitions newDefinitions) lexicon
addLine : String -> ( String, Lexicon ) -> ( String, Lexicon )
addLine line ( currentKey, lexicon ) =
if Regex.contains (regex "^\\s*#") line then
( currentKey, lexicon )
else if Regex.contains (regex "^\\s") line then
( currentKey, addToLexiconKey currentKey line lexicon )
else
( line, lexicon )
in
List.foldl addLine ( "default", Dict.empty ) (String.lines stringLexicon)
|> Tuple.second