diff --git a/name-eugenics/name-eugenics.scm b/name-eugenics/name-eugenics.scm new file mode 100644 index 0000000..1c09bec --- /dev/null +++ b/name-eugenics/name-eugenics.scm @@ -0,0 +1,48 @@ +(random-seed (time-nanosecond (current-time))) + +(define (sample elements) + (let* ((len (length elements)) + (random-index (random len))) + (list-ref elements random-index))) + +(define (flatten lst) + (cond + ((null? lst) '()) + ((list? (car lst)) (append (flatten (car lst)) (flatten (cdr lst)))) + (else (cons (car lst) (flatten (cdr lst)))))) + +(define (symbols-to-string symbol-list) + (apply string-append (map symbol->string symbol-list))) + +(define V '(a e i o u)) + +(define C '(p t k b d g f s h v z m n r l y w)) + +(define syllable-types + '((C V) + (V) + (C V C) + (V C))) + +(define (random-syllable) + (let* ((syllable-type (sample syllable-types))) + (map + (lambda (cover-symbol) + (sample (case cover-symbol + ((C) C) + ((V) V) + (else (error #f "Invalid symbol"))))) + syllable-type))) + +(define (multiple n f) + (if (= n 0) '() + (cons (f) + (multiple (- n 1) f)))) + +(let* + ((max-syllables 5) + (syllable-count (+ 1 (random max-syllables))) + (syllables (multiple syllable-count random-syllable))) + (begin + (display (symbols-to-string (flatten syllables))) + (newline))) diff --git a/name-eugenics/shell.nix b/name-eugenics/shell.nix new file mode 100644 index 0000000..6c98220 --- /dev/null +++ b/name-eugenics/shell.nix @@ -0,0 +1,4 @@ +{ pkgs ? import {} }: +pkgs.mkShell { + packages = [ pkgs.chez ]; +}