add doubly linked lists, tests, minischeme

1 files changed, 332 insertions, 0 deletions

diff --git a/doubly-linked-list.scm b/doubly-linked-list.scm
new file mode 100644
index 0000000..fa6bd20
--- /dev/null
+++ b/doubly-linked-list.scm
@@ -0,0 +1,332 @@
+;;; Copyright (C) Peter McGoron 2024
+;;; 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, version 3 of the License.
+;;; 
+;;; 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, see <https://www.gnu.org/licenses/>.
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Code to handle the linked list container.
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
+;;; The container is constructed with DL:CTR and has two fields,
+;;; head and tail which point to the start and end of the list.
+
+;;; (DL:CTR) constructs an empty doubly linked list container.
+(define dl:ctr
+  (lambda () (cons '() '())))
+
+(define dl:head car)
+(define dl:set-head! set-car!)
+(define dl:tail cdr)
+(define dl:set-tail! set-cdr!)
+
+;;; (DL:EMPTY? CTR) tests if CTR is a list of zero elements.
+(define dl:empty?
+  (lambda (ctr)
+    (null? (dl:head ctr))))
+
+;;; (DL:ADD-FIRST-ELEMENT CTR ELEM) initializes CTR to be a list of one
+;;; element ELEM.
+(define dl:add-first-element
+  (lambda (ctr elem)
+    (dl:set-head! ctr elem)
+    (dl:set-tail! ctr elem)))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Code to handle list elements
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; List elements are constructed with (DL:ELEM VAL), where VAL is the
+;;; value to be stored in the list.
+
+;;; (DL:ELEM VAL) constructs a new doubly linked list element with element
+;;; VAL.
+(define dl:elem
+  (lambda (val)
+    (vector '() val '())))
+
+(define dl:prev
+  (lambda (elem) (vector-ref elem 0)))
+(define dl:set-prev!
+  (lambda (elem prev) (vector-set! elem 0 prev)))
+
+(define dl:val
+  (lambda (elem) (vector-ref elem 1)))
+
+(define dl:val-equal?
+  (lambda (elem x) (equal? (dl:val elem) x)))
+
+(define dl:next
+  (lambda (elem) (vector-ref elem 2)))
+(define dl:set-next!
+  (lambda (elem next) (vector-set! elem 2 next)))
+
+(define dl:is-head?
+  (lambda (ctr elem)
+    (eqv? (dl:head ctr) elem)))
+
+(define dl:is-tail?
+  (lambda (ctr elem)
+    (eqv? (dl:tail ctr) elem)))
+
+(define dl:link
+  (lambda (before after)
+    (dl:set-next! before after)
+    (dl:set-prev! after before)))
+
+(define dl:unlink
+  (lambda (elem)
+    (let ((prev (dl:prev elem))
+          (next (dl:next elem)))
+      (if (not (null? prev))
+          (dl:set-next! prev next)
+          '())
+      (if (not (null? next))
+          (dl:set-prev! next prev)
+          '())
+      (dl:set-prev! elem '())
+      (dl:set-next! elem '()))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+;;; Linked List operations
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+
+;;; (DL:PUSH CTR ELEM) pushes ELEM to the head of the list in CTR.
+;;; The element after ELEM is the previous head.
+(define dl:push
+  (lambda (ctr elem)
+    (if (dl:empty? ctr)
+        (dl:add-first-element ctr elem)
+        (begin
+          (dl:set-prev! elem '())
+          (dl:link elem (dl:head ctr))
+          (dl:set-head! ctr elem)))))
+
+;;; (DL:PUSH-TAIL CTR ELEM) pushes ELEM to the tail of the list in CTR.
+;;; The element before ELEM is the previous tail.
+(define dl:push-tail
+  (lambda (ctr elem)
+    (if (dl:empty? ctr)
+        (dl:add-first-element ctr elem)
+        (begin
+          (dl:set-next! elem '())
+          (dl:link (dl:tail ctr) elem)
+          (dl:set-tail! ctr elem)))))
+
+;;; (DL:FIND CTR OK?) searches CTR for the first element whose value
+;;; VAL satisfies (OK? VAL). If there is no element, the function
+;;; returns #F.
+(define dl:find
+  (lambda (ctr ok?)
+    (letrec
+        ((loop
+          (lambda (element)
+            (cond
+              ((null? element) #f)
+              ((ok? (dl:val element)) element)
+              (else (loop (dl:next element)))))))
+      (loop (dl:head ctr)))))
+
+;;; (DL:FIND-EQUAL CTR VAL) searches CTR for the first element such that
+;;; (EQUAL? CTR (DL:VAL ELEM)). See documentation for DL:FIND
+(define dl:find-equal
+  (lambda (ctr val) (dl:find ctr (lambda (x)
+                                   (equal? val x)))))
+
+;;; (DL:INSERT-BEFORE CTR ELEM TO-BE-INSERTED)
+;;; places TO-BE-INSERTED in the list before ELEM. ELEM must be a part of
+;;; the list.
+(define dl:insert-before
+  (lambda (ctr elem to-be-inserted)
+    (if (dl:is-head? ctr elem)
+        (dl:push ctr to-be-inserted)
+        (let ((prev (dl:prev elem)))
+          (dl:link prev to-be-inserted)
+          (dl:link to-be-inserted elem)))))
+
+;;; (DL:INSERT-AFTER CTR ELEM TO-BE-INSERTED)
+;;; places TO-BE-INSERTED in the list after ELEM. ELEM must be a part of
+;;; the list.
+(define dl:insert-after
+  (lambda (ctr elem to-be-inserted)
+    (if (dl:is-tail? ctr elem)
+        (dl:push-tail ctr to-be-inserted)
+        (let ((next (dl:next elem)))
+          (dl:link to-be-inserted next)
+          (dl:link elem to-be-inserted)))))
+
+;;; (DL:REMOVE CTR ELEM) removes ELEM from the list by linking the
+;;; previous and next elements of the list together (if they exist).
+(define dl:remove
+  (lambda (ctr elem)
+    (let ((was-head? (dl:is-head? ctr elem))
+          (was-tail? (dl:is-tail? ctr elem))
+          (prev (dl:prev elem))
+          (next (dl:next elem)))
+      (dl:unlink elem)
+      (if was-head?
+          (dl:set-head! ctr next)
+          #f)
+      (if was-tail?
+          (dl:set-tail! ctr tail)
+          #f))))
+
+;;; (DL:PUSH-LIST-BACK CTR LST) appends LST to CTR.
+(define dl:push-list-back
+  (lambda (ctr lst)
+    (if (null? lst)
+        ctr
+        (begin
+          (dl:push-tail ctr (dl:elem (car lst)))
+          (dl:push-list-back ctr (cdr lst))))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Tests
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define %dl:equal-to-list?
+  (lambda (ctr lst)
+    (letrec
+        ((xor?
+          (lambda (x y)
+            (if x (not y) y)))
+         (loop
+          (lambda (dl-elem lst-elem)
+            (if (not (dl:val-equal? dl-elem (car lst-elem)))
+                #f
+                (let ((dl-next (dl:next dl-elem))
+                      (lst-next (cdr lst-elem)))
+                  (if (xor? (null? dl-next) (null? lst-next))
+                      #f
+                      (if (null? dl-next)
+                          #t
+                          (loop dl-next lst-next))))))))
+      (loop (dl:head ctr) lst))))
+
+(define %dl:find-remove
+  (lambda (ctr val)
+    (let ((elem (dl:find-equal ctr val)))
+      (if elem
+          (begin
+            (dl:remove ctr elem)
+            #t)
+          #f))))
+
+(define %dl:find-remove-from-list
+  (lambda (ctr lst)
+    (if (null? lst)
+        #t
+        (if (not (%dl:find-remove ctr (car lst)))
+            #f
+            (%dl:find-remove-from-list ctr (cdr lst))))))
+
+(define %dl:test-insert-into-list
+  (lambda (original-list searched-value value-to-insert
+                         insert-direction modified-list)
+    (let ((ctr (dl:ctr)))
+      (dl:push-list-back ctr original-list)
+      (let ((searched-elem (dl:find-equal ctr searched-value)))
+        (if (not searched-elem)
+            #f
+            (begin
+              (insert-direction ctr
+                                searched-elem
+                                (dl:elem value-to-insert))
+              (%dl:equal-to-list? ctr modified-list)))))))
+
+(define %dl:tests
+  (list
+   (cons "insert one in front"
+         (lambda ()
+           (let ((ctr (dl:ctr)))
+             (dl:push ctr (dl:elem 5))
+             (%dl:equal-to-list? ctr '(5)))))
+   (cons "insert one in back"
+         (lambda ()
+           (let ((ctr (dl:ctr)))
+             (dl:push-tail ctr (dl:elem 5))
+             (%dl:equal-to-list? ctr '(5)))))
+   (cons "insert many"
+         (lambda ()
+           (let ((ctr (dl:ctr))
+                 (to-insert '(1 2 3 4 5)))
+             (dl:push-list-back ctr to-insert)
+             (%dl:equal-to-list? ctr '(1 2 3 4 5)))))
+   (cons "insert then delete"
+         (lambda ()
+           (let ((ctr (dl:ctr))
+                 (el (dl:elem 5)))
+             (dl:push ctr el)
+             (dl:remove ctr el)
+             (dl:empty? ctr))))
+   (cons "insert many then delete all"
+         (lambda ()
+           (let ((ctr (dl:ctr))
+                 (vals '(1 2 3 4 5)))
+             (dl:push-list-back ctr vals)
+             (if (not (%dl:find-remove-from-list ctr vals))
+                 #f
+                 (dl:empty? ctr)))))
+   (cons "insert many then delete some"
+         (lambda ()
+           (let ((ctr (dl:ctr)))
+             (dl:push-list-back ctr '(1 2 3 4 5 6 7 8 9 10))
+             (if (not (%dl:find-remove-from-list ctr '(1 2 5 7 10)))
+                 #f
+                 (%dl:equal-to-list? ctr '(3 4 6 8 9))))))
+   (cons "push head many"
+         (lambda ()
+           (let ((ctr (dl:ctr)))
+             (dl:push ctr (dl:elem 1))
+             (dl:push ctr (dl:elem 2))
+             (dl:push ctr (dl:elem 3))
+             (%dl:equal-to-list? ctr '(3 2 1)))))
+   (cons "insert before in the middle"
+         (lambda ()
+           (%dl:test-insert-into-list '(1 2 3 4 5)
+                                      3
+                                      10
+                                      dl:insert-before
+                                      '(1 2 10 3 4 5))))
+   (cons "insert before at head"
+         (lambda ()
+           (%dl:test-insert-into-list '(1 2 3 4 5)
+                                      1
+                                      10
+                                      dl:insert-before
+                                      '(10 1 2 3 4 5))))
+   (cons "insert before at tail"
+         (lambda ()
+           (%dl:test-insert-into-list '(1 2 3 4 5)
+                                      5
+                                      10
+                                      dl:insert-before
+                                      '(1 2 3 4 10 5))))
+   (cons "insert after in middle"
+         (lambda ()
+           (%dl:test-insert-into-list '(1 2 3 4 5)
+                                      3
+                                      10
+                                      dl:insert-after
+                                      '(1 2 3 10 4 5))))
+   (cons "insert after at head"
+         (lambda ()
+           (%dl:test-insert-into-list '(1 2 3 4 5)
+                                      1
+                                      10
+                                      dl:insert-after
+                                      '(1 10 2 3 4 5))))
+   (cons "insert after at tail"
+         (lambda ()
+           (%dl:test-insert-into-list '(1 2 3 4 5)
+                                      5
+                                      10
+                                      dl:insert-after
+                                      '(1 2 3 4 5 10))))))
+