设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 算法与数据结构 › 堆排序-LISP
返回列表 发新帖
查看: 1726|回复: 4

[研讨] 堆排序-LISP

[复制链接]
守仁格竹GM

已领礼包: 1757个

财富等级: 堆金积玉
发表于 2014-12-24 08:12:45 | 显示全部楼层 |阅读模式

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
本帖最后由 守仁格竹GM 于 2014-12-24 08:21 编辑

抛砖引玉，对于堆排序尚不清楚，代码属于多C语言直译。希望大家优化。
经测试，目前此函数没有vl-sort运行速度快，慢很多。
  2. ;获取表中第N个元素（从1开始）
  3. ;(setq s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) "123" "555"))
  4. ;(gm-Lst-Nth 2 S) ;获取(4 5 6)
  5. (defun gm-Lst-Nth (N lst)
  6.    (nth (- N 1) lst)
  7. )
  8. ;替换表中第N个元素（从1开始）
  9. ;(gm-Lst-N-Subst "KKK" 2 s)  ;获取：((1 2 3) "KKK" (7 8 9) "123" "555")
  10. (defun gm-Lst-N-Subst (a n lst / i)
  11.   (setq i 0)
  12.   (apply
  13.     'append
  14.     (mapcar
  15.       '(lambda(x)
  16.    (setq i (1+ i))
  17.    (if (= n i)
  18.      (if a (list a) nil)
  19.      (list x)
  20.    )
  21.       )
  22.       lst
  23.     )
  24.   )
  25. )  
  26. (defun gm-HeapAdjust (lst s m / data_s rc j data_j)
  27.   (setq data_s (gm-Lst-Nth s lst))
  28.   (setq rc data_s)
  29.   (setq j (* 2 s))
  30.   (setq data_j (gm-Lst-Nth j lst))
  31.   (while (and (<= rc data_j) (<= j m))
  32.     (if(and (< j m) (< (gm-Lst-Nth j lst) (gm-Lst-Nth (1+ j) lst))) (setq j (1+ j)))
  33.     (if (<= rc (setq data_j (gm-Lst-Nth j lst)))
  34.       (progn
  35.   ;(setq data_s data_j)
  36.   (setq lst (gm-Lst-N-Subst data_j s lst))
  37.   (setq s j)
  38.   (setq j (* j 2))
  39.       )
  40.     )
  41.   )
  42.   (gm-Lst-N-Subst rc s lst)
  43. )

  45. ;(Heap_sort  '(42 13 24 91 23 16 5 88)  8)
  46. (defun Heap_sort (lst long_n / i temp)
  47.   (setq i (fix(* long_n 0.5)))
  48.   (while (> i 0)
  49.     (setq lst (gm-HeapAdjust lst i long_n))
  50.     (setq i (1- i))
  51.   )
  52.   (setq i long_n)
  53.   (while (> i 0)
  54.     (setq temp (nth 0 lst))
  55.     (setq lst (gm-Lst-N-Subst (gm-Lst-Nth i lst) 1 lst))
  56.     (setq lst (gm-Lst-N-Subst temp i lst))
  57.     (setq lst (gm-HeapAdjust lst 1 (1- i)))
  58.     (setq i (1- i))
  59.   )
  60.   lst
  61. )
修改成能够方便应用的排序，代码如下（速度同上--慢）：
  2. ;|
  3. (setq lst
  4.        '((42 (1 2 3)) (13 (4 5 6)) (24 (7 8 9))
  5.          (91 (10 11 12)) (23 (13 14 15)) (16 (16 17))
  6.          (5 123) (88 (123))))
  7. (setq   long_n 8)
  8. (pt_Heap_sort lst 8)
  9. |;

  11. (defun pt_Heap_sort (lst long_n / i temp)
  12.   (setq i (fix(* long_n 0.5)))
  13.   (while (> i 0)
  14.     (setq lst (pt_HeapAdjust lst i long_n))
  15.     (setq i (1- i))
  16.   )
  17.   (setq i long_n)
  18.   (while (> i 0)
  19.     (setq temp (nth 0 lst))
  20.     (setq lst (gm-Lst-N-Subst (gm-Lst-Nth i lst) 1 lst))
  21.     (setq lst (gm-Lst-N-Subst temp i lst))
  22.     (setq lst (pt_HeapAdjust lst 1 (1- i)))
  23.     (setq i (1- i))
  24.   )
  25.   lst
  26. )
  27. (defun pt_HeapAdjust (lst s m / data_s rc j data_j)
  28.   (setq data_s (gm-Lst-Nth s lst))
  29.   (setq rc data_s)
  30.   (setq j (* 2 s))
  31.   (setq data_j (gm-Lst-Nth j lst))
  32.   (while (and (<= (car rc) (car data_j)) (<= j m))
  33.     (if(and (< j m) (< (car(gm-Lst-Nth j lst)) (car(gm-Lst-Nth (1+ j) lst)))) (setq j (1+ j)))
  34.     (if (<= (car rc) (car(setq data_j (gm-Lst-Nth j lst))))
  35.       (progn
  36.   ;(setq data_s data_j)
  37.   (setq lst (gm-Lst-N-Subst data_j s lst))
  38.   (setq s j)
  39.   (setq j (* j 2))
  40.       )
  41.     )
  42.   )
  43.   (gm-Lst-N-Subst rc s lst)
  44. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

守仁格竹GM

已领礼包: 1757个

财富等级: 堆金积玉
 楼主| 发表于 2014-12-24 08:23:41 | 显示全部楼层
void HeapAdjust(int data[],int s,int m) /* 排列成堆的形式 */
{
     int j,rc;
     rc=data[s];     /* 保存处理元素 */
     for(j=2*s;j<=m;j*=2)        /* 处理父亲元素 */
     {
          if(j<m && data[j]<data[j+1])  ++j; /* 取较大的孩子节点 */
          if(rc>data[j]) break;
          data[s]=data[j];   /* 父节点比较大的孩子节点大则互换 ,保证父节点比所有子节点都大（父节点存储在前面）*/
          s=j;
     }
    data[s]=rc;     /* 相当于data[j]=rc */
}
void Heap_sort(int data[],int long_n) /* 堆排序函数 */
{
     int i,temp;
     for(i=long_n/2;i>0;--i)  /* 还没有读懂这样处理的原因，希望大家不吝赐教 */
     {
      HeapAdjust(data,i,long_n); /* 处理后，data[i]是这个数组后半部分的最大值 */
     }
     for(i=long_n;i>0;--i)
     {
      temp=data[1];    /* 把根元素（剩下元素中最大的那个）放到结尾 ,下一次只要排剩下的数就可以啦*/
      data[1]=data[i];
      data[i]=temp;   
      HeapAdjust(data,1,i-1);
     }
}
这是对应的C语言代码
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

/db_自贡黄明儒_

已领礼包: 604个

财富等级: 财运亨通
发表于 2014-12-24 08:34:09 | 显示全部楼层
高飞的
http://bbs.xdcad.net/forum.php?m ... peid%26typeid%3D123
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Lisphk

已领礼包: 19个

财富等级: 恭喜发财
发表于 2014-12-24 09:47:32 | 显示全部楼层
可以像VL-SORT那样，支持带任意的子表排序吗？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1903个

财富等级: 堆金积玉
发表于 2014-12-27 15:07:48 来自手机 | 显示全部楼层
想了个效率很低的整数排序算法，1，根据表lst中的最小，最大值构造一个逐步增1的有序表lst0；2，对表lst0中每个元素e做判断，若e为lst中的某一元素，则输出该元素，得到排序后的结果。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-20 07:41 , Processed in 0.443365 second(s), 43 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表