乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 11|回复: 11

[编程交流] 函数vl排序问题

[复制链接]

2

主题

11

帖子

9

银币

初来乍到

Rank: 1

铜币
10
发表于 2022-7-6 11:15:45 | 显示全部楼层 |阅读模式
大家好。
我对函数vl sort有问题
这是代码
  1. (setq L (list "D1A" "D3" "D7" "D4" "D9" "D10B" "D10A" "D11" "D2" "D20A"))
  2. (vl-sort L '<)

 
例子:
 
  1. (defun ArchSort (lst / SplitStr comparable)
  2. ;; Gile & Lee Mac
  3. (defun SplitStr (str / lst test rslt num tmp)
  4.    
  5.    (setq lst  (vl-string->list str)
  6.          test (chr (car lst)))
  7.    
  8.    (if (< 47 (car lst) 58)
  9.      (setq num T))
  10.    
  11.    (while (setq lst (cdr lst))
  12.      (if num
  13.        (cond (  (= 46 (car lst))
  14.                 (if (and (cadr lst)
  15.                          (setq tmp (strcat "0." (chr (cadr lst))))
  16.                          (numberp (read tmp)))
  17.                   (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
  18.                   (setq rslt (cons (read test) rslt) test "." num nil)))
  19.              (  (< 47 (car lst) 58)
  20.                 (setq test (strcat test (chr (car lst)))))
  21.              (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))
  22.        (if (< 47 (car lst) 58)
  23.          (setq rslt (cons test rslt) test (chr (car lst)) num  T)
  24.          (setq test (strcat test (chr (car lst)))))))
  25.    
  26.    (if num
  27.      (setq rslt (cons (read test) rslt))
  28.      (setq rslt (cons test rslt)))
  29.    
  30.    (reverse rslt))
  31. (defun comparable (e1 e2)
  32.    (or (and (numberp e1) (numberp e2))
  33.        (= 'STR (type e1) (type e2))
  34.        (not e1)
  35.        (not e2)))
  36. (mapcar
  37.    (function
  38.      (lambda (x)
  39.        (nth x lst)))
  40.    
  41.    (vl-sort-i (mapcar (function SplitStr) lst)
  42.      (function
  43.        (lambda (x1 x2 / n1 n2 comp)
  44.          (while
  45.            (and (setq comp (comparable (setq n1 (car x1))
  46.                                        (setq n2 (car x2))))
  47.                 (= n1 n2))
  48.             (setq x1 (cdr x1) x2 (cdr x2)))
  49.          
  50.          (if comp (< n1 n2) (numberp n1)))))))

 
  1. (ArchSort (list "D1A" "D3" "D7" "D4" "D9" "D10B" "D10A" "D11" "D2" "D20A"))
  2. >> ("D1A" "D2" "D3" "D4" "D7" "D9" "D10A" "D10B" "D11" "D20A")
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 11:21:56 | 显示全部楼层
太棒了!
谢谢Gile
谢谢李
 
非常感谢你
回复

使用道具 举报

2

主题

11

帖子

9

银币

初来乍到

Rank: 1

铜币
10
发表于 2022-7-6 11:31:54 | 显示全部楼层
不客气
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 11:35:15 | 显示全部楼层
谢谢李
当我有列表L时,请告诉我如何使用函数ArchSort
 
(setq L(append(list(cons“D1A”2))(list(cons“D3”2))(list(cons“D7”3))(list(cons“D4”2))(list(cons“D9”1))(list(cons“D10B”1))(list(cons“D10A”3))(list(cons“D11”2))(list(cons“D2”4))(list(cons“D20A”2)))
 
((“D1A.2)(“D3.2”(“D7.3)(“D4.2”(“D9.1)(“D10B.1)(“D10A”)。
3) (“D11.2)(“D2.4”(“D20A.2))
 
请告诉我怎么解决
谢谢
回复

使用道具 举报

2

主题

11

帖子

9

银币

初来乍到

Rank: 1

铜币
10
发表于 2022-7-6 11:40:31 | 显示全部楼层
更改突出显示。
 
顺便说一句,不需要所有的附加。。。
 
  1. (defun ArchSort (lst / SplitStr comparable)
  2. ;; Gile & Lee Mac
  3. (defun SplitStr (str / lst test rslt num tmp)
  4.    
  5.    (setq lst  (vl-string->list str)
  6.          test (chr (car lst)))
  7.    
  8.    (if (< 47 (car lst) 58)
  9.      (setq num T))
  10.    
  11.    (while (setq lst (cdr lst))
  12.      (if num
  13.        (cond (  (= 46 (car lst))
  14.                 (if (and (cadr lst)
  15.                          (setq tmp (strcat "0." (chr (cadr lst))))
  16.                          (numberp (read tmp)))
  17.                   (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
  18.                   (setq rslt (cons (read test) rslt) test "." num nil)))
  19.              (  (< 47 (car lst) 58)
  20.                 (setq test (strcat test (chr (car lst)))))
  21.              (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))
  22.        (if (< 47 (car lst) 58)
  23.          (setq rslt (cons test rslt) test (chr (car lst)) num  T)
  24.          (setq test (strcat test (chr (car lst)))))))
  25.    
  26.    (if num
  27.      (setq rslt (cons (read test) rslt))
  28.      (setq rslt (cons test rslt)))
  29.    
  30.    (reverse rslt))
  31. (defun comparable (e1 e2)
  32.    (or (and (numberp e1) (numberp e2))
  33.        (= 'STR (type e1) (type e2))
  34.        (not e1)
  35.        (not e2)))
  36. (mapcar
  37.    (function
  38.      (lambda (x)
  39.        (nth x lst)))
  40.    
  41.    (vl-sort-i (mapcar (function SplitStr) [color=Blue][b](mapcar (function car)[/b][/color] lst[b][color=Blue])[/color][/b])
  42.      (function
  43.        (lambda (x1 x2 / n1 n2 comp)
  44.          (while
  45.            (and (setq comp (comparable (setq n1 (car x1))
  46.                                        (setq n2 (car x2))))
  47.                 (= n1 n2))
  48.             (setq x1 (cdr x1) x2 (cdr x2)))
  49.          
  50.          (if comp (< n1 n2) (numberp n1)))))))
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 11:44:26 | 显示全部楼层
非常感谢李
但是我在列表L中遇到了一个问题。这个代码不起作用
(ArchSort(列表“D1-1”“D1-10”“D1-12”“D1-13”“D1-14”“D1-15A”“D1-15B”“D1-15C”“D1-1B”“D1-1C”“D1-1D”“D1-2”“D1-20”“D1-21”“D1-22”“D1-23”“D1-3A”“D1-3B”“D1-4A”“D1-4B”“D1-4C”“D1-5”“D1-6A”“D1-6B”“D1-7A”“D1-7B”“D1-8”“D1-9A”“D1-9B”“D1-9C”“D1-B”“D1-C”“D1-D”“DL-D“DL-E”))
>>>>不起作用。。。。。
 
我不明白为什么?
请告诉我怎么解决
谢谢
回复

使用道具 举报

2

主题

11

帖子

9

银币

初来乍到

Rank: 1

铜币
10
发表于 2022-7-6 11:51:36 | 显示全部楼层
你能帮我查一下密码吗?
非常感谢你
回复

使用道具 举报

2

主题

11

帖子

9

银币

初来乍到

Rank: 1

铜币
10
发表于 2022-7-6 11:58:33 | 显示全部楼层
试试这个:
 
  1. 5
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 12:01:25 | 显示全部楼层
代码对你有用吗?
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 12:09:17 | 显示全部楼层
太好了
谢谢你的帮助
代码运行得很好
谢谢
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-6 11:14 , Processed in 0.615857 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表