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