name-eugenics: import
This commit is contained in:
48
name-eugenics/name-eugenics.scm
Normal file
48
name-eugenics/name-eugenics.scm
Normal file
@@ -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)))
|
||||
4
name-eugenics/shell.nix
Normal file
4
name-eugenics/shell.nix
Normal file
@@ -0,0 +1,4 @@
|
||||
{ pkgs ? import <nixpkgs> {} }:
|
||||
pkgs.mkShell {
|
||||
packages = [ pkgs.chez ];
|
||||
}
|
||||
Reference in New Issue
Block a user