anchor.diff: -;; Weighted branches trie
  -;;; 
  -;;; A trie implementation with nodes holding a width value;
  -;;; an integer telling how many branches go through each node.
  -;;; 
  -;;; Author: Peter Hillerström
  -;;; Initial version: 2010-08-01
  -;;; 
  -;;; This trie implementation can hold nodes with keys of any type, 
  -;;; and can manipulate tries with any type of sequence as keys.
  -
  -
  -;; Example of representation:
  -;; '(ROOT 2 ((F 2 ((G 1 NIL) (H 1 NIL))))) ; ROOT -> F -> (G E)
  -
  -(defpackage :trie)
  -; (:use :cl)
  -
  +;;; -*- Mode: Lisp -*-
  +;;; 
  +;;; P-TRIE - probability trie (with branch widths)
  +;;; 
  +;;; Author:
  +;;;     Peter Hillerström
  +;;; Version:
  +;;;     0.1
  +;;; Initial Comon Lisp version:
  +;;;     2010-08-01
  +;;; 
  +;;; Features:
  +;;;     This trie implementation has an original idea of “branch width”
  +;;;     invented by Peter Hillerström on 14 of November 2008.
  +;;;     Branch width of a trie node tells how many branches go through that node.
  +;;;     Widths can be used to calculate probabilites for different suffixes.
  +;;; 
  +;;; Notes about this implementation:
  +;;;     * P-trie is implemented recursively, so ‘trie’ can mean the whole tree 
  +;;;       or a single node on a trie.
  +;;;     * Keys can be sequences of any type.
  +;;;     * IMPORTANT: All functions are destructive, for efficiently handling 
  +;;;       large data sets. There will be non-destructive versions of functions.
  +;;; 
  +;;; About tries generally:
  +;;;     Trie, or prefix tree, is an ordered tree data structure that is used to store 
  +;;;     an associative array where the keys are usually strings. Unlike a binary search 
  +;;;     tree, no node in the tree stores the whole key associated with that node; 
  +;;;     instead, its position in the tree shows what key it is associated with.
  +;;;     
  +;;;     All the descendants of a node have a common prefix of the string associated 
  +;;;     with that node, and the root is associated with the empty string.
  +;;;     Looking up a key of length m takes worst case O(m) time.
  +;;;     
  +;;;     More information about tries:
  +;;;     http://en.wikipedia.org/wiki/Trie
  +
  +(defpackage :ptrie
  +    (:export
  +        ; Predicates
  +        :branchesp :leafp :wordp
  +        
  +        ;; Init and slots
  +        :make-trie :trie-key :trie-width :trie-branches
  +        
  +        ;; Insert, retrieve and remove (CRUD) operations
  +        :add-seq :add-seqs
  +        :find-key :find-seq
  +        
  +        ;; Printing
  +        :pprint-trie :print-words
  +        
  +        ;; Extras
  +        :trie-prob :test-trie
  +        )
  +    (:use :cl))
  +
  +(in-package :ptrie)
  +
  +(defparameter *print-pretty* t)
   (defparameter *print-circle* t)
  -(defparameter *print-pretty* t)
   (defparameter *debug* nil)
   
  -; Struct node occupies 24 bits for slots and 16 for 1-char key = 40 bits
  -(defstruct
  -    (trie
  -        (:type list)
  -        ; :named
  -        )
  -    (key "" :read-only t)   ; generic - could be :type char
  +;;; Initialization
  +;;;
  +;;; With struct, trie nodes occupy (without contents):
  +;;; Struct:             8 bits for each slot (24 bits)
  +;;; (with contents:     + 16 bits for 1-char key = 40 bits)
  +;;;
  +;;; Alternative implementation could use lists, arrays or objects:
  +;;; Linked cons cells:  3 * cons (8 bits) = 24 bits
  +;;; Class:              16 for class, 20 for vector = 36 bits
  +
  +(defstruct (trie (:type list))
  +    "Trie data structure, see package documentation for more info."
  +    (key "" :read-only t)       ; Generic type -- could be :type char
       (width 0 :type integer)
       (branches nil :type list))  ; Could a vector for optimization, but complicates things!
   
  -(defun test ()
  -    (setf r (make-trie))
  -    (add-seqs r '("blow" "boa" "blush" "foo")))
  -
  -; Sentence level
  -
  -(defun add-seqs (trie seqs)
  -    (mapcar #'(lambda (seq) (add-seq trie seq))
  -        seqs))
  -
  -; Word level
  +(defun test-trie ()
  +    "Simple utility function to build a test trie."
  +    (let ((r (make-trie)))
  +        (add-seqs r (mapcar #'(lambda (s) (string-downcase (string s)))
  +                            '(blow boa blush foo bar baz)))
  +        (pprint-trie t r)
  +        r))
  +
  +
  +;;; Predicates
  +
  +(defun wordp (trie)
  +    (find-key trie t))
  +
  +(defun branchesp (trie)
  +    ; TODO account for (t 1 nil) nodes for word endings
  +    (car (trie-branches trie)))
  +
  +(defun leafp (trie)
  +    (not (branchesp trie)))
  +
  +
  +;;; Retrieval
   
   (defun find-seq (trie seq)
       "Find a sequence from trie"
  
positive.code: ;     (wrap-recursion (#'recurse-trie trie seq)
  ;         (unless symbol
  ;             (setf symbol (add-key trie (elt seq 0))))
  ;         (incf (trie-width symbol))))
  
negative.code:             (return-from find-seq nil)
              (find-seq symbol (subseq seq 1)))))
  
  (defun find-key (trie key)
      "Return a symbol matching key from trie's branches."
      (find key (trie-branches trie) :test #'equal :key (lambda (n) (trie-key n))))
  
  
  ;;; Insertion
  
  (defun add-seqs (trie seqs)
      (mapcar #'(lambda (seq) (add-seq trie seq))
          seqs))
  
  (defun add-seq (trie seq &optional (count 1))
      "Add a branch to the trie count times. If branch already exists, increase it’s width.
      A count below one is changed to one. Modifies trie in-place."
      (when (< count 0) (error (format nil "Negative count ~A." count)))
      (incf (trie-width trie) count)
      (when (zerop (length seq))
          (add-key trie t count)
          (return-from add-seq trie))
      (let ((symbol (add-key trie (elt seq 0) 0)))
          ; (add-key trie (elt seq 0) count)
          (add-seq symbol (subseq seq 1) count)))
  
  (defun add-key (trie key &optional (count 1))
      "Add a node to trie. If node exists, increases it’s width."
      (when (< count 0) (error (format nil "Negative count ~A." count)))
      (let ((node (find-key trie key)))
          (if node
              (incf (trie-width node) count)
              (setq node (create-node trie key count)))
          node))
  
  (defun create-node (trie key &optional (count 0))
      "Destructively adds node to trie"
      (car (push (make-trie :key key :width count) (trie-branches trie))))
  
  
  ;;; Removal
  
  ; (defun remove-key (trie key &optional (count 1))
  ;     "### Remove a node from trie. If node exists, decrease it’s width.
  ;     
  ;     1. Find if key exist.
  ;     2. Decrease it's width when is less than or equal to count.
  ;     3. If width is 0, remove node into new trie to be returned."
  ;     nil)
  
  ; (defun remove-key-broken (trie key)
  ;     "###"
  ;     (let ((node (find-key trie key))
  ;           (branches (trie-branches trie)))
  ;         (when node
  ;             (decf (trie-width node)) ; FIXME
  ;             (when (<= 0 trie-width node)
  ;                 (setf branches (remove-if #'(lambda (x) (equal x key)) branches))))))
  
  
  ; (defun remove-seq (trie seq &optional (count 1))
  ;     "### Remove a sequence from trie"
  ;     (unless (find-seq trie seq)
  ;         (return-from remove-seq nil))
  ;     (decf (trie-width trie) (max count 1))
  