gnu-emacs-sources
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

tstree.el -- new release


From: Toby Cubitt
Subject: tstree.el -- new release
Date: Sat, 27 May 2006 16:39:29 +0200
User-agent: Mutt/1.5.11


;;; tstree.el --- ternary search tree package


;; Copyright (C) 2004-2006 Toby Cubitt

;; Author: Toby Cubitt <address@hidden>
;; Version: 0.6
;; Keywords: ternary search tree, tstree
;; URL: http://www.dr-qubit.org/emacs.php


;; This file is NOT part of Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301, USA.


;;; Commentary:
;;
;; A ternary search tree associates data with keys. The keys can be
;; any ordered sequence of elements: vector, list or string. It stores
;; them in such a way that both storage size and data lookup are
;; reasonably space- and time-efficient, respectively. But more
;; importantly, returning all strings with a given prefix in
;; alphabetical or any other sort-order is also time-efficient.
;;
;; A ternary search tree consists of two cons cells, the first one
;; holding the tag 'TSTREE in the car cell and the second one having
;; the tree in the car and the compare function in the cdr cell. The
;; compare function must take two arguments of the type which is to
;; be stored in the tree and must return a negative value if the
;; first argument is "less than" the second, a positive value if the
;; first argument is "greater than" the second, and zero if the two
;; arguments are "equal".
;;
;; You create a ternary search tree using `tstree-create', add data to
;; it using `tstree-insert', lookup data using `tstree-member', find
;; completions of a sequence and their associated data using
;; `tstree-complete', find completions and sort them in an order you
;; specify using `tstree-complete-ordered', and map over it using
;; `tstree-map' and `tstree-mapcar'. Various other useful functions
;; are also provided.
;;
;; This package uses the ternary heap package heap.el.


;;; Change Log:
;;
;; Version 0.6
;; * lists of trees now act as one combined tree when passed as
;;   arguments to most functions
;; * data in a tree can now be referenced by any sequence type
;; * removed cl dependency
;;
;; Version 0.5.2
;; * fixed internal function and macro names
;;
;; Version 0.5.1
;; * added more commentary
;;
;; Version 0.5
;; * completion functions now return lists instead of vectors
;;
;; Version 0.4
;; * removed elib dependency by replacing elib stacks with lists
;;
;; Version 0.3
;; * added `tstree-mapcar' macro
;;
;; Version 0.2.1
;; * fixed bug in `tstree-map' so it doesn't error on empty trees
;;
;; Version 0.2
;; * added `tstree-map' function
;;
;; Version 0.1
;; * initial release



;;; Code:

(provide 'tstree)
(require 'heap)




;;; ================================================================
;;;                Replacements for CL functions

(defmacro tstree--signum (n)  ; INTERNAL USE ONLY
  ;; Return 1 if x is positive, -1 if negativs, 0 if zero.
  `(cond ((> ,n 0) 1) ((< ,n 0) -1) (t 0))
)




;;; ================================================================
;;;  Internal functions for use in the ternary search tree package


(defmacro tstree--tree-root (tree)  ; INTERNAL USE ONLY.
  ;; Return the root node for a ternary search tree.
  `(tstree--node-equal (car (cdr ,tree)))
)



(defmacro tstree--tree-dummyroot (tree)  ; INTERNAL USE ONLY.
  ;; Return the dummy node of a ternary search tree.
  `(car (cdr ,tree))
)



(defmacro tstree--tree-cmpfun (tree)  ; INTERNAL USE ONLY.
  ;; Return the compare function of ternary search tree TREE.
  `(car (cdr (cdr ,tree)))
)



(defmacro tstree--tree-insfun (tree)  ; INTERNAL USE ONLY.
  ;; Return the insert function of ternary search tree TREE.
  `(car (cdr (cdr (cdr ,tree))))
)


(defmacro tstree--tree-rankfun (tree)  ; INTERNAL USE ONLY
  ;; Return the rank function of ternary search tree TREE.
  `(cdr (cdr (cdr (cdr ,tree))))
)


(defmacro tstree--node-create (low equal high split)  ; INTERNAL USE ONLY.
  ;; Create a TST node from LOW, EQUAL, HIGH and SPLIT.
  ;; Note: If SPLIT is nil, EQUAL stores data rather than a pointer
  `(vector ,low ,equal ,high ,split)
)



(defmacro tstree--node-p (obj)  ; INTERNAL USE ONLY
  ;; Return t if OBJ is a valid ternary search tree node, nil
  ;; otherwise.
  `(and (vectorp ,obj) (= (length ,obj) 4))
)



(defmacro tstree--node-low (node)  ; INTERNAL USE ONLY.
  ;; Return the low pointer of NODE.
  `(aref ,node 0)
)



(defmacro tstree--node-equal (node)  ; INTERNAL USE ONLY.
  ;; Return the equal pointer of NODE.
  `(aref ,node 1)
)



(defmacro tstree--node-high (node)  ; INTERNAL USE ONLY.
  ;; Return the high pointer of NODE.
  `(aref ,node 2)
)



(defmacro tstree--node-split (node)  ; INTERNAL USE ONLY.
  ;; Return the split value of NODE.
  `(aref ,node 3)
)




(defmacro tstree--node-branch (node d)  ; INTERNAL USE ONLY.
  ;; For D negative, zero, or positive, return the low, equal or high
  ;; pointer of NODE respectively.
  `(aref ,node (1+ (tstree--signum ,d)))
)



(defmacro tstree--node-set-high (node newhigh)  ; INTERNAL USE ONLY.
  ;; Set the high pointer of NODE to NEWHIGH
  `(aset ,node 0 ,newhigh)
)



(defmacro tstree--node-set-equal (node newequal)  ; INTERNAL USE ONLY.
  ;; Set the equal pointer of NODE to NEWEQUAL
  `(aset ,node 1 ,newequal)
)



(defmacro tstree--node-set-low (node newlow)  ; INTERNAL USE ONLY.
  ;; Set the low pointer of NODE to NEWLOW
  `(aset ,node 2 ,newlow)
)



(defmacro tstree--node-set-split (node newsplit)  ; INTERNAL USE ONLY.
  ;; Set the split value of NODE to NEWSPLIT
  `(aset ,node 3 ,newsplit)
)



(defmacro tstree--node-set-branch (node d newbranch)  ; INTERNAL USE ONLY.
  ;; If D is negative, zero or positive, set the high, equal or low
  ;; value respectively of NODE to NEWBRANCH.
  `(aset ,node (1+ (tstree--signum ,d)) ,newbranch)
)




(defun tstree--node-find (tree string)  ; INTERNAL USE ONLY
  ;; Returns the node corresponding to STRING, or nil if none found.
  
  (cond
   ;; don't search for nil!
   ((null string) nil)
   ;; return root node if searching for an empty string
   ((= 0 (length string)) (tstree--tree-root tree))
   ;; otherwise search for node corresponding to string
   (t (let ((cmpfun (tstree--tree-cmpfun tree))
            (node (tstree--tree-root tree))
            (c 0) (chr (elt string 0)) (d 0)
            (len (length string)))
        
        ;; as long as we keep finding nodes, keep descending the tree
        (while (and node (< c len))
          (setq d (funcall cmpfun chr (tstree--node-split node)))
          (if (= 0 d)
              (when (< (setq c (1+ c)) len) (setq chr (elt string c))))
          (setq node (tstree--node-branch node d)))
        node))
  )
)



(defmacro tstree-construct-sortfun (cmpfun)
  "Construct function to compare keys, based on a CMPFUN
that compares individual elements of that type."
  `(lambda (a b)
     (let (cmp)
       (catch 'compared
         (dotimes (i (min (length a) (length b)))
           (setq cmp (funcall ,cmpfun (elt a i) (elt b i)))
           (cond ((< cmp 0) (throw 'compared nil))
                 ((> cmp 0) (throw 'compared t))))
         (> (length a) (length b)))))
)




;;; ================================================================
;;;    The public functions which operate on ternary search trees.


(defun tstree-create (&optional compare-function insert-function
                                rank-function)
  "Create an empty ternary search tree. If no arguments are
supplied, it creates a tree suitable for storing strings with
numerical data.

The optional COMPARE-FUNCTION sets the comparison function for
the tree. COMPARE-FUNCTION takes two arguments, A and B, and
returns a negative value if A is less than B, zero if A is equal
to B, and a positive value if A is greater than B. It defaults to
subtraction.

The optional INSERT-FUNCTION takes two arguments of the type
stored as data in the tree or nil, and returns the same type. It
defaults to \"replace\". See `tstree-insert'.

The optional RANK-FUNCTION takes two arguments, each a cons whose
car is an array (vector or string) referencing data in the tree,
and whose cdr is the data at that reference. It should return
non-nil if the first argument is \"better than\" the second, nil
otherwise. It defaults to numerical comparison of the data using
\"greater than\". Used by `tstree-complete-ordered' to rank
completions."

         ;; comparison-function defaults to -
  (let* ((cmpfun (when compare-function compare-function '-))
         ;; the lambda expression redefines the compare funtion to ensure
         ;; that all values other than nil are "greater" than nil
         (cmpfun `(lambda (a b)
                    (cond ((and (null a) (null b)) 0) ((null a) -1)
                          ((null b) 1) (t (,cmpfun a b)))))
         ;; insert-function defaults to "replace".
         (insfun (if insert-function insert-function (lambda (a b) a)))
         ;; rank function defaults to >
         (rankfun (if rank-function rank-function
                    (lambda (a b) (> (cdr a) (cdr b))))))
  
    (cons 'TSTREE
          (cons (tstree--node-create nil nil nil t)
                (cons cmpfun
                      (cons insfun rankfun))))
  )
)




(defun tstree-p (obj)
  "Return t if OBJ is a ternary search tree, nil otherwise."
  (eq (car-safe obj) 'TSTREE)
)



(defun tstree-compare-function (tree)
  "Return the comparison function for the ternary search tree TREE."
  (tstree--tree-cmpfun tree)
)



(defun tstree-insert-function (tree)
  "Return the insertion function for the ternary search tree TREE."
  (tstree--tree-insfun tree)
)



(defun tstree-rank-function (tree)
  "Return the rank function for the ternary seach tree TREE."
  (tstree--tree-rankfun tree)
)



(defun tstree-empty (tree)
  "Return t if the ternary search tree TREE is empty, nil otherwise."
  (null (tstree--tree-root tree))
)



(defun tstree-insert (tree string &optional data insert-function)
  "Calculate the result of applying the tree TREE's insetion
function to DATA and the existing data at position STRING in the
tree (or nil if empty), and insert the result into the ternary
search tree at the position referenced by STRING. STRING must be
an array (vector or string) containing the type used to reference
data in the tree.

The optional INSERT-FUNCTION over-rides the tree's own insertion
function. It should take two arguments of the type stored as data
in the tree, or nil. The first is the data DATA, the second is
the data stored at position STRING in the tree, or nil if STRING
doesn't yet exist. It should return the same type. The return
value is stored in the tree."
  
  ;; don't add empty strings to the tree
  (if (= 0 (length string)) nil
    
    (let ((cmpfun (tstree--tree-cmpfun tree))
          (insfun (if insert-function insert-function
                    (tstree--tree-insfun tree)))
          (node (tstree--tree-dummyroot tree))
          (c 0) (chr (elt string 0)) (d 0)
          (len (length string)) newdata)
      
      ;; as long as we keep finding nodes, keep descending the tree
      (while (and node (tstree--node-branch node d))
        (setq node (tstree--node-branch node d))
        (setq d (funcall cmpfun chr (tstree--node-split node)))
        (when (= 0 d)
          (if (< (setq c (1+ c)) len)
              (setq chr (elt string c))
            ;; if complete string already exists in the tree and
            ;; we've found the data node, insert new data
            (if (tstree--node-split node)
                (setq chr nil)  ; not at data node so keep descending
              (tstree--node-set-equal
               node (setq newdata
                          (funcall insfun data (tstree--node-equal node))))
              (setq node nil)))))  ; forces loop to exit
      
      ;; once we've found one node that doesn't exist, must create all
      ;; others
      (while node
        ;; create nodes for remainder of string, if any
        (if (< c len)
            (progn
              (setq chr (elt string c))
              (tstree--node-set-branch
               node d (tstree--node-create nil nil nil chr))
              (setq node (tstree--node-branch node d))
              (setq d 0)
              (setq c (1+ c)))
          ;; if we've reached end of string, create data node and exit
          (tstree--node-set-branch
           node d (tstree--node-create
                   nil (setq newdata (funcall insfun data nil)) nil nil))
          (setq node nil)))  ; fores loop to exit
      
      ;; return the newly inserted data
      newdata)
  )
)




(defun tstree-member (tree string &optional combine-function)
  "Return the data referenced by STRING from the tree TREE,
or nil if STRING does not exist in the tree.

Note: this will not distinguish between a non-existant STRING and
a STRING whose data is nil. Use `tstree-member-p' instead.

If TREE is a list of trees, the return value will be created by
combining data from all trees containing STRING, by calling
COMBINE-FUNCTION on pairs of data. COMBINE-FUNCTION defaults to
the insersion function of the first tree in the list."

  ; wrap tree in a list if not already
  (when (tstree-p tree) (setq tree (list tree)))

  
  (let (data node)
    ;; loop over all trees
    (dotimes (i (length tree))
      
      ;; find first node corresponding to STRING
      (setq node (tstree--node-find (nth i tree) string))
      
      ;; keep following the low branch until we find the data node, or
      ;; can't go any further
      (while (tstree--node-p node)
        (setq node (if (tstree--node-split node) (tstree--node-low node)
                     (tstree--node-equal node))))
      ;; combine data
      (setq data (if combine-function
                     (funcall combine-function data node)
                   node)))

    ;; return combined data
    data)
)



(defun tstree-member-p (tree string)
  "Return t if STRING is in tree TREE, nil otherwise."
  
  (let ((node (tstree--node-find tree string)))
    
    (while (tstree--node-p node)
      (setq node (if (tstree--node-split node) (tstree--node-low node)
                   (setq node t))))
    node)
)



;; Deleting strings from a ternary search tree is a messy
;; operation. Basically, either the tree has to be left with redundant
;; nodes and probably nodes with nil equal children, or the sub-tree
;; below the string needs to be restructured.
;;
;; Possible solutions are either to leave the tree in a mess, or delete
;; the entire sub-tree then add the strings it contained back
;; again. Both are undesirable: the former because it leaves the tree
;; with redundant nodes that apart from making the tree slightly
;; inefficient, might even cause errors when running functions; the
;; latter because it could potentially be very inefficient.
;;
;; The best option is probably to make sure you never need to delete
;; strings from the tree! Therefore I haven't bothered writing the
;; following function:
;;
;; (defun tstree-delete (tree string)
;;   "Delete string STRING from tree TREE."
;; )



(defun tstree-map (function tree &optional type mapcar)
  "Apply FUNTION to all elements in the ternary search tree TREE,
for side-effects only.

FUNCTION will be passed two arguments: a key and its associated
data. It is safe to assume the tree will be traversed in
\"lexical\" order (i.e. the order defined by the tree's
comparison function).

If TREE is a list of trees, FUNCTION will be mapped over all trees in
the list, in order.

Optional argument TYPE should be one of the symbols 'string,
'list, or 'vector (default is 'vector). It defines which type of
sequence is passed to FUNCTION. If TYPE is 'string, it must be
possible to apply the function `string' to the type used to
reference data in the tree.

\(If optional argument MAPCAR is non-nil, a list of results of
function calls is returned. Don't use this. Use the
`tstree-mapcar' macro instead\)."

  ;; wrap tree in list if not already
  (when (tstree-p tree) (setq tree (list tree)))
  
  (let (stack str node result accumulate)
    ;; loop over all trees in list
    (dolist (tr tree)
      ;; only do something if tree is not empty
      (when (tstree--tree-root tr)
        ;; initialise the stack
        (push (tstree--tree-root tr) stack)
        (cond
         ((eq type 'string) (push "" stack))
         ((eq type 'list) (push () stack))
         (t (push [] stack)))
        
        ;; keep going until we've traversed all nodes (stack is empty)
        (while (not (null stack))
          (setq str (pop stack))
          (setq node (pop stack))
          ;; add the high child to the stack, if it exists
          (when (tstree--node-high node)
            (push (tstree--node-high node) stack)
            (push str stack))
          ;; add the low child to the stack, if it exists
          (when (tstree--node-low node)
            (push (tstree--node-low node) stack)
            (push str stack))
          ;; if we're at a data node call FUNCTION, otherwise add the
          ;; equal child to the stack
          (if (null (tstree--node-split node))
              (progn
                (setq result (funcall function str
                                      (tstree--node-equal node)))
                (when mapcar (setq accumulate (cons result accumulate))))
            (push (tstree--node-equal node) stack)
            (push (cond
                   ((eq type 'string)
                    (concat str (string (tstree--node-split node))))
                   ((eq type 'list)
                    (append str (list (tstree--node-split node))))
                   (t (vconcat str (vector (tstree--node-split node)))))
                  stack)))))
    
    ;; return accumulated list of results (nil if MAPCAR was nil)
    (nreverse accumulate))
)



(defmacro tstree-mapcar (function tree &optional type)
  "Apply FUNTION to all elements in the ternary search tree TREE,
and make a list of the results.

FUNCTION will be passed two arguments: a key and its associated
data. It is safe to assume the tree will be traversed in
\"lexical\" order (i.e. the order defined by the tree's
comparison function).

If TREE is a list of trees, FUNCTION will be mapped over all trees in
the list, in order.

Optional argument TYPE should be one of the symbols 'string,
'list, or 'vector (default is 'vector). It defines which type of
sequence is passed to FUNCTION. If TYPE is 'string, it must be
possible to apply the function `string' to the type used to
reference data in the tree."
  `(tstree-map ,function ,tree ,type t))



(defun tstree-complete
  (tree sequence &optional maxnum combine-function filter)
  "Return an alist containing all completions of SEQUENCE found in
ternary searh tree TREE along with their associated data, in
\"lexical\" order (i.e. the order defined by the tree's
comparison function). If no completions are found, return nil.

If TREE is a list of ternary search trees, it will behave as
though it were a single tree: completions will be sought in all
trees in the list, and if a completion exists in more than one
tree, the data from all the trees will be combined by calling
COMBINE-FUNCTION on pairs of data. COMBINE-FUNCTION defaults to
the first tree's insersion function.

SEQUENCE must be a sequence (vector, list or string) containing
elements of the type used to reference data in the tree, or a
list of such sequences. (If the sequence is a string, it must be
possible to apply the `string' function to the tree's reference
type.) The completions returned in the alist will be sequences of
the same type. If a list of sequences is supplied, completions of
all sequences in the list are included in the returned alist.

The optional integer argument MAXNUM limits the results to the
first MAXNUM completions. Otherwise, all completions are
returned.

The optional COMBINE-FUNCTION argument should take two arguments,
the data associated with the same key in two different trees, and
return the combined data.

The FILTER argument sets a filter function for the
completions. If supplied, it is called for each possible
completion with two arguments: the completion, and its associated
data. If the filter function returns nil, the completion is not
included in the results."
  
  (let (stack completions seq num node data sortfun)
    ;; wrap tree and sequence in lists, if not already lists
    (setq tree (if (tstree-p tree) (list tree) tree))
    (setq sortfun
          (tstree-construct-sortfun (tstree--tree-cmpfun (car tree))))
    ;; FIXME: this will fail if SEQUENCE is a list, and tree's reference
    ;;        type is itself a sequence (actually, there might be no way
    ;;        to fully fix this...)
    (if (or (atom sequence)
              (and (listp sequence) (not (sequencep (car sequence)))))
        (setq sequence (list sequence))
      ;; sort sequences in list
      (setq sequence (sort sequence sortfun)))
    
    
    ;; loop over all trees in the list
    (dotimes (i (length tree))
      (setq num 0)
      
      ;; ----- initialise the stack -----
      ;; add initial nodes for each sequence in the sequence list
      (dolist (seq sequence)
        ;; if completions exist, add initial node to the stack
        (if (car (push (tstree--node-find (nth i tree) seq) stack))
            (push seq stack)
          (pop stack)))
      
      ;; ----- search the tree -----
      ;; Keep going until we've searched all nodes (node stack is empty),
      ;; or have found enough completions.
      (while (and stack (or (null maxnum) (< num maxnum)))
        (setq seq (pop stack))
        (setq node (pop stack))
        
        ;; add the high child to the stack, if it exists
        (when (tstree--node-high node)
          (push (tstree--node-high node) stack)
          (push seq stack))
        
        ;; add the low child to the stack, if it exists
        (when (tstree--node-low node)
          (push (tstree--node-low node) stack)
          (push seq stack))
        
        ;; if we're not at a data node, add the equal child to the stack
        (if (tstree--node-split node)
            (progn
              (push (tstree--node-equal node) stack)
              (push (cond
                     ((stringp seq)
                      (concat seq (string (tstree--node-split node))))
                     ((listp seq)
                      (append seq (list (tstree--node-split node))))
                     (t (vconcat seq (vector (tstree--node-split node)))))
                    stack))
          
          ;; ----- if we're at a data node, we've found a completion -----
          ;; if no filter was supplied, or the completion passes the
          ;; filter...
          (when (or (null filter)
                    (funcall filter seq (tstree--node-equal node)))
            ;; skip completion if we've already found it in a previous tree
            (unless (catch 'found
                      (dotimes (j i)
                        (when (tstree-member-p (nth j tree) seq)
                          (throw 'found t))))
              ;; combine data with that from trees later in the list
              (setq data (tstree--node-equal node))
              (dotimes (j (- (length tree) i 1))
                (setq data
                      (if combine-function
                          (funcall combine-function data
                                   (tstree-member (nth (+ i j 1) tree) seq))
                        data)))
              ;; add the completion to the list
              (setq completions (cons (cons seq data) completions))
              (setq num (1+ num))))
          )))
    
    
    ;; ----- construct the list of completions -----
    ;; if searching across multiple trees, need to sort completions
    (when (> (length tree) 1)
      ;; construct sort function from tree's comparison function
      (let* ((cmpl-sortfun `(lambda (a b) (,sortfun (car a) (car b)))))
        ;; sort completions
        (setq completions (sort completions cmpl-sortfun))))
    
    ;; discard any excess completions
    (when (and maxnum (> (length completions) maxnum))
      (setcdr (nthcdr (1- maxnum) completions) nil))
    
    ;; return the completions
    (nreverse completions))
)




(defun tstree-complete-ordered
  (tree sequence &optional maxnum rank-function combine-function filter)
  "Return an alist containing all completions of STRING found in
ternary search tree TREE, along with their associated data. If no
completions are found, return nil.

Note that `tstree-complete' is significantly more efficient than
`tstree-complete-ordered', especially when a maximum number of
completions is specified. Always use `tstree-complete' when you
don't care about the ordering of the completions, or you need the
completions ordered \"alphabetically\".

If TREE is a list of ternary search trees, it will behave as
though it were a single tree: completions will be sought in all
trees in the list, and if a completion exists in more than one
tree, the data from all the trees will be combined by calling
COMBINE-FUNCTION on pairs of data. COMBINE-FUNCTION defaults to
the first tree's insersion function. The completions are ranked
according to the values of the combined data.

SEQUENCE must be a sequence (vector, list or string) containing
elements of the type used to reference data in the tree, or a
list of such sequences. (If the sequence is a string, it must be
possible to apply the `string' function to the tree's reference
type.) The completions returned in the alist will be sequences of
the same type. If a list of sequences is supplied, completions of
all sequences in the list are included in the returned alist.

The optional integer argument MAXNUM limits the results to the
\"best\" MAXNUM completions. If nil, all completions are
returned.

The optional argument RANK-FUNCTION over-rides the tree's default
rank function. It should take two arguments, each a cons whose
car is a key, and whose cdr is the data associated with it. It
should return non-nil if the first argument is \"better than\"
the second, nil otherwise. The elements of the returned alist are
sorted according to this rank-function, in descending order.

The optional COMBINE-FUNCTION argument should take two arguments,
the data associated with the same key in two different trees, and
return the combined data.

The FILTER argument sets a filter function for the
completions. If supplied, it is called for each possible
completion with two arguments: the completion (a sequence of the
same type as SEQUENCE), and its associated data. If the filter
function returns nil, the completion is not included in the
results."
  
  (let* (stack heap)
    ;; wrap tree and sequence in lists if necessary
    (when (tstree-p tree) (setq tree (list tree)))
    ;; FIXME: this will fail if SEQUENCE is a list, and tree's
    ;;        reference type is itself a sequence
    (when (or (atom sequence)
              (and (listp sequence) (not (sequencep (car sequence)))))
      (setq sequence (list sequence)))

    
    ;; ----- initialise the heap -----
    (let ((rankfun (or rank-function (tstree--tree-rankfun (car tree)))))
      ;; create the heap with a rank-function constructed from the first
      ;; tree in the list
      (setq heap (heap-create `(lambda (a b) (not (,rankfun a b))))))
    
    (let (num seq node data newdata)
      ;; loop over all trees in the list
      (dotimes (i (length tree))
        (setq num 0)
        
        ;; ----- initialise the stack -----
        (dolist (seq sequence)
          ;; if completions exist, add initial node and sequence to the
          ;; stack
          (if (car (push (tstree--node-find (nth i tree) seq) stack))
              (push seq stack)
            (pop stack)))
        
        
        ;; ------ search the current tree -----
        ;; keep going until we've searched all nodes (node stack is empty)
        (while stack
          (setq seq (pop stack))
          (setq node (pop stack))
          
          ;; add the high child to the stack, if it exists
          (when (tstree--node-high node)
            (push (tstree--node-high node) stack)
            (push seq stack))
          
          ;; add the low child to the stack, if it exists
          (when (tstree--node-low node)
            (push (tstree--node-low node) stack)
            (push seq stack))
          
          ;; if we're not at a data node, add the equal child to the stack
          (if (tstree--node-split node)
              (progn
                (push (tstree--node-equal node) stack)
                (push (cond
                       ((stringp seq)
                        (concat seq (string (tstree--node-split node))))
                       ((listp seq)
                        (append seq (list (tstree--node-split node))))
                       (t
                        (vconcat seq (vector (tstree--node-split node)))))
                      stack))

            
            ;; ---- if we're at a data node, we've found a completion ----
            ;; if no filter was supplied, or the completion passes the
            ;; filter...
            (when (or (null filter)
                      (funcall filter seq (tstree--node-equal node)))
              ;; skip completion if we've already found it in a previous
              ;; tree
              (unless (catch 'found
                        (dotimes (j i)
                          (when (tstree-member-p (nth j tree) seq)
                            (throw 'found t))))
                ;; combine data with that from trees later in the list
                (setq data (tstree--node-equal node))
                (dotimes (j (- (length tree) i 1))
                  (setq data
                        (if combine-function
                            (funcall combine-function data
                                     (tstree-member (nth (+ i j 1) tree)
                                                    seq))
                          data)))
                ;; add the completion to the heap
                (heap-add heap (cons seq data))
                (setq num (1+ num))
                ;; If we already have enough completions, delete the worst
                ;; one from the heap.
                (when (and maxnum (> num maxnum))
                  (heap-delete-root heap))))
            ))))
    
    
    ;; ----- create the completions vector -----
    ;; repeatedly transfer the worst completion left in the heap to the
    ;; front of the completions vector
    (let (completions cmpl)
      (while (not (heap-empty heap))
        (setq completions
              (setq cmpl (cons (heap-delete-root heap) completions))))
      ;; return the list of completions
      completions))
)


;;; tstree.el ends here




reply via email to

[Prev in Thread] Current Thread [Next in Thread]