about summary refs log tree commit diff
path: root/users/wpcarro/emacs/.emacs.d/wpc/tree.el
diff options
context:
space:
mode:
Diffstat (limited to 'users/wpcarro/emacs/.emacs.d/wpc/tree.el')
-rw-r--r--users/wpcarro/emacs/.emacs.d/wpc/tree.el200
1 files changed, 200 insertions, 0 deletions
diff --git a/users/wpcarro/emacs/.emacs.d/wpc/tree.el b/users/wpcarro/emacs/.emacs.d/wpc/tree.el
new file mode 100644
index 000000000000..ae5fba7950c9
--- /dev/null
+++ b/users/wpcarro/emacs/.emacs.d/wpc/tree.el
@@ -0,0 +1,200 @@
+;;; tree.el --- Working with Trees -*- lexical-binding: t -*-
+
+;; Author: William Carroll <wpcarro@gmail.com>
+;; Version: 0.0.1
+;; URL: https://git.wpcarro.dev/wpcarro/briefcase
+;; Package-Requires: ((emacs "25.1"))
+
+;;; Commentary:
+;; Some friendly functions that hopefully will make working with trees cheaper
+;; and therefore more appealing!
+;;
+;; Tree terminology:
+;; - leaf: node with zero children.
+;; - root: node with zero parents.
+;; - depth: measures a node's distance from the root node.  This implies the
+;;   root node has a depth of zero.
+;; - height: measures the longest traversal from a node to a leaf.  This implies
+;;   that a leaf node has a height of zero.
+;; - balanced?
+;;
+;; Tree variants:
+;; - binary: the maximum number of children is two.
+;; - binary search: the maximum number of children is two and left sub-trees are
+;;   lower in value than right sub-trees.
+;; - rose: the number of children is variable.
+
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Dependencies
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'prelude)
+(require 'list)
+(require 'set)
+(require 'tuple)
+(require 'series)
+(require 'random)
+(require 'maybe)
+(require 'cl-lib)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Library
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(cl-defstruct tree xs)
+
+(cl-defstruct node value children)
+
+(cl-defun tree-node (value &optional children)
+  "Create a node struct of VALUE with CHILDREN."
+  (make-node :value value
+             :children children))
+
+(defun tree-reduce-breadth (acc f xs)
+  "Reduce over XS breadth-first applying F to each x and ACC (in that order).
+Breadth-first traversals guarantee to find the shortest path in a graph.
+  They're typically more difficult to implement than DFTs and may also incur
+  higher memory costs on average than their depth-first counterparts.")
+
+;; TODO: Support :order as 'pre | 'in | 'post.
+;; TODO: Troubleshoot why I need defensive (nil? node) check.
+(defun tree-reduce-depth (acc f node)
+  "Reduce over NODE depth-first applying F to each NODE and ACC.
+F is called with each NODE, ACC, and the current depth.
+Depth-first traversals have the advantage of typically consuming less memory
+  than their breadth-first equivalents would have.  They're also typically
+  easier to implement using recursion.  This comes at the cost of not
+  guaranteeing to be able to find the shortest path in a graph."
+  (cl-labels ((do-reduce-depth
+               (acc f node depth)
+               (let ((acc-new (funcall f node acc depth)))
+                 (if (or (maybe-nil? node)
+                         (tree-leaf? node))
+                     acc-new
+                   (list-reduce
+                    acc-new
+                    (lambda (node acc)
+                      (tree-do-reduce-depth
+                       acc
+                       f
+                       node
+                       (number-inc depth)))
+                    (node-children node))))))
+    (do-reduce-depth acc f node 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun tree-height (xs)
+  "Return the height of tree XS.")
+
+;; TODO: Troubleshoot why need for (nil? node).  Similar misgiving
+;; above.
+(defun tree-leaf-depths (xs)
+  "Return a list of all of the depths of the leaf nodes in XS."
+  (list-reverse
+   (tree-reduce-depth
+    '()
+    (lambda (node acc depth)
+      (if (or (maybe-nil? node)
+              (tree-leaf? node))
+          (list-cons depth acc)
+        acc))
+    xs)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Generators
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; TODO: Consider parameterizing height, forced min-max branching, random
+;; distributions, etc.
+
+;; TODO: Bail out before stack overflowing by consider branching, current-depth.
+
+(cl-defun tree-random (&optional (value-fn (lambda (_) nil))
+                                 (branching-factor 2))
+  "Randomly generate a tree with BRANCHING-FACTOR.
+
+This uses VALUE-FN to compute the node values.  VALUE-FN is called with the
+current-depth of the node.  Useful for generating test data.  Warning this
+function can overflow the stack."
+  (cl-labels ((do-random
+               (d vf bf)
+               (make-node
+                :value (funcall vf d)
+                :children (->> (series/range 0 (number-dec bf))
+                               (list-map
+                                (lambda (_)
+                                  (when (random-boolean?)
+                                    (do-random d vf bf))))))))
+    (do-random 0 value-fn branching-factor)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Predicates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun tree-instance? (tree)
+  "Return t if TREE is a tree struct."
+  (node-p tree))
+
+(defun tree-leaf? (node)
+  "Return t if NODE has no children."
+  (maybe-nil? (node-children node)))
+
+(defun tree-balanced? (n xs)
+  "Return t if the tree, XS, is balanced.
+A tree is balanced if none of the differences between any two depths of two leaf
+  nodes in XS is greater than N."
+  (> n (->> xs
+            tree-leaf-depths
+            set-from-list
+            set-count
+            number-dec)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst tree-enable-testing? t
+  "When t, test suite runs.")
+
+;; TODO: Create set of macros for a proper test suite including:
+;; - describe (arbitrarily nestable)
+;; - it (arbitrarily nestable)
+;; - line numbers for errors
+;; - accumulated output for synopsis
+;; - do we want describe *and* it? Why not a generic label that works for both?
+(when tree-enable-testing?
+  (let ((tree-a (tree-node 1
+                           (list (tree-node 2
+                                            (list (tree-node 5)
+                                                  (tree-node 6)))
+                                 (tree-node 3
+                                            (list (tree-node 7)
+                                                  (tree-node 8)))
+                                 (tree-node 4
+                                            (list (tree-node 9)
+                                                  (tree-node 10))))))
+        (tree-b (tree-node 1
+                           (list (tree-node 2
+                                            (list (tree-node 5)
+                                                  (tree-node 6)))
+                                 (tree-node 3)
+                                 (tree-node 4
+                                            (list (tree-node 9)
+                                                  (tree-node 10)))))))
+    ;; instance?
+    (prelude-assert (tree-instance? tree-a))
+    (prelude-assert (tree-instance? tree-b))
+    (prelude-refute (tree-instance? '(1 2 3)))
+    (prelude-refute (tree-instance? "oak"))
+    ;; balanced?
+    (prelude-assert (tree-balanced? 1 tree-a))
+    (prelude-refute (tree-balanced? 1 tree-b))
+    (message "Tests pass!")))
+
+(provide 'tree)
+;;; tree.el ends here