mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Lint tree.el

Browse source 
- add Version, URL, Package-Requires sections
- prefer `tree-` prefer to `tree/`
This commit is contained in:
William Carroll 2020-08-31 14:44:53 +01:00
parent 1aa4b3a547
commit 2844c1ffbd
1 changed files with 44 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

84
emacs/.emacs.d/wpc/tree.el
View file

@ -1,5 +1,9 @@
;;; tree.el --- Working with Trees -*- lexical-binding: t -*- ;;; tree.el --- Working with Trees -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com> ;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "25.1"))
;;; Commentary: ;;; Commentary:
;; Some friendly functions that hopefully will make working with trees cheaper ;; Some friendly functions that hopefully will make working with trees cheaper
@ -42,12 +46,12 @@
(cl-defstruct node value children) (cl-defstruct node value children)
(cl-defun tree/node (value &optional children) (cl-defun tree-node (value &optional children)
"Create a node struct of VALUE with CHILDREN." "Create a node struct of VALUE with CHILDREN."
(make-node :value value (make-node :value value
:children children)) :children children))
(defun tree/reduce-breadth (acc f xs) (defun tree-reduce-breadth (acc f xs)
"Reduce over XS breadth-first applying F to each x and ACC (in that order). "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. 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 They're typically more difficult to implement than DFTs and may also incur
@ -55,7 +59,7 @@ Breadth-first traversals guarantee to find the shortest path in a graph.
;; TODO: Support :order as 'pre | 'in | 'post. ;; TODO: Support :order as 'pre | 'in | 'post.
;; TODO: Troubleshoot why I need defensive (nil? node) check. ;; TODO: Troubleshoot why I need defensive (nil? node) check.
(defun tree/reduce-depth (acc f node) (defun tree-reduce-depth (acc f node)
"Reduce over NODE depth-first applying F to each NODE and ACC. "Reduce over NODE depth-first applying F to each NODE and ACC.
F is called with each NODE, ACC, and the current depth. F is called with each NODE, ACC, and the current depth.
Depth-first traversals have the advantage of typically consuming less memory Depth-first traversals have the advantage of typically consuming less memory
@ -66,12 +70,12 @@ Depth-first traversals have the advantage of typically consuming less memory
(acc f node depth) (acc f node depth)
(let ((acc-new (funcall f node acc depth))) (let ((acc-new (funcall f node acc depth)))
(if (or (maybe/nil? node) (if (or (maybe/nil? node)
(tree/leaf? node)) (tree-leaf? node))
acc-new acc-new
(list/reduce (list/reduce
acc-new acc-new
(lambda (node acc) (lambda (node acc)
(tree/do-reduce-depth (tree-do-reduce-depth
acc acc
f f
node node
@ -83,19 +87,19 @@ Depth-first traversals have the advantage of typically consuming less memory
;; Helpers ;; Helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tree/height (xs) (defun tree-height (xs)
"Return the height of tree XS.") "Return the height of tree XS.")
;; TODO: Troubleshoot why need for (nil? node). Similar misgiving ;; TODO: Troubleshoot why need for (nil? node). Similar misgiving
;; above. ;; above.
(defun tree/leaf-depths (xs) (defun tree-leaf-depths (xs)
"Return a list of all of the depths of the leaf nodes in XS." "Return a list of all of the depths of the leaf nodes in XS."
(list/reverse (list/reverse
(tree/reduce-depth (tree-reduce-depth
'() '()
(lambda (node acc depth) (lambda (node acc depth)
(if (or (maybe/nil? node) (if (or (maybe/nil? node)
(tree/leaf? node)) (tree-leaf? node))
(list/cons depth acc) (list/cons depth acc)
acc)) acc))
xs))) xs)))
@ -109,7 +113,7 @@ Depth-first traversals have the advantage of typically consuming less memory
;; TODO: Bail out before stack overflowing by consider branching, current-depth. ;; TODO: Bail out before stack overflowing by consider branching, current-depth.
(cl-defun tree/random (&optional (value-fn (lambda (_) nil)) (cl-defun tree-random (&optional (value-fn (lambda (_) nil))
(branching-factor 2)) (branching-factor 2))
"Randomly generate a tree with BRANCHING-FACTOR using VALUE-FN to compute the "Randomly generate a tree with BRANCHING-FACTOR using VALUE-FN to compute the
node values. VALUE-FN is called with the current-depth of the node. Useful for node values. VALUE-FN is called with the current-depth of the node. Useful for
@ -129,20 +133,20 @@ generating test data. Warning this function can overflow the stack."
;; Predicates ;; Predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tree/instance? (tree) (defun tree-instance? (tree)
"Return t if TREE is a tree struct." "Return t if TREE is a tree struct."
(node-p tree)) (node-p tree))
(defun tree/leaf? (node) (defun tree-leaf? (node)
"Return t if NODE has no children." "Return t if NODE has no children."
(maybe/nil? (node-children node))) (maybe/nil? (node-children node)))
(defun tree/balanced? (n xs) (defun tree-balanced? (n xs)
"Return t if the tree, XS, is balanced. "Return t if the tree, XS, is balanced.
A tree is balanced if none of the differences between any two depths of two leaf A tree is balanced if none of the differences between any two depths of two leaf
nodes in XS is greater than N." nodes in XS is greater than N."
(> n (->> xs (> n (->> xs
tree/leaf-depths tree-leaf-depths
set/from-list set/from-list
set/count set/count
number/dec))) number/dec)))
@ -151,7 +155,7 @@ A tree is balanced if none of the differences between any two depths of two leaf
;; Tests ;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst tree/enable-testing? t (defconst tree-enable-testing? t
"When t, test suite runs.") "When t, test suite runs.")
;; TODO: Create set of macros for a proper test suite including: ;; TODO: Create set of macros for a proper test suite including:
@ -160,33 +164,33 @@ A tree is balanced if none of the differences between any two depths of two leaf
;; - line numbers for errors ;; - line numbers for errors
;; - accumulated output for synopsis ;; - accumulated output for synopsis
;; - do we want describe *and* it? Why not a generic label that works for both? ;; - do we want describe *and* it? Why not a generic label that works for both?
(when tree/enable-testing? (when tree-enable-testing?
(let ((tree-a (tree/node 1 (let ((tree-a (tree-node 1
(list (tree/node 2 (list (tree-node 2
(list (tree/node 5) (list (tree-node 5)
(tree/node 6))) (tree-node 6)))
(tree/node 3 (tree-node 3
(list (tree/node 7) (list (tree-node 7)
(tree/node 8))) (tree-node 8)))
(tree/node 4 (tree-node 4
(list (tree/node 9) (list (tree-node 9)
(tree/node 10)))))) (tree-node 10))))))
(tree-b (tree/node 1 (tree-b (tree-node 1
(list (tree/node 2 (list (tree-node 2
(list (tree/node 5) (list (tree-node 5)
(tree/node 6))) (tree-node 6)))
(tree/node 3) (tree-node 3)
(tree/node 4 (tree-node 4
(list (tree/node 9) (list (tree-node 9)
(tree/node 10))))))) (tree-node 10)))))))
;; instance? ;; instance?
(prelude/assert (tree/instance? tree-a)) (prelude/assert (tree-instance? tree-a))
(prelude/assert (tree/instance? tree-b)) (prelude/assert (tree-instance? tree-b))
(prelude/refute (tree/instance? '(1 2 3))) (prelude/refute (tree-instance? '(1 2 3)))
(prelude/refute (tree/instance? "oak")) (prelude/refute (tree-instance? "oak"))
;; balanced? ;; balanced?
(prelude/assert (tree/balanced? 1 tree-a)) (prelude/assert (tree-balanced? 1 tree-a))
(prelude/refute (tree/balanced? 1 tree-b)) (prelude/refute (tree-balanced? 1 tree-b))
(message "Tests pass!"))) (message "Tests pass!")))
(provide 'tree) (provide 'tree)