如何按要求对表进行归类

fan_zh_mjtd · 发表于 2016-1-29 13:19:56

如图
需要对表中的数据进行归类，表中每个元长度一样，排列不一样，有什么办法找出该一定规律的元素呢

fan_zh_mjtd · 发表于 2016-2-18 12:57:35

有没有大神在线啊

ll_j · 发表于 2016-2-18 13:23:51

看不懂要求，看上去都一样。

ivde · 发表于 2016-2-18 17:28:22

本帖最后由 ivde 于 2016-2-18 17:41 编辑

感觉递归代码简化些

(defun tt (lst / conslst first nlst tf1 tf2)
(defun conslst (lst)
(cons (last lst) (reverse (cdr (reverse lst))))
)
(while lst
(if nlst
(progn
(setq
nlst (mapcar '(lambda (x / tf first llast tf1 tf2)
(setq tf t)
(while tf
(setq first (conslst (car x))
llast (conslst (last x))
)
(if (setq
tf1 (vl-member-if
'(lambda (x)
(equal first x 0.00001)
)
lst
)
)
(setq x (cons first x)
lst (vl-remove first lst)
)
)
(if (setq
tf2 (vl-member-if
'(lambda (x)
(equal llast x 0.00001)
)
lst
)
)
(setq x (reverse (cons llast (reverse x)))
lst (vl-remove llast lst)
)
)
(if (and (not tf1) (not tf2))
(setq tf nil)
)
)
x
)
nlst
)
)
(if lst
(progn
(setq first (conslst (car lst)))
(if (vl-member-if
'(lambda (x) (equal first x 0.00001))
(cdr lst)
)
(setq nlst (cons (list (car lst) first) nlst)
lst (vl-remove first lst)
)
)
(setq lst (cdr lst))
)
)
)
(progn
(setq first (conslst (car lst))) ;_back
(if (setq tf1 (vl-member-if
'(lambda (x) (equal first x 0.00001))
(cdr lst)
)
)
(setq nlst (cons (list (car lst) first) nlst)
lst (vl-remove first lst)
)
)
(setq second (append (cdar lst)
(list (caar lst))
)
) ;_front
(if (setq tf2 (vl-member-if
'(lambda (x) (equal second x 0.00001))
lst
)
)
(if nlst
(setq nlst (list (cons second (car nlst)))
lst (vl-remove second lst)
)
(setq nlst (cons (list (car lst) second) nlst)
lst (vl-remove second lst)
)
)
)
(if (and (not tf1) (not tf2))
(setq lst (cdr lst))
)
)
)
)
nlst
)

(defun tt (lst / conslst first nlst tf1 tf2) 
  (defun conslst (lst) 
    (cons (last lst) (reverse (cdr (reverse lst)))) 
  ) 
  (while lst 
    (if        nlst 
      (progn 
        (setq 
          nlst (mapcar '(lambda        (x / tf first llast tf1 tf2) 
                          (setq tf t) 
                          (while tf 
                            (setq first        (conslst (car x)) 
                                  llast        (conslst (last x)) 
                            ) 
                            (if        (setq 
                                  tf1 (vl-member-if 
                                        '(lambda (x) 
                                           (equal first x 0.00001) 
                                         ) 
                                        lst 
                                      ) 
                                ) 
                              (setq x        (cons first x) 
                                    lst        (vl-remove first lst) 
                              ) 
                            ) 
                            (if        (setq 
                                  tf2 (vl-member-if 
                                        '(lambda (x) 
                                           (equal llast x 0.00001) 
                                         ) 
                                        lst 
                                      ) 
                                ) 
                              (setq x        (reverse (cons llast (reverse x))) 
                                    lst        (vl-remove llast lst) 
                              ) 
                            ) 
                            (if        (and (not tf1) (not tf2)) 
                              (setq tf nil) 
                            ) 
                          ) 
                          x 
                        ) 
                       nlst 
               ) 
        ) 
        (if lst 
          (progn 
            (setq first (conslst (car lst))) 
            (if        (vl-member-if 
                  '(lambda (x) (equal first x 0.00001)) 
                  (cdr lst) 
                ) 
              (setq nlst (cons (list (car lst) first) nlst) 
                    lst         (vl-remove first lst) 
              ) 
            ) 
            (setq lst (cdr lst)) 
          ) 
        ) 
      ) 
      (progn 
        (setq first (conslst (car lst))) ;_back 
        (if (setq tf1 (vl-member-if 
                        '(lambda (x) (equal first x 0.00001)) 
                        (cdr lst) 
                      ) 
            ) 
          (setq        nlst (cons (list (car lst) first) nlst) 
                lst  (vl-remove first lst) 
          ) 
        ) 
        (setq second (append (cdar lst) 
                             (list (caar lst)) 
                     ) 
        ) ;_front 
        (if (setq tf2 (vl-member-if 
                        '(lambda (x) (equal second x 0.00001)) 
                        lst 
                      ) 
            ) 
          (if nlst 
            (setq nlst (list (cons second (car nlst))) 
                  lst  (vl-remove second lst) 
            ) 
            (setq nlst (cons (list (car lst) second) nlst) 
                  lst  (vl-remove second lst) 
            ) 
          ) 
        ) 
        (if (and (not tf1) (not tf2)) 
          (setq lst (cdr lst)) 
        ) 
      ) 
    ) 
  ) 
  nlst 
)

_$ (tt '((1 2 3 4) (2 1 3 4) (1 4 3 2) (4 3 1 2) (3 4 2 1) (3 4 1 2) (4 1 2 3) (3 4 1 2)))
(((1 2 3 4) (4 1 2 3) (3 4 1 2)))
_$

fan_zh_mjtd · 发表于 2016-2-19 09:55:15

从来没研究过递归，学习了

账号		自动登录	找回密码
密码			注册

[讨论] 如何按要求对表进行归类

本帖子中包含更多资源

点评

浏览过的版块