明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 304|回复: 6

[源码] 两个表配对、表匹配的函数

[复制链接]
发表于 2021-6-4 22:18 | 显示全部楼层 |阅读模式
本帖最后由 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)
)

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1明经币 +1 收起 理由
tryhi + 1 赞一个!

查看全部评分

发表于 2021-6-6 18:24 | 显示全部楼层
(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)
    )
  )
)

评分

参与人数 1明经币 +1 收起 理由
tryhi + 1 赞一个!

查看全部评分

发表于 2021-6-6 18:24 | 显示全部楼层
我写了 一个 交流一下
发表于 2021-6-6 21:02 来自手机 | 显示全部楼层
不知使用场景
 楼主| 发表于 2021-6-7 23:26 来自手机 | 显示全部楼层
kkq0305 发表于 2021-6-6 18:24
(defun ZR:list:makepair        (l1 l2 f flag / lst)
  (vl-load-com)
  (and (setq

看起来有点像LEEMAC的风格,反正我看起来很费劲。。
 楼主| 发表于 2021-6-7 23:30 来自手机 | 显示全部楼层
Bao_lai 发表于 2021-6-6 21:02
不知使用场景

有点类似小朋友的配对游戏题,左边一列右边一列,根据规则把这两列的元素配对。比如第一个表是1 2 3 4,第二个表是4 2 1 3,按两个元素相加等于5作为配对规则,那么配对结果就是((1 4)(2 3)(3 2)(4 1))
发表于 2021-6-8 01:50 | 显示全部楼层
Zrrrrr 发表于 2021-6-7 23:30
有点类似小朋友的配对游戏题,左边一列右边一列,根据规则把这两列的元素配对。比如第一个表是1 2 3 4, ...

就是这种意思 我写的代码 都是这种风格   leemac 久仰大名还没有读过他写的代码  我都是在论坛边逛边消化 写的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2020 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2021-6-16 05:36 , Processed in 0.456008 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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