删除X值一样，Y值除最大值外的表

炫翔

初级版本 表中只有一种重复的X值

(SETQ LST '((1 9)(5.5 1)(2 8)(5.5 2)(5.5 4)(5.5 3)))

返回--->((1 9)(2 8)(5.5 4))

st788796

先排序      

炫翔

st788796 发表于 2014-3-15 16:09
先排序

表中5.5只是个例子，也许是1.1  0.6等数据

/db_自贡黄明儒_

炫翔 发表于 2014-3-15 16:10
表中5.5只是个例子，也许是1.1  0.6等数据

2楼说得对，先排序,后面就好干了

炫翔

/db_自贡黄明儒_ 发表于 2014-3-15 16:34
2楼说得对，先排序,后面就好干了

排序后 ，判断第一个与第二个 X相同 相同就归表 ，不同就放弃 依次类推?

st788796

炫翔 发表于 2014-3-15 16:36
排序后 ，判断第一个与第二个 X相同 相同就归表 ，不同就放弃 依次类推?

看看groupbyindex，X做索引分组，对分组后的排序，在排序后的表里删，最后合并表

炫翔

(DEFUN C:XX( / e1 e2 lst lst1 x)
(SETQ LST '((1 9)(5.5 1)(2 8)(5.5 2)(5.5 4)(5.5 3)))
(SETQ LST(vl-sort lst (function (lambda (e1 e2) (> (CAR e1) (CAR e2))))))
(SETQ LST(XD::List:GroupByIndex LST 0))
(foreach X LST
(IF(> (length X) 3)
  (SETQ LST1 (CONS(LIST(CAR X) (CAR(vl-sort (CDR X) (function (lambda (e1 e2) (> e1 e1))))))LST1))
  (SETQ LST1 (CONS X LST1))
  )
)
LST1
)

炫翔

根据大家的思路 随手写了下，

st788796

炫翔 发表于 2014-3-15 16:56
根据大家的思路 随手写了下，

1. (defun tt (lst /)
   
2.   (setq        lst (mapcar '(lambda (x)
   
3.                        (list (float (car x)) x)
   
4.                      )
   
5.                     lst
   
6.             )
   
7.         lst (XD::List:GroupByIndex lst 1e-5)
   
8.         lst (mapcar '(lambda (x)
   
9.                        (vl-sort        x
   
10.                                 '(lambda (x1 x2)
    
11.                                    (> (cadr x1) (cadr x2))
    
12.                                  )
    
13.                        )
    
14.                      )
    
15.                     (mapcar 'cdr lst)
    
16.             )
    
17.         lst (mapcar 'car lst)
    
18.   )
    
19. )

(defun tt (lst /)<br />   (setq        lst (mapcar '(lambda (x)<br />                        (list (float (car x)) x)<br />                      )<br />                     lst<br />             )<br />         lst (XD::List:GroupByIndex lst 1e-5)<br />         lst (mapcar '(lambda (x)<br />                        (vl-sort        x<br />                                 '(lambda (x1 x2)<br />                                    (> (cadr x1) (cadr x2))<br />                                  )<br />                        )<br />                      )<br />                     (mapcar 'cdr lst)<br />             )<br />         lst (mapcar 'car lst)<br />   )<br /> )

炫翔

st788796 发表于 2014-3-15 17:41

分组前需要先转实数， 有待升级

st788796

炫翔 发表于 2014-3-15 17:52
分组前需要先转实数， 有待升级

不转也可以啊！

/db_自贡黄明儒_

1. ;;(SETQ LST '((1 9) (5.5 1) (2 8) (5.5 2) (5.5 4) (5.5 3)))
   
2. ;;(w1 lst)=>((1 9) (2 8) (5.5 4))
   
3. (defun w2 (LST /  CAR1  L2)
   
4.   (foreach x  (HH:ssPts:Sort LST "XY" 0)
   
5.     (cond ((not (member (car x) car1))
   
6.      (setq car1 (cons (car x) car1))
   
7.      (setq L2 (cons x L2))
   
8.     )
   
9.     )
   
10.   )
    
11.   L2
    
12. )
    

;;(SETQ LST '((1 9) (5.5 1) (2 8) (5.5 2) (5.5 4) (5.5 3)))<br /> ;;(w1 lst)=>((1 9) (2 8) (5.5 4))<br /> (defun w2 (LST /  CAR1  L2)<br />   (foreach x  (HH:ssPts:Sort LST "XY" 0)<br />     (cond ((not (member (car x) car1))<br />      (setq car1 (cons (car x) car1))<br />      (setq L2 (cons x L2))<br />     )<br />     )<br />   )<br />   L2<br /> )<br />

;;(SETQ LST '((1 9) (5.5 1) (2 8) (5.5 2) (5.5 4) (5.5 3)))
;;(w1 lst)=>((1 9) (2 8) (5.5 4))
(defun w1 (LST / AA CAR1 L1 L2)  
  (setq L1 (HH:ssPts:Sort LST "XY" 0));http://bbs.xdcad.net/thread-670556-1-1.html
  (while (setq aa (car L1))   
    (setq L1 (cdr L1))
    (if        (not (member (car aa) car1))
      (progn
        (setq car1 (cons (car aa) car1))
        (setq L2 (cons aa L2))
      )
    )
  )
  L2
)

XDSoft

/db_自贡黄明儒_ 发表于 2014-3-19 13:37
;;(SETQ LST '((1 9) (5.5 1) (2 8) (5.5 2) (5.5 4) (5.5 3)))
;;(w1 lst)=>((1 9) (2 8) (5.5 4))
(def ...

HH:ssPts:Sort 这个函数呢？

/db_自贡黄明儒_

XDSoft 发表于 2014-3-19 15:02
HH:ssPts:Sort 这个函数呢？

老大，及时补充了（亡羊补牢）{:soso_e113:}