SICP Table

主要叙述一下习题中的两个

其一为生成keylist为argument的过程

这个操作显然又是一种递归思路,我们只需不断生成子表直到最后一个key 但是与textbook中不同的是

textbook中由于是two dimensional table 所以直接将首项加入子表中

而我们生成的仅仅是子表,故只需(list (car keylist))即可

同样,我们类似思路可以实现lookup 

完成以上后我们进行测试,结果会有点bug 例如 (put '(a) 1) (put '(a b) 2)

我们(get '(a))将得到值1 和子表 (b 2) 这显然不是我们要的结果,但是非常接近

我们对结果打个补丁,将(not pair? ）进行输出即可

其二为利用树的结构实现有序表

这个一开始看到实在有点懵逼,所以直接重写了一个,遗憾是只实现了一维表,原因是因为二维即以上需要再加一个空作为子树(key-2)的指针

首先,我们要创建树节点(key value left-node right-node)的selectors 以及mutators 其次我们要创建树addnode looknode等操作

最后将这些放入我们的insert lookup中即可

以下是实现代码

(define same-key? eq?)
(define (find-not-pair list) 
	(cond	((null? list) ())
		((not (pair? list)) list)
		((not (pair? (car list))) (car list))
		(else (find-not-pair (cdr list)))))
(define (last list) (if (null? (cdr list)) (car list) (last (cdr list))))
(define (make-table same-key?)
	(let	((table (list '*table*)))
		(define (insert keylist value)
			(define (iter keylist table)
				(cond	((null? (cdr keylist)) table)
					(else 
						(let	((subtable (assq (car keylist) (cdr table))))
							(if	(null? subtable)
								(begin
									(set-cdr! table (cons (list (car keylist)) (cdr table)))
									(iter (cdr keylist) (cadr table)))
								(iter (cdr keylist) subtable))))))
			(let	((subtable (iter keylist table)))
				(let	((record (assq (last keylist) (cdr subtable))))
					(if	(null? record)
						(set-cdr! subtable (cons (cons (last keylist) value) (cdr subtable)))
						(set-cdr! record value))))
			'ok)
		(define (lookup keylist)
			(define (iter keylist table)
				(if	(null? (cdr keylist))
					table
					(let	((subtable (assq (car keylist) (cdr table))))
						(if	(null? subtable)
							()
							(iter (cdr keylist) subtable)))))
			(let	((subtable (iter keylist table)))
				(if	(null? subtable)
					()
					(let	((record (assq (last keylist) (cdr subtable))))
						(if	(null? record)
							()
							(find-not-pair (cdr record)))))))
		(define (assq key records)
				(cond	((null? records) ())
					((not (pair? records)) ())
					((same-key? key (caar records)) (car records))
					(else (assq key (cdr records)))))
		(lambda (m) 
			(cond	((eq? m 'lookup) lookup)
				((eq? m 'insert) insert)
				(else (error "Error Operation --TABLE" m))))))
(define tmp-table (make-table same-key?))
(define put (tmp-table 'insert))
(define get (tmp-table 'lookup))

;;First I need to implement the one dimensional  ordered  table use tree
(define (make-table)
	;;use a list (key vaule smaller-key bigger-key) as a node
	
	;;Node
	(define (create-node key value)
		(list key value () ()))

	(define (Nodekey node) (car node))
	(define (Nodevalue node) (cadr node))
	(define (NodeSkey node)  (caddr node))
	(define (NodeBkey node) (cadddr node))

	(define (Setvalue node value) (set-car! (cdr node) value ))
	(define (SetSkey node item) (set-car! (cddr node) item ))
	(define (SetBkey node item) (set-car! (cdddr node) item ))
	(define (setKey node key ) (set-car! node key))


	;;Tree Operation
	
	(define (Addnode key value node)
		(cond	((= key (Nodekey node))
				(Setvalue node value))
			((< key (Nodekey node))
				(cond	((null? (NodeSkey node))
						(SetSkey node (create-node key value)))
					((> key (Nodekey (NodeSkey node)))
						(let	((new-node (create-node key value)))
							(SetSkey new-node (NodeSkey node))
							(SetSkey node new-node)))
					(else (Addnode key value (NodeSkey node)))))
			((> key (Nodekey node))
				(cond	((null? (NodeBkey node))
						(SetBkey node (create-node key value)))
					((< key (Nodekey (NodeBkey node)))
						(let	((new-node (create-node key value)))
							(SetBkey new-node (NodeBkey node))
							(SetBkey node new-node)))))))

	(define (LookNode key node)
		(cond	((null? node) ())
			((= key (Nodekey node)) (NodeValue node))
			((< key (Nodekey node)) (LookNode key (NodeSkey node)))
			(else (LookNode key (NodeBkey node)))))
	

	;;Table Tree
	(let	((table (cons '*table* (create-node () ()))))
		(define (insert key value)
		;;Here assume it can be ordered by numerically
			(define (iter node)
				(cond
					((null? (Nodekey node)) (SetKey node key) (Setvalue node value))
					(else (Addnode key value node))))
			(iter (cdr table))
		'ok)
		(define (lookup key)
			(define (iter node)
				(cond
					((null? (Nodekey node)) ())
					(else (LookNode key node))))
			(iter (cdr table)))
		(lambda (m)
			(cond
				((eq? m 'insert) insert)
				((eq? m 'lookup) lookup)
				(else (error "Error Operation -- TABLE" m))))))
(define tmp-table (make-table))
(define put (tmp-table 'insert))
(define get (tmp-table 'lookup))