peter
/
UNSLISP
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

change around insert, delete, and update to hide representation

This commit is contained in:
Peter McGoron 2024-09-05 21:18:04 -04:00
parent 1e93de26d5
commit f0cad72190
1 changed files with 37 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
set.scm
View File

@ -286,21 +286,22 @@
(loop tree))))) (loop tree)))))
;;; (SET:UPDATE <=>) generates an update function for <=>. ;;; (SET:UPDATE <=>) generates an update function for <=>.
;;; (UPDATE TREE NODE UPDATE) inserts (UPDATE NODE #F) into the tree if ;;; (UPDATE TREE DATA UPDATE) inserts a node with data (UPDATE DATA #F)
;;; no node comparing equal to NODE is found, and (UPDATE NODE OLD) if ;;; into the tree if no node comparing equal to DATA is found, and a node
;;; OLD compares equal to NODE. ;;; with data (UPDATE DATA OLD) if OLD compares equal to NODE.
(define set:update (define set:update
(lambda (<=>) (lambda (<=>)
(lambda (tree node update) (lambda (tree data update)
(letrec (letrec
((loop ((loop
(lambda (tree) (lambda (tree)
(if (null? tree) (if (null? tree)
(update node #f) (%set:node (update data '()) '< '() '> '())
(let ((dir (<=> (set:get node '=) (let ((dir (<=> data (set:get tree '=))))
(set:get tree '=))))
(if (eq? dir '=) (if (eq? dir '=)
(update node tree) (%set:node (update data tree)
'< (set:get tree '<)
'> (set:get tree '>))
(let ((invdir (%set:invdir dir))) (let ((invdir (%set:invdir dir)))
(set:join (set:get tree '=) (set:join (set:get tree '=)
dir (loop (set:get tree dir)) dir (loop (set:get tree dir))
@ -309,40 +310,35 @@
;;; (SET:INSERT <=>) generates an insert function for comparison function ;;; (SET:INSERT <=>) generates an insert function for comparison function
;;; <=>. ;;; <=>.
;;; (INSERT TREE NODE) inserts NODE into TREE. It returns ;;; (INSERT TREE DATA) inserts a node with DATA into TREE. It returns
;;; (CONS NEWTREE FOUND), where FOUND is the node that was replaced by ;;; (CONS NEWTREE FOUND), where FOUND is the node that was replaced by
;;; NODE, and #F otherwise, and NEWTREE is the new root of the tree. ;;; the node, and '() otherwise, and NEWTREE is the new root of the tree.
(define set:insert (define set:insert
(lambda (update) (lambda (update)
(lambda (tree node) (lambda (tree node)
(let ((found #f)) (let ((found '()))
(let ((newroot (update tree node (let ((newroot (update tree node
(lambda (node oldnode) (lambda (data oldnode)
(if (not oldnode)
node
(begin
(set! found oldnode) (set! found oldnode)
(set:node-new-val oldnode data))))
(set:get node '=))))))))
(cons newroot found)))))) (cons newroot found))))))
;;; (SET:DELETE <=>) generates a delete function for comparison function ;;; (SET:DELETE <=>) generates a delete function for comparison function
;;; <=>. ;;; <=>.
;;; (DELETE TREE DATA) deletes a node from TREE that compares equal to ;;; (DELETE TREE DATA) deletes a node from TREE that compares equal to
;;; DATA. The function returns (CONS NEWTREE FOUND), where FOUND is the ;;; DATA. The function returns (CONS NEWTREE FOUND), where FOUND is the
;;; deleted node, or NULL if not found, and NEWTREE is the root of the new ;;; deleted node, or '() if not found, and NEWTREE is the root of the new
;;; tree. ;;; tree.
(define set:delete (define set:delete
(lambda (<=>) (lambda (<=>)
(lambda (tree node) (lambda (tree data)
(let ((found '())) (let ((found '()))
(letrec (letrec
((loop ((loop
(lambda (tree) (lambda (tree)
(if (null? tree) (if (null? tree)
node '()
(let ((dir (<=> (set:get node '=) (let ((dir (<=> data (set:get tree '=))))
(set:get tree '=))))
(if (eq? dir '=) (if (eq? dir '=)
(begin (begin
(set! found tree) (set! found tree)
@ -357,6 +353,8 @@
;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;
;;; Converting sets to maps ;;; Converting sets to maps
;;;
;;; The conversion stores (CONS KEY VAL) into each pair.
;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;
;;; Convert a <=> for sets to one for maps. ;;; Convert a <=> for sets to one for maps.
@ -365,16 +363,6 @@
(lambda (x y) (lambda (x y)
(<=> (car x) (car y))))) (<=> (car x) (car y)))))
(define map:node-new-val
(lambda (node newkey newval)
(set:node-new-val node
(cons newkey newval))))
(define map:empty-node
(lambda (key val)
(%set:node (cons key val)
'< '() '> '())))
(define map:key (define map:key
(lambda (node) (lambda (node)
(car (set:get node '=)))) (car (set:get node '=))))
@ -383,17 +371,22 @@
(lambda (node) (lambda (node)
(cdr (set:get node '=)))) (cdr (set:get node '=))))
;;; (UPDATE TREE KEY UPDATE*) runs inserts a node with value
;;; (UPDATE KEY '()) if no node is found comparing equal to KEY, and
;;; (UPDATE KEY NODE) if NODE compared equal to KEY.
(define map:update (define map:update
(lambda (%update-recursive) (lambda (%update-recursive)
(lambda (tree key update) (lambda (tree key update)
(%update-recursive tree (map:empty-node key '()) (%update-recursive tree (cons key '())
update)))) (lambda (_ oldnode)
(cons key
(update key oldnode)))))))
(define map:insert (define map:insert
(lambda (%update-recursive) (lambda (%update-recursive)
(let ((insert (set:insert %update-recursive))) (let ((insert (set:insert %update-recursive)))
(lambda (tree key val) (lambda (tree key val)
(insert tree (map:empty-node key val)))))) (insert tree (cons key val))))))
(define map:search (define map:search
(lambda (<=>) (lambda (<=>)
@ -405,7 +398,7 @@
(lambda (<=>) (lambda (<=>)
(let ((delete (set:delete <=>))) (let ((delete (set:delete <=>)))
(lambda (tree key) (lambda (tree key)
(delete tree (map:empty-node key '())))))) (delete tree (cons key '()))))))
(define map:split (define map:split
(lambda (<=>) (set:split <=>))) (lambda (<=>) (set:split <=>)))
@ -467,6 +460,10 @@
"should have been found") "should have been found")
((and already-in (not (equal? already-in ((and already-in (not (equal? already-in
(map:val (cdr insert-return))))) (map:val (cdr insert-return)))))
(display (list already-in
insert-return
(map:val (cdr insert-return))))
(newline)
"found is not correct") "found is not correct")
(else (%set:operate-all f (car insert-return) (cdr lst))))))))) (else (%set:operate-all f (car insert-return) (cdr lst)))))))))
@ -534,7 +531,7 @@
(let ((insert-return (smap:insert '() (string #\a) 5))) (let ((insert-return (smap:insert '() (string #\a) 5)))
(cond (cond
((not (pair? insert-return)) "invalid insert return") ((not (pair? insert-return)) "invalid insert return")
((cdr insert-return) "string found in empty tree") ((not (null? (cdr insert-return))) "string found in empty tree")
(else (else
(let ((tree (car insert-return))) (let ((tree (car insert-return)))
(let ((found (smap:search tree (string #\a)))) (let ((found (smap:search tree (string #\a))))
@ -600,10 +597,8 @@
tree tree
(let ((tree (smap:update tree (let ((tree (smap:update tree
(string #\a #\b #\c #\d #\e) (string #\a #\b #\c #\d #\e)
(lambda (node oldnode) (lambda (key oldnode)
(map:node-new-val oldnode 10))))
(string #\a #\b #\c #\d #\e)
10)))))
(let ((res (%set:search-all tree (let ((res (%set:search-all tree
(list (list
(list (string #\a #\b #\c #\d) 1 1) (list (string #\a #\b #\c #\d) 1 1)