两个表配对、表匹配的函数

Zrrrrr

在论坛没有搜到相关功能，就写了个两个表匹配的函数，用于两个表匹配：
;;功能：将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)
)

;;;;;;;;;;;;;;;;
由于论坛发代码似乎不方便，故再截个图看的清晰些

kkq0305

(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

我写了 一个 交流一下

Bao_lai

不知使用场景

Zrrrrr

kkq0305 发表于 2021-6-6 18:24
(defun ZR:list:makepair        (l1 l2 f flag / lst)
  (vl-load-com)
  (and (setq

看起来有点像LEEMAC的风格，反正我看起来很费劲。。

Zrrrrr

Bao_lai 发表于 2021-6-6 21:02
不知使用场景

有点类似小朋友的配对游戏题，左边一列右边一列，根据规则把这两列的元素配对。比如第一个表是1 2 3 4，第二个表是4 2 1 3，按两个元素相加等于5作为配对规则，那么配对结果就是（（1 4）（2 3）（3 2）（4 1））

kkq0305

Zrrrrr 发表于 2021-6-7 23:30
有点类似小朋友的配对游戏题，左边一列右边一列，根据规则把这两列的元素配对。比如第一个表是1 2 3 4， ...

就是这种意思 我写的代码 都是这种风格   leemac 久仰大名还没有读过他写的代码  我都是在论坛边逛边消化 写的

376394482

谢谢分享          .