两个表配对、表匹配的函数
本帖最后由 Zrrrrr 于 2021-6-4 22:25 编辑在论坛没有搜到相关功能，就写了个两个表匹配的函数，用于两个表匹配：
;;功能：将L1中每个元素的第一个元素与L2中每个元素的第一个元素进行配对，若配对成功，则改元素对作为新表的一个元素
;;示例及调试：
;;L1: ((1 . 2) (2 . 3))
;;L2: ((2 . 1)(3 . 3) (4 . 5) (5 . 6))
;;f: 配对函数，以L1中某元素和L2中某元素作为参数
;;flag: 若为nil，则不允许L2中元素重复使用，若为T，则L2中元素可以重复使用。本例中以两个元素加起来为5作为配对依据
;;调试：
;(ZR:list:makepair '((1 . 2) (1 . 3) (1.5 . 4) (2 . 3)) '((2 . 1)(3 . 3) (4 . 5) (5 . 6))
; (function
;(lambda (x y)
; (if (= 5 (+ (car x) (car y)))
; (list x y)
; )
;)
; )
; nil
;)
;;返回：(((1 . 2) (4 . 5)) ((2 . 3) (3 . 3)))，即：(1 . 2) 和(4 . 5)因为1+4=5满足配对函数的条件故配成了一组，余同。
;;源代码：
(defun ZR:list:makepair (l1 l2 f flag / tmp i j r)
(setq i 0 j 0 f (eval f))
(if (and l1 l2)
(progn
(while (< i (length l1))
(setq j 0 tmp nil)
(while (and (< j (length l2)) (null tmp))
(if (setq tmp (f (nth i l1) (nth j l2)))
(progn
(setq r (append r (list tmp)))
(if (null flag) (setq l2 (LI_DelLst0 l2 j)))
)
(setq j (1+ j))
)
)
(setq i (1+ i))
)
r
)
)
)
;子函数：按索引删除表中的一个元素（非原创）
(defun LI_DelLst0 ( Lst Idx / nlst cnt elem )
(setq
nlst '()
cnt 0
)
(foreach elem lst
(if (/= cnt Idx)
(setq nlst (cons elem nlst))
)
(setq cnt (1+ cnt))
)
(reverse nlst)
)
;;;;;;;;;;;;;;;;
由于论坛发代码似乎不方便，故再截个图看的清晰些
(defun ZR:list:makepair (l1 l2 f flag / lst)
(vl-load-com)
(and (setq
lst
(vl-remove
nil
(mapcar
'(lambda (x) (apply f x))
(apply
'append
(mapcar
'(lambda (x) (mapcar '(lambda (y) (list x y)) l2))
l1
)
)
)
)
)
(not flag)
(setq lst
(mapcar 'car
(lstdup lst '(lambda (x y) (equal (cadr x) (cadr y))))
)
)
)
lst
)
(defun lstdup (lst f)
(if lst
(cons (vl-remove-if-not '(lambda (x) (apply f (list x (car lst)))) lst)
(lstdup (vl-remove-if '(lambda (x) (apply f (list x (car lst)))) lst) f)
)
)
) 我写了 一个 交流一下
不知使用场景 kkq0305 发表于 2021-6-6 18:24
(defun ZR:list:makepair (l1 l2 f flag / lst)
(vl-load-com)
(and (setq
看起来有点像LEEMAC的风格，反正我看起来很费劲。。 Bao_lai 发表于 2021-6-6 21:02
不知使用场景
有点类似小朋友的配对游戏题，左边一列右边一列，根据规则把这两列的元素配对。比如第一个表是1 2 3 4，第二个表是4 2 1 3，按两个元素相加等于5作为配对规则，那么配对结果就是（（1 4）（2 3）（3 2）（4 1））
Zrrrrr 发表于 2021-6-7 23:30
有点类似小朋友的配对游戏题，左边一列右边一列，根据规则把这两列的元素配对。比如第一个表是1 2 3 4， ...
就是这种意思 我写的代码 都是这种风格 leemac 久仰大名还没有读过他写的代码我都是在论坛边逛边消化 写的 谢谢分享 .
页:
[1]