scheme 学习:红黑树
这几天继续学习scheme,scheme中虽然有hashtable但没有类似C++中的map,于是把C版本中的红黑树移植到scheme(中间也发现了C版本中的一些问题,暂时懒得调整了^()^)
以作为后序set和表格驱动设计中表格的基础数据结构.
虽说这个红黑树在C版本中是调试好的了,但移植过来还是花费了我一天多的时间,中间出现各种小问题,苦于并不熟悉如何调试scheme程序,所以进度十分缓慢.
(注:代码中大量使用set-car!所以无法再racket中运行,当然也可以调整rbnode的表示形式,不使用list来表示各字段,只使用set!修改字段的内容以使得可以被
racket支持)
(begin(define nil-node (list 0 0 'black '() '() '()));红黑树节点的定义;节点结构如下;(key (val (color (parent (left (right nil)))))) (define (make-rb-node key val)(list key val 'red '() '() '()))(define (get-key rbnode)(car rbnode))(define (get-val rbnode)(cadr rbnode))(define (set-val! rbnode val)(set-car! (cdr rbnode) val))(define (get-color rbnode)(caddr rbnode))(define (set-color! rbnode color)(set-car! (cddr rbnode) color))(define (get-parent rbnode)(cadddr rbnode)) (define (set-parent! rbnode parent)(if (not (equal? rbnode nil-node))(set-car! (cdddr rbnode) parent)))(define (get-left rbnode)(car (cddddr rbnode)))(define (set-left! rbnode left)(if (not (equal? rbnode nil-node))(set-car! (cddddr rbnode) left)))(define (get-right rbnode)(cadr (cddddr rbnode)))(define (set-right! rbnode right)(if (not (equal? rbnode nil-node))(set-car! (cdr (cddddr rbnode)) right)))(define (color-flip rbnode)(if (and (not (null? (get-left rbnode)))(not (null? (get-right rbnode))))(begin (set-color! rbnode 'red)(set-color! (get-left rbnode) 'black)(set-color! (get-right rbnode) 'black)#t)#f) );红黑树定义;(root (size nil)) (define (make-rbtree comp-function);(let ((rbtree (list nil 0 nil)))(let ((root nil-node)(size 0)(cmp-function comp-function))(define (rbtree-get-root) root)(define (rbtree-set-root! new-root) (set! root new-root))(define (rbtree-get-size) size)(define (rbtree-insert key val)(define rbnode (make-rb-node key val))(define child_link '())(define parent nil-node)(define cmp cmp-function)(define (iter cur)(if (equal? cur nil-node) #t(begin(set! parent cur)(let ((ret (cmp key (get-key cur))))(cond ((= 0 ret) #f)(else (if (< ret 0) (begin (set! child_link (cddddr cur))(set! cur (get-left cur)))(begin (set! child_link (cdr (cddddr cur)))(set! cur (get-right cur)))) (iter cur)))))))(if (not (iter (rbtree-get-root))) #f(begin(set-left! rbnode nil-node)(set-right! rbnode nil-node)(set-parent! rbnode parent)(if (not (null? child_link)) (set-car! child_link rbnode))(set! size (+ 1 size))(if (= 1 size)(rbtree-set-root! rbnode))(insert-fix-up rbnode)#t)))(define (rbtree-find-imp key)(define (iter node)(define cmp cmp-function)(if (equal? node nil-node)'()(let ((ret (cmp key (get-key node))))(cond ((= 0 ret) node)((= -1 ret) (iter (get-left node)))(else (iter (get-right node)))))))(if (= 0 size) '()(iter root)))(define (rbtree-find key)(define ret (rbtree-find-imp key))(if (null? ret) ret (get-val ret)))(define (rbtree-remove key)(define rbnode (rbtree-find-imp key))(if (null? rbnode)'()(rbtree-delete rbnode))rbnode );获取用于代替将被删除节点的节点 (define (get-replace-node rbnode)(cond ((and (equal? (get-left rbnode) nil-node)(equal? (get-right rbnode) nil-node))rbnode)((not (equal? (get-right rbnode) nil-node)) (minimum (get-right rbnode))) (else (maxmum (get-left rbnode)))))(define (rbtree-delete rbnode)(define x (get-replace-node rbnode));用x替代rbnode的位置(define rb-parent (get-parent rbnode));rbnode的父亲(define x-parent (get-parent x));x的父亲 (define x-old-color (get-color x))(define fix-node nil-node)(if (equal? nil-node (get-left x))(set! fix-node (get-right x))(set! fix-node (get-left x)))(if (not (equal? x rbnode));如果x与rbnode不是同一个节点 (begin;x的父亲不是rbnode,将x的孩子交给它的父亲 (if (not (equal? x-parent rbnode))(let ((child (if (not (equal? nil-node (get-left x)))(get-left x)(get-right x))))(set-parent! child x-parent) (if (equal? x (get-left x-parent)) (set-left! x-parent child) (set-right! x-parent child))))(if (not (equal? nil-node rb-parent));如果rb-parent不为nil让x成为rb-parent的孩子 (begin(if (equal? rbnode (get-left rb-parent))(set-left! rb-parent x)(set-right! rb-parent x))(set-parent! x rb-parent) );否则将x父亲设为nil (set-parent! x nil-node));将rbnode的孩子移交给x (let ((rb-left (get-left rbnode))(rb-right (get-right rbnode)))(if (not (equal? nil-node rb-left))(begin (set-left! x rb-left)(set-parent! rb-left x)))(if (not (equal? nil-node rb-right))(begin (set-right! x rb-right)(set-parent! rb-right x)))) ));将rbnode的所有关系清除 (set-left! rbnode nil-node)(set-right! rbnode nil-node)(set-parent! rbnode nil-node)(if (equal? root rbnode)(rbtree-set-root! x))(set! size (- size 1)) (if (and (equal? nil-node fix-node) (eq? x-old-color 'black))(delete-fix-up fix-node)) )(define (rotate-left rbnode)(define parent (get-parent rbnode))(define right (get-right rbnode))(if (not (equal? nil-node right))(begin(set-right! rbnode (get-left right))(set-parent! (get-left right) rbnode)(if (equal? root rbnode) (rbtree-set-root! right)(begin(if (equal? rbnode (get-left parent))(set-left! parent right)(set-right! parent right))))(set-parent! right parent)(set-parent! rbnode right)(set-left! right rbnode)#t)#f))(define (rotate-right rbnode)(define parent (get-parent rbnode))(define left (get-left rbnode))(if (not (equal? nil-node left))(begin(set-left! rbnode (get-right left))(set-parent! (get-right left) rbnode)(if (equal? root rbnode) (rbtree-set-root! left)(begin(if (equal? rbnode (get-left parent))(set-left! parent left)(set-right! parent left))))(set-parent! left parent)(set-parent! rbnode left)(set-right! left rbnode)#t)#f))(define (insert-fix-up rbnode)(define (iter n)(if (eq? (get-color (get-parent n)) 'black)(set-color! root 'black)(begin(let ((parent (get-parent n))(grand_parent (get-parent (get-parent n))))(if (equal? parent (get-left grand_parent))(begin(let ((ancle (get-right grand_parent)))(if (eq? (get-color ancle) 'red)(begin (color-flip grand_parent) (set! n grand_parent))(begin (if (equal? n (get-right parent))(begin (set! n parent)(rotate-left n)))(set-color! (get-parent n) 'black)(set-color! (get-parent (get-parent n)) 'red)(rotate-right (get-parent (get-parent n)))))) )(begin(let ((ancle (get-left grand_parent)))(if (eq? (get-color ancle) 'red)(begin (color-flip grand_parent) (set! n grand_parent))(begin (if (equal? n (get-left parent))(begin (set! n parent)(rotate-right n)))(set-color! (get-parent n) 'black)(set-color! (get-parent (get-parent n)) 'red)(rotate-left (get-parent (get-parent n)))))) )))(iter n))))(iter rbnode))(define (delete-fix-up rbnode)(define (iter n)(if (not (and (not (equal? n root))(not (equal? (get-color n) 'red))))(set-color! n 'black)(begin(let ((parent (get-parent n)))(if (equal? n (get-left parent))(begin(let ((w (get-right parent)))(if (eq? 'red (get-color w))(begin(set-color! w 'black)(set-color! parent 'red)(rotate-left parent)(set! w (get-right parent))))(if (and (eq? 'black (get-color (get-left w)))(eq? 'black (get-color (get-right w))))(begin (set-color! w 'red)(set! n parent))(begin(if (eq? (get-color (get-right w)) 'black)(begin(set-color! (get-left w) 'black)(set-color! w 'red)(rotate-right w)(set! w (get-right parent))))(set-color! w (get-color parent))(set-color! parent 'black)(set-color! (get-right w) 'black)(rotate-left parent)(set! n root) ))))(begin(let ((w (get-left parent)))(if (eq? 'red (get-color w))(begin(set-color! w 'black)(set-color! parent 'red)(rotate-right parent)(set! w (get-left parent))))(if (and (eq? 'black (get-color (get-left w)))(eq? 'black (get-color (get-right w))))(begin (set-color! w 'red)(set! n parent))(begin(if (eq? (get-color (get-left w)) 'black)(begin(set-color! (get-right w) 'black)(set-color! w 'red)(rotate-left w)(set! w (get-left parent))))(set-color! w (get-color parent))(set-color! parent 'black)(set-color! (get-left w) 'black)(rotate-right parent)(set! n root) )))))) (iter n))))(iter rbnode))(define (minimum rbnode)(define (minimum-imp rbnode)(if (equal? (get-left rbnode) nil-node)rbnode(minimum-imp (get-left rbnode))))(minimum-imp rbnode))(define (maxmum rbnode)(define (maxmum-imp rbnode)(if (equal? (get-right rbnode) nil-node)rbnode(maxmum-imp (get-right rbnode))))(maxmum-imp rbnode)) (define (successor rbnode)(define (iter parent node)(if (and (not (equal? parent nil-node))(equal? (get-right parent) node))(iter (get-parent parent) parent)parent))(if (not (equal? (get-right rbnode) nil-node))(minimum (get-right rbnode))(iter (get-parent rbnode) rbnode))) (define (node-next rbnode)(display (get-key rbnode))(newline)(if (null? rbnode) '()(begin(let ((succ (successor rbnode)))(if (equal? succ nil-node) '() succ))))) (define (rbtree->array)(define (iter rbnode ret)(if (null? rbnode) ret(iter (node-next rbnode) (cons (get-val rbnode) ret))))(iter (minimum root) '())) (lambda (op . arg)(cond ((eq? op 'find) (rbtree-find (car arg)))((eq? op 'remove) (rbtree-remove (car arg)))((eq? op 'insert) (rbtree-insert (car arg) (cadr arg)))((eq? op 'size) size)((eq? op 'root) (get-key root))((eq? op 'tree->array-desc) (rbtree->array))((eq? op 'tree->array-asc) (reverse (rbtree->array)))(else "bad op")))))(define (default-cmp a b)(cond ((= a b) 0)((< a b) -1)(else 1)))(define r (make-rbtree default-cmp))(r 'insert 1 1)(r 'insert 4 4)(r 'insert 5 5)(r 'insert 11 11)(r 'insert 15 15)(r 'insert 8 8)(r 'insert 2 2)(r 'insert 3 3)(r 'insert 6 6)(r 'insert 7 7) )
转载于:https://www.cnblogs.com/sniperHW/archive/2013/05/31/3110146.html
scheme 学习:红黑树相关推荐
- 学习红黑树过程中的个人总结
在知乎老师的帮助下,刚刚开始学习红黑树,个人的总结记录下 对于TreeMap.class添加方法的了解: 先贴代码(TreeMap.class添加调整方法): 这个是添加代码里面最后调用的方法,用于调 ...
- 算法学习----红黑树
算法学习----红黑树 红黑树的介绍 先来看下算法导论对R-BTree的介绍: 红黑树,一种二叉查找树,但在每个结点上增加一个存储位表示结点的颜色,可以是Red或Black. 通过对任何一条从根到叶子 ...
- 拒绝枯燥,用生动的例子带你学习红黑树
/ 今日科技快讯 / 2019胡润百富榜于今日(10月10日)揭晓,今年百富榜前十位的上榜门槛比去年上升100亿元,达到1200亿元.马云家族以2750亿元财富位列第一,第三次成为中国首富:马 ...
- java红黑树_JAVA学习-红黑树详解
1.定义 红黑树是特殊的二叉查找树,又名R-B树(RED-BLACK-TREE),由于红黑树是特殊的二叉查找树,即红黑树具有了二叉查找树的特性,而且红黑树还具有以下特性: 1.每个节点要么是黑色要么是 ...
- 数据结构 - 学习笔记 - 红黑树
数据结构 - 学习笔记 - 红黑树 定义 简介 知识点 1. 结点属性 2. 前驱.后继 3. 旋转 查找 插入 父结点为黑色 父结点为红色 1. 有4种情形只需要变色(对应234树4结点) 1.1. ...
- COSMIC的后端学习之路——1.1 随处可见的红黑树
1.1 随处可见的红黑树 1.知识树 2.红黑树的性质(3) 3.红黑树的使用(2) 4.红黑树用在哪里(举例) 5.判断是否为叶子节点的方法(2) 6.红黑树的旋转 (1)左旋 (2)右旋 7.操作 ...
- 图解 二叉查找树 红黑树
红黑树,对很多童鞋来说,是既熟悉又陌生.熟悉是因为在校学习期间,准备面试时,这是重点.然后经过多年的荒废,如今已经忘记的差不多了.如果正在看文章的你,马上快要毕业,面临着找工作的压力:又或者你觉得需要 ...
- 红黑树效率为甚恶魔是log_一文带你彻底读懂红黑树(附详细图解)
红黑树简介 红黑树是一种自平衡的二叉查找树,是一种高效的查找树.它是由 Rudolf Bayer 于1972年发明,在当时被称为对称二叉 B 树(symmetric binary B-trees).后 ...
- 红黑树(三)之 C++的实现
概要 前面分别介绍红黑树的理论知识和红黑树的C语言实现.本章是红黑树的C++实现,若读者对红黑树的理论知识不熟悉,建立先学习红黑树的理论知识,再来学习本章. 目录 1. 红黑树的介绍 2. 红黑树的C ...
最新文章
- linux修正系统错误指令fsck和badblocks
- 你有哪些deep learning(rnn、cnn)调参的经验?
- 单点登录(SSO)—简介
- 关于jQuery中的offset()和position()
- Nginx教程-安装
- Pipelines - .NET中的新IO API指引(二)
- hihoCoder 1014trie树(字典树)
- 初步理解NServiceBus
- JAVAWeb项目 微型商城项目-------(五)用户登录实现
- FTP服务器配置与管理(2) 创建FTP站点
- sap未分摊差异怎么处理_聊一聊,临时外包员工差异化薪酬要怎么处理
- 【第9篇】Python爬虫实战-银行卡归属地查询
- premiere直接使用计算机素材,Premiere使用技巧之视频捕捉 -电脑资料
- ajax上传图片到又拍云,又拍云存储(UpYun)的.NET Core填坑
- cmd_vel速度话题的使用
- 2023.04.22更新大麦网移动端/M端抢购软件和使用教程
- UDIMM和RDIMM内存条区别
- centos /bin/sh: warning: setlocale: LC_ALL: cannot change locale (en_US.UTF-8)
- 基于 Spring Boot 的在线考试系统
- matlab DSP6678,TI CC6678数字信号处理器 (DSP) 的50种用法
热门文章
- 一条语句判断数x是否2的n次幂.求取二进制1的个数
- 全国英语计算机9月统考2019,2019年9月网络教育统考《计算机应用基础》模拟题6...
- request mysql 接口_TP5接口开发
- C语言实现单链表(带头结点)的基本操作(创建,头插法,尾插法,删除结点,打印链表)
- Python3输入输出
- 万字长文!2020-2021京东Java面试真题解析
- Android架构师谈:View-Pager-性能优化之-无限循环
- 计算机网络与网站设计知识点,计算机网络技术知识点总结-20210525075410.docx-原创力文档...
- BaseYii_autoload
- POJ 1502	MPI Maelstrom 最短路