dcl1214 发表于 前天 20:23

数据转置



(defun $shu-ju-zhuan-zhi$ (d lst / a b i ks ljs old old-cdr)
          ;数据转置
(while (setq a (car d))
    (setq i 1)
    (while (and a)
      (setq b (car a))
      (setq old-cdr nil)
      (setq old (assoc i ks))
      (and old (setq old-cdr (cdr old)))
      (setq old-cdr (cons b old-cdr))
      (and old (setq ks (vl-remove old ks)))
      (setq ks (cons (cons i old-cdr) ks))
      (setq i (1+ i))
      (setq a (cdr a))
    )
    (setq d (cdr d))
)
(setq
    ks (vl-sortks
    (function (lambda (e1 e2) (< (car e1) (car e2))))
       )
)
(setq d (mapcar 'cdr ks))
d
)

感谢qr测试

Bao_lai 发表于 前天 21:02

杜老师，应该上一个示例用法。

tigcat 发表于 前天 22:44

Bao_lai 发表于 2025-7-2 21:02
杜老师，应该上一个示例用法。

lst没有用上，
_$ ($shu-ju-zhuan-zhi$ '((1 2 3) (4 5 6)) t)
((4 1) (5 2) (6 3))
_$

tigcat 发表于 前天 22:53

感觉和这个一样的功能
(apply 'mapcar (cons 'list (reverse '((1 2 3) (4 5 6)(7 8 9)))))

kozmosovia 发表于 前天 22:54

一句代码的事(Defun Transpose (l)
(apply 'mapcar (cons 'list l))
)

kozmosovia 发表于 前天 23:06

tigcat 发表于 2025-7-2 22:44
lst没有用上，
_$ ($shu-ju-zhuan-zhi$ '((1 2 3) (4 5 6)) t)
((4 1) (5 2) (6 3))


转置出来竟然倒序？应该((1 4)(2 5)(3 6))才是正确的。

dcl1214 发表于 昨天 12:52

tigcat 发表于 2025-7-2 22:53
感觉和这个一样的功能
(apply 'mapcar (cons 'list (reverse '((1 2 3) (4 5 6)(7 8 9)))))

每个表内的元素数量个数不等，试试

llsheng_73 发表于 昨天 13:56

dcl1214 发表于 2025-7-3 12:52
每个表内的元素数量个数不等，试试
数据应该有一定的使用场景，如果子项缺失可能导致数据失真（无法确定缺失的项是哪几个项），这样的数据处理前应该检查，或者处理时丢弃无意义的数据，保留它反倒不知道它是怎么回事了
比如($shu-ju-zhuan-zhi$ '((1 2 ) (4 5 3)) t)和($shu-ju-zhuan-zhi$ '((1 2 3) (4 5)) t)返回结果是一样的((4 1) (5 2) (3))，这时只知道(3)这是因数缺项了，但不知道到底是哪个位置缺失的，倒不如直接丢掉省事

tigcat 发表于 昨天 16:20

llsheng_73 发表于 2025-7-3 13:56
数据应该有一定的使用场景，如果子项缺失可能导致数据失真（无法确定缺失的项是哪几个项），这样的数据处 ...

可能大佬有自己要用到的特殊场景吧。
页: [1]
查看完整版本: 数据转置