在列表中排序列表

Quest for Peace · 发表于 2022-7-5 18:40:20

我有一个基本上由点列表组成的列表。我需要比较点列表（模糊度可以是2’，但每英寸的分数都会有所不同），并记录所有长度和点位置相等的点：
((1 (1 2 0) (3 4 0) (5 6 0)) (2 (3 4 0) (1 2 0) (5 6 0)) (3 (2 1 0) (4 3 0) (5 6 0)) (4 (1 2 0) (3 4 0) (5 6 0)) (5 (7 8 0) (9 10 0) (5 6 0)) (6 (2 1 0) (4 3 0) (5 6 0))
结果是：（（1 2 4）（3 6））
注意2仍然是相等的，即使点无序，5被忽略，因为它是唯一的。哦，我指的这些数字是用于跟踪单个列表的主要索引数字。如果这意味着什么，第一个点总是0,0–或接近它。
以下是该程序生成的实际列表：

我相信结果是（（1 2 4 5）（6 9 10））。清单3、7、8和11是唯一的。3缺少一点，11完全不同。列表7和8应该匹配，但我的程序刚刚告诉我#7缺少一点。任何事情的顺序都不重要，只要列出的列表定义了哪些列表是相等的。列表通常有6-10个点长，一个图形中可以有多达80个列表，在某些组合中通常有80%以上的列表相互匹配。

我到处都找过了，什么都没找到。当我试着用手去做的时候，它立刻分解成了一个个循环，我不可能在脑海中记录下来，去理解我在做什么或试图做什么。你们中的一些人在编程方面非常老练（因为你们是专业人士），我纯粹是业余爱好者。因此，请避免视觉lisp。我不可能理解这一点，也不可能在以后需要时对其进行调整。我相信有人会嘲笑我，然后用几句话来解决这个问题。Mapcar和Lambda的疯狂组合。提前谢谢。对不起，如果我没有正确地发布这个。我经常潜伏，但很少发帖。谢谢

rlx · 发表于 2022-7-5 18:49:29

当你说，请避免视觉Lisp程序，你为什么把你的问题张贴在这里？

您的解决方案在于此链接http://www.lee-mac.com/uniqueduplicate.html

但是这意味着使用visual lisp

gr.Rlx

Stefan BMR · 发表于 2022-7-5 18:58:36

试试这个

copy

(defun group (l f / round o r)
 
 (defun round (a f)
   (cond
     ((numberp a)
      (if (equal a (fix a)) a (* (atof (rtos (/ a f) 2 0)) f))
      )
     ((and a (listp a)) (mapcar '(lambda (x) (round x f)) a))
     )
   )
 
 (setq l (mapcar
           (function
             (lambda (x)
               (cons
                 (car x)
                 (vl-sort
                   (vl-sort
                     (vl-sort
                       (cdr x)
                       '(lambda (a b) (< (caddr a) (caddr b)))
                     )
                     '(lambda (a b) (< (cadr a) (cadr b)))
                   )
                   '(lambda (a b) (< (car a) (car b)))
                 )
               )
             )
           )
           (if (/= f 0.0) (round l f) l)
         )
       )
 (foreach x (reverse l)
   (if
     (setq o (vl-some '(lambda (a) (if (vl-every 'equal (car a) (cdr x)) a)) r))
     (setq r (subst (list (car o) (cons (car x) (cadr o))) o r))
     (setq r (cons (list (cdr x) (list (car x))) r))
     )
   )
 (vl-remove-if '(lambda (a) (< (length a) 2)) (mapcar 'cadr r))
 )

copy

_$ (setq l '((1 (-5.68434e-014 1.13687e-013 0.0) (-5.68434e-014 ...
_$ (group l 0)      -> nil
_$ (group l 1)      -> ((1 2 4 5) (6 9 10))
_$ (group l 0.0001) -> ((1 2 4 5) (6 9))
_$ (setq l '((1 (1 2 0) (3 4 0) (5 6 0)) (2 (3 4 ...
_$ (group l 0)      -> ((1 2 4) (3 6))
_$ (group l 1)      -> ((1 2 4) (3 6))

rlx · 发表于 2022-7-5 19:05:13

哇，令人印象深刻：-）

Lee Mac · 发表于 2022-7-5 19:09:32

以下是Stefan方法的优化：

copy

(defun sort2 ( lst fuz / rtn tmp )
   (foreach itm lst
       (setq tmp
           (vl-sort (cdr itm)
              '(lambda ( a b )
                   (if (equal (car a) (car b))
                       (if (equal (cadr a) (cadr b))
                           (< (caddr a) (caddr b))
                           (< (cadr  a) (cadr  b))
                       )
                       (< (car a) (car b))
                   )
               )
           )
       )
       (or (vl-some
              '(lambda ( x )
                   (if (vl-every '(lambda ( a b ) (equal a b fuz)) (last x) tmp)
                       (setq rtn  (subst (cons (car itm) x) x rtn))
                   )
               )
               rtn
           )
           (setq rtn (cons (list (car itm) tmp) rtn))
       )
   )
   (reverse (vl-remove-if-not 'cdr (mapcar '(lambda ( x ) (cdr (reverse x))) rtn)))
)

比较：

copy

_$ (benchmark '((group lst 0.01) (sort2 lst 0.01)))
Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):
   (SORT2 LST 0.01).....1513 / 2.51 <fastest>
   (GROUP LST 0.01).....3791 / 1 <slowest>

rlx · 发表于 2022-7-5 19:17:10

我就知道你无法抗拒李哈哈

Quest for Peace · 发表于 2022-7-5 19:21:28

你们太棒了，非常感谢。有时，我不得不进入我十多年前自己编写的程序，我找到了一页长的例程，我可以用自己的lambda和mapcar表达式在几行中完成。都是从你们身上学到的。现在更容易了，更准确了，我的调试时间也更短了。大约一周前，我意识到我需要这个常规，我整个星期都在害怕它。我昨天就开始了。我想在我开始之前我就已经精神崩溃了。非常感谢大家，效果很好。