Binary Search Tree: Perl and Common Lisp implementation

June 30, 2016
Algorithm

Perl

#!perl

use strict;
use warnings;
use utf8;
use 5.014;

# insert given value into the proper position. If no tree provided,
# use implicit pass by reference aspect of @_ to fill one.
sub insert {
    my($tree, $value) = @_;
    unless ($tree) {
        $tree = {};
        $tree->{VALUE} = $value;
        $tree->{LEFT} = undef;
        $tree->{RIGHT} = undef;
        $_[0] = $tree; # $_[0] is reference param
        return;
    }
    if ($tree->{VALUE} > $value) { insert($tree->{LEFT}, $value) }
    elsif ($tree->{VALUE} < $value) { insert($tree->{RIGHT}, $value) }
    else { warn "duplicate insert of $value\n" }
}

sub in_order {
    my($tree) = @_;
    return unless $tree;
    in_order($tree->{LEFT});
    print $tree->{VALUE}, " ";
    in_order($tree->{RIGHT});
}

sub pre_order {
    my($tree) = @_;
    return unless $tree;
    print $tree->{VALUE}, " ";
    pre_order($tree->{LEFT});
    pre_order($tree->{RIGHT});
}

sub post_order {
    my($tree) = @_;
    return unless $tree;
    post_order($tree->{LEFT});
    post_order($tree->{RIGHT});
    print $tree->{VALUE}, " ";
}

sub search {
    my($tree, $value) = @_;
    return unless $tree;
    return $tree if ($tree->{VALUE} == $value);
    search ($tree->{ ($value < $tree->{VALUE}) ? "LEFT" : "RIGHT" }, $value)
}

my($root, $n);
insert($root, int(rand(100))) while ($n++ < 5);
print "Pre order:  "; pre_order($root); print "\n";
print "In order:   "; in_order($root); print "\n";
print "Post order: "; post_order($root); print "\n";

# prompt until EOF
for (print "Search? "; <>; print "Search? ") {
    chomp;
    my $found = search($root, $_);
    if ($found) { print "Found $_ at $found, $found->{VALUE}\n" }
    else { print "No $_ in the tree.\n" }
}

Common Lisp

(defclass tree-node ()
  ((value :initform nil
          :initarg :value
          :accessor value)
   (left :initform nil
         :accessor left-child)
   (right :initform nil
          :accessor right-child)))

(defun create-node (value)
  (let ((node (make-instance 'tree-node :value value)))
    node))

(defun insert-node (tree-node
                    value)
  (cond ((> (value tree-node) value)
         (if (null (left-child tree-node))
             (setf (left-child tree-node)
                   (create-node value))
             (insert-node (left-child tree-node) value)))
        ((< (value tree-node) value)
         (if (null (right-child tree-node))
             (setf (right-child tree-node)
                   (create-node value))
             (insert-node (right-child tree-node) value)))
        (t (format t "duplicate insert of ~d~%" value))))

(defun in-order (tree-node)
  (if (null tree-node) (return-from in-order))
  (in-order (left-child tree-node))
  (format t "~d " (value tree-node))
  (in-order (right-child tree-node)))

(defun pre-order (tree-node)
  (if (null tree-node) (return-from pre-order))
  (format t "~d " (value tree-node))
  (pre-order (left-child tree-node))
  (pre-order (right-child tree-node)))

(defun post-order (tree-node)
  (if (null tree-node) (return-from post-order))
  (post-order (left-child tree-node))
  (post-order (right-child tree-node))
  (format t "~d " (value tree-node)))

(defun search-value (tree-node
                     value)
  (if (null tree-node) (return-from search-value nil))
  (if (equal value (value tree-node))
      (return-from search-value tree-node))
  (search-value (if (< value (value tree-node))
                    (left-child tree-node)
                    (right-child tree-node))
                value))

(defparameter root (create-node 1))

(dotimes (i 5)
  (insert-node root (random 100)))

(format t "~%~%Pre-order: ")
(pre-order root)
(format t "~%")
(format t "~&In--order: ")
(in-order root)
(format t "~%")
(format t "~&Pos-order: ")
(post-order root)
(format t "~%")

;; use C-c C-d h to read the documentation.
;; use C-u RET to input EOF in the SLIME REPL

(format t "Search? ")
(loop for in = (read nil nil)
      while in
      do
         (let ((found (search-value root in)))
           (if found
               (format t "Found ~d at ~a~%"
                       (value found)
                       found)
               (format t "No ~d in the tree.~%" in))
           (format t "Search? ")))

comments powered by Disqus