( ns markov-language-model
( :require [ clojure.string :as string ]
[ clojure.java.io :as io ]
[ com.owoga.trie.math :as math ]
[ com.owoga.tightly-packed-trie :as tpt ]
[ com.owoga.tightly-packed-trie.encoding :as encoding ]
[ com.owoga.trie :as tr ]
[ cljol.dig9 :as d ]
[ clojure.zip :as zip ]
[ com.owoga.tightly-packed-trie.bit-manip :as bm ] ) )
( def corpus ( slurp ( io/resource "cask_of_amontillado.txt" ) ) )
( defn prep-punctuation-for-tokenization
" Puts spaces around punctuation so that they aren 't
tokenized with the words they are attached to.
Might add extraneous whitespace , but presumedly that will be ignored/removed
during tokenization. "
[ text ]
( string/replace text # "([\.,!?])" " $1 " ) )
;; For better generation of text, you'll probably want to pad the starts
;; of sentences with n-1 "start-of-sentence" tokens.
( defn add-bol-and-eol-tokens [ text ]
( -> text
( string/replace # "(\.)" "</s> . <s>" )
( # ( str "<s> " % ) ) ) )
( defn remove-quotes
[ text ]
( string/replace text # "\"" "" ) )
( defn remove-formatting-characters
" Input has underscores , presumably because the text
might be rendered by something that can italicize or bold text.
We 'll just ignore them for now. "
[ text ]
( string/replace text # "[_*]" "" ) )
( defn tokenize [ text ]
( -> text
remove-formatting-characters
prep-punctuation-for-tokenization
remove-quotes
add-bol-and-eol-tokens
string/lower-case
( string/split # "[\n ]+" ) ) )
( defn interleave-all
" Like interleave , but instead of ending the interleave when the shortest collection
has been consumed , continues to interleave the remaining collections. "
{ :added "1.0"
:static true }
( [ ] ( ) )
( [ c1 ] ( lazy-seq c1 ) )
( [ c1 c2 ]
( lazy-seq
( let [ s1 ( seq c1 ) s2 ( seq c2 ) ]
( if ( and s1 s2 )
( cons ( first s1 ) ( cons ( first s2 )
( interleave-all ( rest s1 ) ( rest s2 ) ) ) )
( lazy-seq ( or s1 s2 ) ) ) ) ) )
( [ c1 c2 & colls ]
( lazy-seq
( let [ ss ( ->> ( map seq ( conj colls c2 c1 ) )
( remove nil? ) ) ]
( when ss
( concat ( map first ss ) ( apply interleave-all ( map rest ss ) ) ) ) ) ) ) )
( comment
( let [ tokens [ 1 2 3 4 5 ]
p1 ( partition 1 1 tokens )
p2 ( partition 2 1 tokens )
p3 ( partition 3 1 tokens ) ]
[ p1
p2
p3
( interleave-all p1 p2 p3 ) ] )
;; => [((1) (2) (3) (4) (5))
;; ((1 2) (2 3) (3 4) (4 5))
;; ((1 2 3) (2 3 4) (3 4 5))
;; ((1) (1 2) (1 2 3) (2) (2 3) (2 3 4) (3) (3 4) (3 4 5) (4) (4 5) (5))]
)
( defn ngramify-tokens [ n m tokens ]
( let [ partition-colls ( map # ( partition % 1 tokens ) ( range n m ) )
ngrams ( apply interleave-all partition-colls ) ]
ngrams ) )
( comment
( ->> ( tokenize corpus )
( take 5 )
( ngramify-tokens 1 4 ) )
;; => (("the")
;; ("the" "thousand")
;; ("the" "thousand" "injuries")
;; ("thousand")
;; ("thousand" "injuries")
;; ("thousand" "injuries" "of")
;; ("injuries")
;; ("injuries" "of")
;; ("injuries" "of" "fortunato")
;; ("of")
;; ("of" "fortunato")
;; ("fortunato"))
)
( defn add-terminal-value-to-ngram
" The Trie expects entries to be of the form ' ( k1 k2 k3 value ) .
The ngrams generated above are just ' ( k1 k2 k3 ) .
This adds a value that is simply the ngram itself :
' ( k1 k2 k3 ' ( k1 k2 k3 ) ) . "
[ ngram ]
( concat ngram ( list ngram ) ) )
( comment
( let [ ngrams ( ->> corpus
tokenize
( take 200 )
( ngramify-tokens 1 4 )
( map add-terminal-value-to-ngram ) ) ] ) )
( defn trie->database
" It 's convenient to work with a trie that has keys and values as
human-readable strings , as pulled straight from a corpus in the case
of a markov trie. But to tightly pack the trie into a byte array ,
we need every value to be an integer that we can variable-length-encode.
This creates a database for conveniently converting the human-readable
entries to ids and back from ids to human-readable entries.
Ids will start at 1 so that 0 can be reserved for the root node. "
[ trie ]
( let [ sorted-keys ( ->> ( seq trie )
( sort-by ( fn [ [ k v ] ]
( :count v ) ) )
( reverse ) ) ]
( loop [ sorted-keys sorted-keys
database { }
i 1 ]
( if ( empty? sorted-keys )
database
( recur
( rest sorted-keys )
( -> database
( assoc ( first ( first sorted-keys ) )
( assoc ( second ( first sorted-keys ) ) :id i ) )
( assoc i ( first ( first sorted-keys ) ) ) )
( inc i ) ) ) ) ) )
( comment
( take 10 ( trie->database trie ) )
( let [ ngrams ( ->> corpus
tokenize
( take 200 )
( ngramify-tokens 1 4 )
( map add-terminal-value-to-ngram ) )
trie ( apply make-trie ngrams ) ]
( trie->database trie ) )
;; {("at") {:count 1, :id 39},
;; 453 ("revenge" "." "You"),
;; ("The") {:count 1, :id 37},
;; ("resolved" ",") {:count 1, :id 256},
;; 487 ("very" "definitiveness" "with"),
;; ("be" "respected") {:count 1, :id 170},
;; ("a" "point") {:count 1, :id 158},
;; 357 ("and" "he" "did"),
;; 275 ("the" "very"),
;; ("doubt" "my" "good") {:count 1, :id 381},
;; ,,,}
)
( defn transform-trie->ids
" Once we have a database to convert from string-keys to integer-ids and back ,
we can traverse the trie replacing the string-keys with their integer-ids. "
[ trie database ]
( ->> trie
( map
( fn [ [ k v ] ]
[ ( vec ( map # ( get ( get database [ % ] ) :id ) k ) )
{ :id ( get-in database [ k :id ] )
:count ( get-in database [ k :count ] ) } ] ) )
( into ( tr/make-trie ) ) ) )
( def trie
( let [ ngrams ( ->> corpus
tokenize
( ngramify-tokens 1 4 )
( map add-terminal-value-to-ngram )
( map ( fn [ entry ]
( list ( butlast entry )
( last entry ) ) ) ) ) ]
( ->> ngrams
( reduce
( fn [ acc [ k v ] ]
( update
acc
k
( fnil
( fn [ existing ]
( update existing :count inc ) )
{ :value v
:count 0 } ) ) )
( tr/make-trie ) ) ) ) )
( comment
( take 10 ( drop 1000 trie ) )
;; => ([["be" "awaiting"] {:value ("be" "awaiting"), :count 1}]
;; [["be" "cautious" "as"] {:value ("be" "cautious" "as"), :count 1}]
;; [["be" "gone"] {:value ("be" "gone"), :count 2}]
;; [["be" "ill" ","] {:value ("be" "ill" ","), :count 1}])
)
( def trie-database
( trie->database trie ) )
( comment
( take 4 trie-database )
;; => ([0 ["."]]
;; [["to" "your" "long"] {:value ("to" "your" "long"), :count 1, :id 1119}]
;; [["an" "instant" "he"] {:value ("an" "instant" "he"), :count 1, :id 4800}]
;; [["fifth" "," "the"] {:value ("fifth" "," "the"), :count 1, :id 3919}])
)
( def tpt-ready-trie ( transform-trie->ids trie trie-database ) )
( comment
( take 4 tpt-ready-trie )
;; => ([[0 1 27] {:id 5082, :count 1}]
;; [[0 1 104] {:id 5072, :count 1}]
;; [[0 1 112] {:id 5075, :count 1}]
;; [[0 1 146] {:id 5077, :count 1}])
)
( defn value-encode-fn [ v ]
( if ( = v ::tpt/root )
( encoding/encode 0 )
( byte-array
( concat ( encoding/encode ( :id v ) )
( encoding/encode ( :count v ) ) ) ) ) )
( defn value-decode-fn [ byte-buffer ]
( let [ id ( encoding/decode byte-buffer ) ]
( if ( zero? id )
{ :id :root }
{ :id id
:count ( encoding/decode byte-buffer ) } ) ) )
( def tightly-packed-trie
( tpt/tightly-packed-trie tpt-ready-trie value-encode-fn value-decode-fn ) )
;;;; DEMO
;;;; ** Out of date since new TrieAgain code
( comment
;;;; Size comparisons
;;
;; Original trie, keys and values are lists and strings.
;; ~1,900 kb
( d/sum [ trie ] )
;; 61112 objects
;; 103249 references between them
;; 1901656 bytes total in all objects
;; no cycles
;; 8421 leaf objects (no references to other objects)
;; Original trie, keys and values numbers
;; ~900 kb
( d/sum [ tpt-ready-trie ] )
;; 30008 objects
;; 62543 references between them
;; 907992 bytes total in all objects
;; no cycles
;; 5438 leaf objects (no references to other objects)
;; Tightly-packed-trie, keys and values numbers (backed by var-len encoded ints)
;; ~36 kb
( d/sum [ tightly-packed-trie ] )
;; 6 objects
;; 5 references between them
;; 36736 bytes total in all objects
;; no cycles
;; 4 leaf objects (no references to other objects)
;;;; Size comparison summary
;;
;; Condensed original: 900 kb
;; Tightly packed: 36 kb
;; Compression: ~96% !!!
;;;; Getting value from each type of trie
;;
( get trie [ "<s>" "i" "was" ] )
;; => {:value ("<s>" "i" "was"), :count 1}
( get tpt-ready-trie [ 0 8 21 ] )
;; => {:id 5116, :count 1}
( get tightly-packed-trie [ 0 8 21 ] )
;; => {:id 5116, :count 1}
;; And then to get back to a string version, use the database.
( ->> [ 0 8 21 ]
( get tightly-packed-trie )
:id
( get trie-database )
( get trie-database ) )
;; => {:value ("<s>" "i" "was"), :count 1, :id 5116}
;;;; Our "database" (just a hash-map) serves a dual purpose.
;;
;; It maps n-grams to their frequency counts and to an integer ID.
;; It also maps that integer ID back to the n-gram.
( take 10 trie-database )
;; => ([("Then" "I") {:count 1, :id 1475}]
;; [("to" "your" "long") {:count 1, :id 5371}]
;; [("an" "instant" "he") {:count 1, :id 3842}]
;; [("fifth" "," "the") {:count 1, :id 4209}]
;; [("from" "the" "depth") {:count 1, :id 4270}]
;; [2721 ("the" "more")]
;; [("during" "which" ",") {:count 1, :id 4144}]
;; [("nodded") {:count 1, :id 674}]
;; [("the" "feeble") {:count 1, :id 2693}]
;; [("intermingling" "," "into") {:count 1, :id 4488}])
;;;; Database
;; Each n-gram has its own integer ID. The integer IDs should be handed
;; out to n-grams in order of frequency. Therefore, you're 1-grams will probably
;; have lower IDs than the higher-order n-grams.
;;
;; Here we see "," is the 2nd most-common n-gram.
( get-in trie-database [ ' ( "," ) :id ] ) ;; => 7
( get-in trie-database [ ' ( "i" ) :id ] ) ;; => 8
;; The ID of a 2-gram is not related in any way to
;; the two 1-grams that make it up. Every n-gram is unique
;; and gets its own unique ID.
;;
;; BUT... Every node is referenced by a 1-gram key.
;; So the 2-gram '("," "I") is referenced from
;; the :root key's children by the 1-gram key '(",")
;; and then by that 1-gram key's children by the 1-gram '("I").
;; The VALUE of that node though is the 2-gram '("," "I").
;;
;; To re-iterate: The keys are all 1-grams at every nesting level.
;; The values are the higher-order n-grams the lower in the nesting
;; that you go.
( get-in trie-database [ ' ( "," "i" ) :id ] ) ;; => 23
;;;; Trie vs Tightly Packed Trie
;;;;
;; The interface is *almost* the same between the two.
;; Tightly packed tries can't be updated or written to.
;; They can only be read.
;; And to get from integer IDs to human-readable strings,
;; you need to go through the database.
;;
;; Other than that though, let's see it in action!
;;
;;;; Here is the Trie
( get trie ' ( "i" ) )
;; => {:value ("i"), :count 107}
( ->> ( tr/lookup trie ' ( "i" ) )
( take 5 ) )
;; => ([["," "i"] {:value ("i" "," "i"), :count 1}]
;; [[","] {:value ("i" ","), :count 1}]
;; [["again" "paused"] {:value ("i" "again" "paused"), :count 1}]
;; [["again"] {:value ("i" "again"), :count 1}]
;; [["am" "on"] {:value ("i" "am" "on"), :count 1}])
( ->> ( tr/lookup trie ' ( "i" ) )
( tr/children )
( map # ( get % [ ] ) )
( take 5 ) )
;; => ({:value ("i" ","), :count 1}
;; {:value ("i" "again"), :count 1}
;; {:value ("i" "am"), :count 1}
;; {:value ("i" "answered"), :count 1}
;; {:value ("i" "began"), :count 2})
;;;; And here is the tightly-packed trie
( ->> ( tr/lookup tightly-packed-trie ' ( 8 ) )
( tr/children )
( map # ( get % [ ] ) )
( take 5 ) )
;; => ({:id 3392, :count 1}
;; {:id 3270, :count 1}
;; {:id 129, :count 5}
;; {:id 70, :count 9}
;; {:id 69, :count 9})
( ->> ( tr/lookup tightly-packed-trie ' ( 8 ) )
( tr/children )
( map # ( get % [ ] ) )
( take 5 )
( map # ( get trie-database ( :id % ) ) ) )
;; => (["i" ","] ["i" "to"] ["i" "was"] ["i" "had"] ["i" "said"])
;;;; Ta-da!
)
( defn key-get-in-tpt [ tpt db ks ]
( let [ id ( map # ( get-in db [ ( list % ) :id ] ) ks )
v ( get tpt id ) ]
{ id v } ) )
( defn id-get-in-tpt [ tpt db ids ]
( let [ ks ( apply concat ( map # ( get db % ) ids ) )
v ( get tpt ids )
id ( get-in db [ ks :id ] ) ]
{ ks ( assoc v :value ( get db id ) ) } ) )
( comment
( key-get-in-tpt
tightly-packed-trie
trie-database
' ( "i" "will" ) )
;; => {(8 49) {:id 3257, :count 1}}
( id-get-in-tpt
tightly-packed-trie
trie-database
' ( 8 49 ) )
;; => {("i" "will") {:id 3257, :count 1, :value ["i" "will"]}}
)
;;;; Markov-generating text from trie
( comment
( def example-story
( loop [ generated-text [ ( :id ( get trie-database [ "<s>" ] ) ) ]
i 0 ]
( if ( > i 100 )
generated-text
( recur
( conj
generated-text
( tpt/.key
( math/weighted-selection
# ( :count ( get % [ ] ) )
( loop [ i 3
children
( tr/children
( tr/lookup
tightly-packed-trie
( vec ( take-last i generated-text ) ) ) ) ]
( if ( empty? children )
( recur ( dec i )
( tr/children
( tr/lookup
tightly-packed-trie
( vec ( take-last i generated-text ) ) ) ) )
children ) ) ) ) )
( inc i ) ) ) ) )
( ->> example-story
( map # ( get trie-database % ) )
( apply concat )
( remove # { "<s>" "</s>" } )
( string/join " " )
( # ( string/replace % # " ([\.,\?])" "$1" ) )
( ( fn [ txt ]
( string/replace txt # "(^|\. |\? )([a-z])" ( fn [ [ a b c ] ]
( str b ( .toUpperCase c ) ) ) ) ) ) )
;; => "I broke and reached him a flagon of de grave. We came at length. He again took my arm, and holding the flambeaux over the wall; i replied, were a great and numerous family. Whither? to your long life. Putting on a tight-fitting parti-striped dress, and descending again, and had given them explicit orders not to be found, and this time i made bold to seize fortunato by an arm above the elbow. In its destined position."
)