找最长升序序列算法问题

tryhi

有一个乱序不重复的整数表，怎样删除其中的某些数，使剩下的数组成一个最长的升序序列。
举几个例子，假设有个tt函数
例子1：(tt '(5 1 3 2 0 8 9 10 4 6 7)) ;>>返回 '(1 2 4 6 7)
例子2：(tt '(3 5 4 6 10 0 1 9 8 2 7)) ;>>返回 '(3 4 6 7)
例子3：(tt '(0 1 9 10 2 3 4 5 6 8 7)) ;>>返回 '(0 1 2 3 4 5 6 7)
例子4：(tt '(6 1 0 3 11 10 4 5 8 9 2 7)) ;>> '(0 3 4 5 8 9)
上面所有例子有多个解，解出任意一个均满足要求，总之，找出一个元素最多的升序序列


这道题目乍一看觉得很简单，然后想了两个小时后发现，似乎………不简单
那么这个tt函数如何写，大家有兴趣可讨论下

mahuan1279

_$ (defun f(lst)
(defun ff(kk)
  (setq nk kk klst nil)
  (while (> nk 0)
    (setq nk (- nk 1))
    (setq klst (cons nk klst))
  )
)
(defun mh(p1 p2)
   (+ (- (car p1) (car p2)) (- (cadr p1) (cadr p2)))
)
(defun nerlst (ptlst pklst)
   ;;;(setq ptlst '((3 4)(5 6)) pnlst  '((1 6)(2 5) (4 3)(5 9)))
   (setq pt (last ptlst))
   (setq pmlst (vl-remove nil (mapcar '(lambda (x) (if (or (>= (car x) (car pt)) (>= (cadr x) (cadr pt))) nil x)) pklst)))
  (if pmlst   
          (progn
          (setq vlst (vl-sort (mapcar '(lambda (x) (cons (mh pt x) x)) pmlst) '(lambda (ea eb) (< (car ea) (car eb)))))
          (setq j 0 valst nil nj (- (length vlst) (length (vl-remove nil (mapcar '(lambda (x) (if (= (car x) (car (car vlst))) nil x)) vlst)))))
         (while (< j nj)
            (setq valst (cons (nth j vlst) valst))
                (setq j (+ j 1))
              )
           (setq va (mapcar '(lambda (x) (reverse (cons (cdr x) (reverse ptlst)))) valst))
           )
      (setq va ptlst)
        )
)
(setq n0 (- (apply 'min lst) 1) n1 (+ (apply 'max lst) 1))
(setq newlst (cons n0 (reverse (cons n1 (reverse lst)))))
(setq pplst (reverse (mapcar 'list (ff (length newlst)) newlst)))
(setq pttlst (list (list (car pplst))) pt0  (last pplst) flag t bestlst nil)
(while flag
     (setq fflst nil)
     (foreach en pttlst
             (if (equal (last en) pt0)
                     (setq bestlst (cons en bestlst))
                 (setq fflst (append (nerlst en pplst) fflst))
                  )
         )
         (if  fflst
                 (setq pttlst fflst)
             (setq flag nil)
          )
)
(setq best (mapcar '(lambda (x) (mapcar '(lambda (y) (cadr y)) x)) bestlst))
(setq len_max (apply 'max (mapcar 'length best)))
(setq best (vl-remove nil (mapcar '(lambda (x) (if (= len_max (length x)) x nil)) best)))
(setq best (mapcar '(lambda (x) (cdr (reverse (cdr x)))) best))
)
F
_$ (setq lst '(5 1 3 2 0 8 9 10 4 6 7))
(5 1 3 2 0 8 9 10 4 6 7)
_$ (f lst)
((1 2 8 9 10) (1 3 8 9 10) (1 2 4 6 7) (1 3 4 6 7))
_$
_$ (setq lst '(3 5 4 6 10 0 1 9 8 2))
(3 5 4 6 10 0 1 9 8 2)
_$ (f lst)
((3 4 6 8) (3 5 6 8) (3 4 6 9) (3 5 6 9))

所得的结果是最长递增序列，但不一定是全部。因为找路径过程是从右上角往左下角找，每次找的点是离右上角最近的点（忽略了离它远的点）。所以要找到所有最长路径，还要考虑从左下角向右上角找路径，正反两方向的最长路径合并才是所有最长路径。

mahuan1279

_$ (defun dp(lst)
  (if (= 1 (length lst))
      (setq valst lst)
          (if (= 2 (length lst))
              (progn
                     (if (> (car lst) (cadr lst))
                             (setq valst (cdr lst))
                                 (setq valst lst)
                          )
                   )
          (if (> (last lst) (last (dp (reverse (cdr (reverse lst))))))
                      (setq valst (reverse (cons (last lst) (reverse (dp (reverse (cdr (reverse lst))))))))
                          (if (>= (length (dp (vl-remove nil (mapcar '(lambda (x) (if (> x (last lst)) nil x)) lst))))
                                 (length (dp (reverse (cdr (reverse lst)))))
                                   )
                                  (setq valst (dp (vl-remove nil (mapcar '(lambda (x) (if (> x (last lst)) nil x)) lst))))
                  (setq valst (dp (reverse (cdr (reverse lst)))))
               )
                   )
            )
   )
)
DP
_$ (dp '(5 1 3 2 0 8 9 10 4 6 7))
(1 2 4 6 7)
_$ (dp '(3 5 4 6 10 0 1 9 8 2 7))
(0 1 2 7)
_$ (dp '(0 1 9 10 2 3 4 5 6 8 7))
(0 1 2 3 4 5 6 7)
_$ (dp '(6 1 0 3 11 10 4 5 8 9 2 7))
(0 3 4 5 8 9)
_$

mahuan1279

tryhi 发表于 2020-3-1 15:13
看来还是递归适合解决这种问题，只是当数量达到100个时，运行时间要达到几十秒甚至超过1分钟，而当数量为 ...

(defun tt(lst)
(defun f1 (plst j num)
   (setq ij -1)
   (setq plst (mapcar '(lambda (x) (if (= (setq ij (+ ij 1)) j) num x)) plst))
)
(setq n (length lst) i 0 ans 0 vlst '(nil))
(repeat n (setq vlst (cons nil vlst)))
(while (< i n)
    (setq l 0 r ans)
        (while (< l r)
          (setq mid (/ (+ l r) 2))
          (if (<= (nth mid vlst) (nth i lst))
               (setq l (+ mid 1))
                   (setq r mid)
           )
        )
    (setq vlst (f1 vlst l (nth i lst)))
        (if (= l ans) (setq ans (+ ans 1)))
        (setq i (+ i 1))
)
(setq vlst (reverse (vl-remove nil vlst)) alst (reverse lst) blst (list (+ 1 (car vlst))))
(while  vlst
     (if (and (>= (car alst) (car vlst)) (<= (car alst) (car blst)))
             (progn
             (setq blst (cons (car alst) blst))
             (setq vlst (cdr vlst))
                         (setq alst (cdr alst))
                 )
                 (setq alst (cdr alst))
         )
)
(reverse (cdr (reverse blst)))
)

_$ (tt '(0 0 2 4 1 5 1 3 1 2 0 8 9 10 4 6))
(0 0 1 1 1 2 8 9 10)
_$  (tt '(0 0 2 4 1 5 1 3 1 2 0 8 9 10 4 6 7))
(0 0 1 1 1 2 4 6 7)
_$ (tt '(5 1 3 2 0 8 9 10 4 6 7))
(1 2 4 6 7)
_$ (tt '(3 5 4 6 10 0 1 9 8 2 7))
(0 1 2 7)
_$ (tt '(0 1 9 10 2 3 4 5 6 8 7))
(0 1 2 3 4 5 6 7)
_$ (tt '(6 1 0 3 11 10 4 5 8 9 2 7))
(0 3 4 5 8 9)
_$

nzl1116

1. (defun tt (aLst / rLst Int0 Int1 Int2 tLst)
   
2.   (setq rLst nil)
   
3.   (setq Int0 0)
   
4.   (while (setq Int1 (car aLst))
   
5.     (setq aLst (cdr aLst))
   
6.     (setq Int2 (length (setq tLst (ttt Int1 aLst))))
   
7.     (if (> Int2 Int0)
   
8.       (setq rLst tLst Int0 Int2)
   
9.     )
   
10.   )
    
11.   rLst
    
12. )
    
13. (defun ttt (Int Lst / rLst Int0 Int1 Int2 tLst)
    
14.   (setq rLst nil)
    
15.   (setq Int0 0)
    
16.   (setq Int1 (length Lst))
    
17.   (while (> Int1 Int0)
    
18.     (setq Int2 (length (setq tLst (tttt Int Lst))))
    
19.     (setq Lst (cdr Lst))
    
20.     (setq Int1 (1- Int1))
    
21.     (if (> Int2 Int0)
    
22.       (setq rLst tLst Int0 Int2)
    
23.     )
    
24.   )
    
25.   rLst
    
26. )
    
27. (defun tttt (Int Lst / rLst tLst Int0 Int1 Int2)
    
28.   (setq rLst nil)
    
29.   (setq Int0 0)
    
30.   (setq Int1 (length Lst))
    
31.   (while (> Int1 Int0)
    
32.     (setq Int2 (length (setq tLst (ttttt Int Lst))))
    
33.     (if (> Int2 Int0)
    
34.       (setq rLst tLst Int0 Int2)
    
35.     )
    
36.     (setq Lst (cdr Lst))
    
37.     (setq Int1 (1- Int1))
    
38.   )
    
39.   rLst
    
40. )
    
41. (defun ttttt (Int Lst)
    
42.   (cond
    
43.     ((not Lst) (list Int))
    
44.     ((> (car Lst) Int) (cons Int (ttttt (car Lst) (cdr Lst))))
    
45.     (T (ttttt Int (cdr Lst)))
    
46.   )
    
47. )

(defun tt (aLst / rLst Int0 Int1 Int2 tLst)<br />   (setq rLst nil)<br />   (setq Int0 0)<br />   (while (setq Int1 (car aLst))<br />     (setq aLst (cdr aLst))<br />     (setq Int2 (length (setq tLst (ttt Int1 aLst))))<br />     (if (> Int2 Int0)<br />       (setq rLst tLst Int0 Int2)<br />     )<br />   )<br />   rLst<br /> )<br /> (defun ttt (Int Lst / rLst Int0 Int1 Int2 tLst)<br />   (setq rLst nil)<br />   (setq Int0 0)<br />   (setq Int1 (length Lst))<br />   (while (> Int1 Int0)<br />     (setq Int2 (length (setq tLst (tttt Int Lst))))<br />     (setq Lst (cdr Lst))<br />     (setq Int1 (1- Int1))<br />     (if (> Int2 Int0)<br />       (setq rLst tLst Int0 Int2)<br />     )<br />   )<br />   rLst<br /> )<br /> (defun tttt (Int Lst / rLst tLst Int0 Int1 Int2)<br />   (setq rLst nil)<br />   (setq Int0 0)<br />   (setq Int1 (length Lst))<br />   (while (> Int1 Int0)<br />     (setq Int2 (length (setq tLst (ttttt Int Lst))))<br />     (if (> Int2 Int0)<br />       (setq rLst tLst Int0 Int2)<br />     )<br />     (setq Lst (cdr Lst))<br />     (setq Int1 (1- Int1))<br />   )<br />   rLst<br /> )<br /> (defun ttttt (Int Lst)<br />   (cond<br />     ((not Lst) (list Int))<br />     ((> (car Lst) Int) (cons Int (ttttt (car Lst) (cdr Lst))))<br />     (T (ttttt Int (cdr Lst)))<br />   )<br /> )

tryhi

nzl1116 发表于 2020-3-1 12:11

看来还是递归适合解决这种问题，只是当数量达到100个时，运行时间要达到几十秒甚至超过1分钟，而当数量为500个，将会卡机，我挂了6个小时都没求出来

llsheng_73

这个应该需要有一个预估，对于一个给定的乱序不重复表，如果确定了某个元素它是这个表第几大及其位置，表里边比它更大并且位置比它靠后的数量是固定的，也就是说从这个位置开始，它后续升序个数不会超过一个固定数值，一般情况只会更小。。。通过这个预估，应该可以减少很多重复次数

zixuan203344

大海，换语言吧，咱们早期那一帮玩lisp的，现在基本上都玩C#了……
我私人群里有你，也不见你说话……

tryhi

zixuan203344 发表于 2020-3-1 19:47
大海，换语言吧，咱们早期那一帮玩lisp的，现在基本上都玩C#了……
我私人群里有你，也不见你说话……

啊，什么群，C#学不来啊

mahuan1279

可以用动态规划来解决。

mahuan1279

将数据从左到右建立一棵二叉树，父节点值大于左子节点值，小于右子节点值。左子树的最长距离就是最长递增序列长度。
有些不对，每次末尾添加一个数值后，前面的二叉树内部结构要进行调整，不是简单的作为左子树或右子树。

mahuan1279

dp(lst)=(if (> (last lst) (last dp(reverse (cdr (reverse lst))) ))
                dp(reverse (cdr (reverse lst)))+(last lst),
                dp(reverse (cdr (reverse lst)))
}

mahuan1279

_$ (defun dp(lst)
  (if (= 1 (length lst))
      (setq valst lst)
          (if (= 2 (length lst))
              (progn
                     (if (> (car lst) (cadr lst))
                             (setq valst (cdr lst))
                                 (setq valst lst)
                          )
                   )
          (if (> (last lst) (last (dp (reverse (cdr (reverse lst))))))
                       (setq valst (reverse (cons (last lst) (reverse (dp (reverse (cdr (reverse lst))))))))
               (setq valst (dp (reverse (cdr (reverse lst)))))
          )
            )
   )
)
DP
_$  (dp '(3))
(3)
_$ (dp '(3 2))
(2)
_$  (dp '(3 2 4))
(2 4)
_$ (dp '(3 2 4 5 1 6 9 2))
(2 4 5 6 9)
_$ (dp '(5 1 3 2 0 8 9 10 4 6 7))
(1 3 8 9 10)
_$ (dp '(3 5 4 6 10 0 1 9 8 2 7))
(3 5 6 10)
_$  (dp '(0 1 9 10 2 3 4 5 6 8 7))
(0 1 9 10)
_$


看来还要比较一个dp(vl-remove nil  (mapcar '(lambda (x) if (> x (last lst)) nil x))  lst)))如果增长序列同长度，保留末尾数值小的那一个序列。