求高手简写代码

stoyer

以下代码实际上是对根据list1对list2进行排序, 只写了3个表项示例, 麻烦高手简写一下>><

(cond ((= (nth 0 list1) "JZZD") (setq a1 (nth 1 list2)))
      ((= (nth 0 list1) "HZZD") (setq a1 (nth 3 list2)))
          ((= (nth 0 list1) "FZZD") (setq a1 (nth 2 list2)))
)
(cond ((= (nth 1 list1) "JZZD") (setq a2 (nth 1 list2)))
      ((= (nth 1 list1) "HZZD") (setq a2 (nth 3 list2)))
          ((= (nth 1 list1) "FZZD") (setq a2 (nth 2 list2)))
)
(cond ((= (nth 2 list1) "JZZD") (setq a3 (nth 1 list2)))
      ((= (nth 2 list1) "HZZD") (setq a3 (nth 3 list2)))
          ((= (nth 2 list1) "FZZD") (setq a3 (nth 2 list2)))
)

补充:
L2里面的值不固定, 但顺序是固定的; L1的值是固定的,但顺序不固定(L1相当于表头名称).

77077

牢固版主的代码，希望对你有用~

1. (vl-sort '(("赵" ("赵老大" "赵老二")) ("孙" ("孙老大" "孙老二")) ("李" ("李老大" "李老二")) ("钱" ("钱老大" "钱老二")))
   
2.          '(lambda (a b) (< (VL-POSITION (car a) '("赵" "钱" "孙" "李")) (VL-POSITION (car b) '("赵" "钱" "孙" "李")))))

复制代码

77077

将L1按照L2的顺序排列~~~
(setq l1 '(("赵" ("赵老大" "赵老二")) ("孙" ("孙老大" "孙老二")) ("李" ("李老大" "李老二")) ("钱" ("钱老大" "钱老二")))
        l2 '("赵" "钱" "孙" "李")
      )
(mapcar
         '(lambda(x)
            (vl-remove-if-not
                    '(lambda(y)(=(car y) x))
                    l1
                    )
                 )
   l2
)

stoyer

谢了! 我试试先, mapcar/lambda这些看着就头巨大...

stoyer

77077 发表于 2015-7-27 16:17
将L1按照L2的顺序排列~~~
(setq l1 '(("赵" ("赵老大" "赵老二")) ("孙" ("孙老大" "孙老二")) ("李" ("李 ...

谢谢77.
这个好像不行, 我的L2里面的值不是固定的, 但顺序是固定的. L1的值是固定的,但顺序不固定(L1相当于表头名称).

77077

你要把表发出来撒

nzl1116

(mapcar '(lambda (x) (cdr (assoc x (mapcar 'cons '("JZZD" "FZZD" "HZZD") (cdr List2))))) List1)

stoyer

77077 发表于 2015-7-27 16:37
你要把表发出来撒

;正确List1,这个是正确顺序的,实际上是一个块多个属性,由于实际操作的时候被炸开了再重新做成块,所以就乱了.
("JZZD" "HZZD" "GZZD" "ZDHX" "KHX" "DSX")

;List2, 这个顺序固定的.
("23.5" "64.3" "A" "GB" "GT" "GH")
....

edata

大概意思是L1的属性标记，L2是属性值。
现在要将L2的值对应上L1，是吗。

edata

1. ;;;根据cond得出
   
2. ;;;(= "JZZD" (nth 1 l2)) => 0
   
3. ;;;(= "HZZD" (nth 3 l2)) => 2
   
4. ;;;(= "FZZD" (nth 2 l2)) => 1
   
5. (defun c:tt(/ l3 l1 l2 l4 lst x y)
   
6. (setq l3 '(("JZZD" . 0)("FZZD" . 1)("HZZD" . 2)))
   
7. (setq l1 '("FZZD" "JZZD" "HZZD"))
   
8. (setq l2 '("jz" "fz" "hz"))
   
9. (setq l4 l1 lst '())
   
10. (while(setq a(car l4))
    
11.   (setq lst(cons (cdr(assoc a l3)) lst))
    
12.   (setq l4(cdr l4))
    
13.   )
    
14. (setq lst (reverse lst))
    
15.   ;返回 (1 0 2)
    
16. (setq l5(mapcar '(lambda(x y)(cons x y)) lst l2))
    
17.   ;返回 ((1 . "jz") (0 . "fz") (2 . "hz"))
    
18. (setq l6(vl-sort l5 '(lambda(x y)(< (car x)(car y)))))
    
19.   ;返回 ((0 . "fz") (1 . "jz") (2 . "hz"))
    
20.   (mapcar 'cdr l6)
    
21.   ;返回 ("fz" "jz" "hz")
    
22. 
    
23.   ;辅值a1 a2 a3
    
24.   (mapcar 'set '(a1 a2 a3) '("fz" "jz" "hz"))
    
25.   ;返回
    
26. ;;;("fz" "jz" "hz")
    
27. ;;;_$ a1
    
28. ;;;"fz"
    
29. ;;;_$ a2
    
30. ;;;"jz"
    
31. ;;;_$ a3
    
32. ;;;"hz"
    
33. ;;;_$
    
34.   )
    

;;;根据cond得出<br /> ;;;(= "JZZD" (nth 1 l2)) => 0<br /> ;;;(= "HZZD" (nth 3 l2)) => 2<br /> ;;;(= "FZZD" (nth 2 l2)) => 1<br /> (defun c:tt(/ l3 l1 l2 l4 lst x y)<br /> (setq l3 '(("JZZD" . 0)("FZZD" . 1)("HZZD" . 2)))<br /> (setq l1 '("FZZD" "JZZD" "HZZD"))<br /> (setq l2 '("jz" "fz" "hz"))<br /> (setq l4 l1 lst '())<br /> (while(setq a(car l4))<br />   (setq lst(cons (cdr(assoc a l3)) lst))<br />   (setq l4(cdr l4))<br />   )<br /> (setq lst (reverse lst))<br />   ;返回 (1 0 2)<br /> (setq l5(mapcar '(lambda(x y)(cons x y)) lst l2))<br />   ;返回 ((1 . "jz") (0 . "fz") (2 . "hz"))<br /> (setq l6(vl-sort l5 '(lambda(x y)(< (car x)(car y)))))<br />   ;返回 ((0 . "fz") (1 . "jz") (2 . "hz"))<br />   (mapcar 'cdr l6)<br />   ;返回 ("fz" "jz" "hz")<br /> <br />   ;辅值a1 a2 a3<br />   (mapcar 'set '(a1 a2 a3) '("fz" "jz" "hz"))<br />   ;返回<br /> ;;;("fz" "jz" "hz")<br /> ;;;_$ a1<br /> ;;;"fz"<br /> ;;;_$ a2<br /> ;;;"jz"<br /> ;;;_$ a3<br /> ;;;"hz"<br /> ;;;_$ <br />   )<br />