;
; random-dict.scm -- create random Link-Grammar dictionaries.
;
; Copyright (c) 2019, 2021 - Linas Vepstas
;
; --------------------------------------------------------
; OVERVIEW:
; Create random Link Grammar dictionaries with specific statistical
; distributions of link-types, disjunct-lengths, vocabulary size, etc.
;
; Example Usage:
; --------------
; See `run-common/gen-dict.scm` for an example usage.
; See documentation below for description of parameters.
;
; Issues:
; -------
; This will generate grammars parts of which are "impossible".
; That is, it will generate grammars that have disjuncts that may be
; impossible to use in a sentence, because there is no way of using
; that disjunct during sentence generation. The sentence generator
; will need to keep track of unusable disjuncts and report them.
;
; This file has some TODO's to expand the kinds and varieties
; of grammars that could be produced.
(use-modules (srfi srfi-1))
; (use-modules (srfi srfi-194))
; (load "zipf.scm")
; --------------------------------------------------------
; Convert integers to base-26 strings
(define (base-26 N UP)
"
base-26 N UP - Print number N in base-26. This returns a string.
If UP is #t, then the string is all upper-case letters; else it's
lower-case.
0 is a blank space, Word 1 is \"a\", and so on.
"
; 65 is the ascii-table offset to upper-case A
; 97 is the ascii-table offset to lower-case a
(define off (if UP 65 97))
(define lett (string (integer->char (+ off (remainder (- N 1) 26)))))
(define quot (quotient (- N 1) 26))
(cond
((<= N 0) " ")
((= 0 quot) lett)
(else (string-append/shared (base-26 quot UP) lett)))
)
; --------------------------------------------------------
; Return the N'th word in the vocabulary.
(define (make-word N)
"
make-word N - Return the N'th word in the vocabulary.
Uses 26 lower-case ascii chars only, starting at \"a\".
Basically, this just prints the number N in base-26, as a string
of lower-case letters. Word 0 is a blank space, Word 1 is
lower-case a, and so on.
"
(base-26 N #f)
)
; --------------------------------------------------------
; Create connectors
(define (make-connector N DIR)
"
make-connector N DIR - Return the N'th connector in direction DIR.
Uses 26 upper-case ascii chars only, starting at \"A\".
Basically, this just prints the number N in base-26, as a string
of upper-case letters, and appends DIR. Connector 1 is \"A\", and
so on.
"
(string-append (base-26 N #t) DIR)
)
(define (make-connector-generator N EXP)
"
make-connector-generator N EXP - generator for random connectors.
Return a generator that returns random connectors. They will be
chosen randomly, out of N, following a Zipfian distribution with
exponent EXP. For EXP=1, the classic Zipf diistribution is used,
which results in the link-type 'A' being more common than 'B' ... etc.
For EXP=0, the distribution becomes uniform, and all link types
are equally likely.
The connector direction will be randomly left-right with a 50-50
probability.
Uses 26 upper-case ascii chars only, starting at \"A\".
"
(define zippy (make-zipf-generator N EXP))
(define (dire) (if (< 0 (random 2)) "+" "-"))
(lambda () (make-connector (zippy) (dire)))
)
; Create disjuncts
;
; TODO: Implement a mode with head and tail indicators, so that
; each disjunct has:
; * Exactly one incoming (head) connector.
; * Zero or more outgoing (tail/dependent) connectors.
; * Connectors must match, as per link-grammar usual.
;
; TODO: use bi-directional directions, for order-independent languages.
(define (make-disjunct-generator NLINK DSIZE LINK-EXP SIZE-EXP)
"
make-disjunct-generator NLINK DSIZE LINK-EXP SIZE-EXP - Random disjuncts.
Return a generator for random disjuncts. Each disjunct is a
sequence of randomly chosen connectors. Connectors are chosen
out of a pool of NLINK different link types. The LINK-EXP is the
Zipf exponent for choosing link types; a value of 0 gives a uniform
distribution, a value of 1 makes the first link types more likely.
The length of the sequence of connectors will be chosen randomly,
but will never exceed DSIZE. The length of the sequence is given
by the Zipfian distribution with exponent SIZE-EXP. Setting
SIZE-EXP=1 gives the classic Zipf distribution, and most disjuncts
will be length 1 or 2. Setting SIZE-EXP to a negative value will
cause most disjuncts to be of length DSIZE.
Uses 26 upper-case ascii chars only, starting at \"A\".
"
(define congen (make-connector-generator NLINK LINK-EXP))
(define zippy (make-zipf-generator DSIZE SIZE-EXP))
(lambda ()
(list-tabulate (zippy) (lambda (X) (congen)))
)
)
; Create sections
(define-public (make-section-generator NLKTYPES DSIZE NDISJ LINK-EXP D-EXP S-EXP)
"
make-section-generator NLKTYPES DSIZE NDISJ LINK-EXP D-EXP S-EXP
Create random sections.
A 'section' is a collection of disjuncts. The number of disjuncts
in a section is controlled by NDISJ and S-EXP. The number of
disjuncts in a section will vary from 1 to NDISJ, following a Zipfian
distribution with exponent S-EXP. For S-EXP=1, most sections will
have only 1 disjunct in them, only a few will have 2 or more. For
S-EXP negative, most sections will have NDISJ disjuncts in them.
The size of a disjunct is controlled by DSIZE and D-EXP.
The distribution of connector types in a disjunct is controlled by
NLKTYPES and LINK-EXP. See `make-disjunct-generator` for details.
Uses 26 upper-case ascii chars only, starting at \"A\".
"
(define disgen (make-disjunct-generator NLKTYPES DSIZE LINK-EXP D-EXP))
(define zippy (make-zipf-generator NDISJ S-EXP))
(lambda ()
(list-tabulate (zippy) (lambda (X) (disgen)))
)
)
; --------------------------------------------------------
; Create dictionaries
(define-public (make-pos-generator NPOS SECT-GEN)
"
make-pos-generator NPOS SECT-GEN - Make lists of disjuncts
Create NPOS different disjunct-collections (sections).
The function SECT-GEN is called to obtain a section.
Return an association list of pos-tags and the disjuncts in them.
"
(define (pos N) (string-append "<pos-" (base-26 (+ 1 N) #f) ">"))
; Convert sections to strings
(define (sex)
(map
(lambda (CONLIST)
(string-append
"("
(string-join CONLIST " & ")
")"))
(SECT-GEN)))
; Populate the pos-tags.
(lambda ()
(list-tabulate NPOS (lambda (N) (list (list (pos N)) (sex)))))
)
(define-public (make-class-generator NCLASS NPOS CSIZE EXP)
"
make-class-generator NCLASS NPOS CSIZE EXP - collections of POS tags
Create NCLASS different word classes.
Each word class will have at most CSIZE different pos-tags in it.
These will be assigned randomly following a Zipfian distribution.
The pos-tags will be drawn randomly from a pool of size NPOS.
The slope of the distribution is controlled by EXP, with EXP=1
giving the classic Zipf distribution, and EXP=0 giving the uniform
distribution. A negative EXP will cause most word-classes to have
CSIZE members in them.
Return an association list of class-tags and the pos-tags in them.
"
(define (pos N) (string-append "<pos-" (base-26 (+ 1 N) #f) ">"))
(define (fcl N) (string-append "<fcl-" (base-26 (+ 1 N) #f) ">"))
(define zippy (make-zipf-generator CSIZE EXP))
(define (pick-pos)
(list-tabulate (zippy) (lambda (N) (pos (random NPOS)))))
; Populate the word-classes.
(lambda ()
(list-tabulate NCLASS (lambda (N) (list (list (fcl N)) (pick-pos)))))
)
; --------------------------------------------------------
;
(define-public (make-wall-generator NCLASS NROOTS NWALLS ENDERS)
"
make-wall-generator NCLASS NROOTS NWALLS ENDERS - create root-word classes
Out of NCLASS different word-classes, connect NWALLS of them to
the left-wall. Use NROOTS different kinds of wall connector types.
It is recommended that NCLASS be equal to or larger than NWALLS * NROOTS.
This emulates the idea of a 'root word' in a dependency grammar.
For example, in English, if NROOTS=1, this would be the 'main verb'
of a sentence, which is indicated with a link to LEFT-WALL. If NROOTS
was 2, then there would be connectors to the man verb and the main
subject (main noun).
ENDERS is a string containing sentence-ending punctuation marks.
For example, the string '. ? !'. If this string is empty, no
punctuation will be generated.
Return an association list of word-classes possibly with walls on them.
"
(define (wall-plus N) (string-append "WALL" (base-26 (+ 1 N) #t) "+"))
(define (wall-minus N) (string-append "WALL" (base-26 (+ 1 N) #t) "-"))
; Define the wall connectors
(define wall-dj
(string-join (list-tabulate NROOTS wall-plus) " & "))
(define have-punct
(and (not (nil? ENDERS)) (< 0 (string-length ENDERS))))
(define dj-punct
(if have-punct (string-append wall-dj " & PUNCT+") wall-dj))
; Define the wall, optionally with the ending punctuation.
(define wall
(list
(if (< 0 NROOTS) (list (list "LEFT-WALL") (list dj-punct)) '())
(if have-punct (list (list ENDERS) (list "PUNCT-")) '())))
(define (fcl N) (string-append "<fcl-" (base-26 (+ 1 N) #f) ">"))
(define (wcl N) (string-append "<wcl-" (base-26 (+ 1 N) #f) ">"))
; Populate the word-classes.
(define asocs
(list-tabulate NCLASS
(lambda (N) (list (list (wcl N)) (list
(if (< N (* NWALLS NROOTS))
(string-append "(" (fcl N) " & " (wall-minus (modulo N NROOTS)) ")")
(fcl N)))))))
(lambda () (append wall asocs))
)
(define-public (make-sense-generator VFRAC NCLASS NSENSES EXP)
"
make-sense-generator VFRAC NCLASS NSENSES EXP - create word senses
Place a fraction VFRAC of the total number of vocabulary words into
multiple classes picked randomly from NCLASS (with a uniform
distribution). Each word will belong to at most NSENSES different
classes. The number of senses will be chosen randomly, with a
Zipfian distribution with exponent EXP. That is, some words will
have many senses, and some will have very few. The EXP is the
exponent of the Zipfian distribution; set EXP=1 for a pure Zipf,
and set EXP=0 for a uniform distribution.
A word with multiple word-senses is just a word that has has multiple
distinct grammatical behaviors; that it, it belongs to multiple
different word-classes.
Return an association list of words and the classes they below to.
"
(define (wcl N) (string-append "<wcl-" (base-26 (+ 1 N) #f) ">"))
(define zippy (make-zipf-generator NSENSES EXP))
(define (pick-cls)
(list-tabulate (zippy) (lambda (N) (wcl (random NCLASS)))))
; Populate the word-classes.
(lambda ()
(define NVOCAB (inexact->exact (floor (* VFRAC next-word))))
(list-tabulate NVOCAB
(lambda (N) (list (list (make-word (+ N 1))) (pick-cls)))))
)
; --------------------------------------------------------
; Create word-classes -- assign words to classes with zipf distribution.
; i.e. word-class contains zipf words in it.
; Used for counting the number of words issued.
; The final value of this will be the vocabulary size.
; This is a global, specific to this module.
(define next-word 1)
(define (get-vocab-size) next-word)
(define (make-wordlist-generator LEN EXP)
"
make-wordlist-generator LEN EXP -- return a random wordlist.
Create a list of words of at most length LEN, having a Zipfian
distribution with exponent EXP. Use EXP=1 for Zipf, and EXP=0
for a uniform distribution.
The current implementation will never re-use a previously-used word.
That is, multiple meanings will never be created.
"
(define zippy (make-zipf-generator LEN EXP))
; Return a list of words.
; Each list starts with the word after the last word of the
; previous list.
(lambda ()
(define nwords (zippy))
(define nstart next-word)
(set! next-word (+ next-word nwords))
(list-tabulate nwords (lambda (N) (make-word (+ N nstart)))))
)
(define-public (make-word-generator NCLASS CSIZE EXP)
"
make-word-generator NCLASS CSIZE EXP - create word-classes
Create NCLASS different word-classes, placing at most CSIZE
words into each class.
Each word-class will have a random number of words in it, drawn
from a Zipfian distribution of size CSIZE. That is, some word
classes will have a lot of words, and some will have very few.
The EXP is the exponent of the Zipfian distribution; set EXP=1
for a pure Zipf, and set EXP=0 for a uniform distribution.
Return an association list of word-classes and the words in them.
"
(define (wcl N) (string-append "<wcl-" (base-26 (+ 1 N) #f) ">"))
(define (wclr N) (wcl (- NCLASS N 1)))
(define wlg (make-wordlist-generator CSIZE EXP))
; Populate the word-classes.
(lambda ()
(reverse
(list-tabulate NCLASS
(lambda (N) (list (wlg) (list (wclr N)))))))
)
; --------------------------------------------------------