曼哈顿距离的应用

aimisiyou

问题来源于trihi的找最长升序序列算法问题：
有一个乱序不重复的整数表，怎样删除其中的某些数，使剩下的数组成一个最长的升序序列。
举几个例子，假设有个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)
上面所有例子有多个解，解出任意一个均满足要求，总之，找出一个元素最多的升序序列。

aimisiyou

根据动态规划很容易得到递归。
_$ (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 '(0 1 9 10 2 3 4 5 6 8 7))
(0 1 2 3 4 5 6 7)
_$ (dp '(3 5 4 6 10 0 1 9 8 2 7))
(0 1 2 7)
_$
_$ (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)
_$ (dp '(6 1 0 3 11 10 4 5 8 9 2 7 16 11 10 13 21 20 24 25 ))
(0 3 4 5 8 9 10 13 20 24 25)

aimisiyou

递归的效率太低了，数据量少的还勉强凑合运行。如果数值都是整形，可以添加左下角和右上角两个辅助点（最后结果删除掉），要求最长递增序列，可以看成左下角点沿着向右向上方式到达右上角点且经过最多点的路径方式。，可以从右上角点开始逆向寻找，找距它曼哈顿距离(横坐标之差与纵坐标之差的和)最小的点，若只有一个点，就从此点接着往下找；如果有多个点的曼哈顿距离相等，就都保留，每个点接着往下找……直到到达左下角那个点。所有路径就是经过点数最多的路径，然后去掉首尾辅助点，就得到所有最长递增序列。

Urings

从小到大排序，删除重复
这就是你要的最长序列？

aimisiyou

Urings 发表于 2020-3-2 22:52
从小到大排序，删除重复
这就是你要的最长序列？

从无重复数据且数据都是整数的lst中按顺序挑选（可以跳着选，但前后关系不能变）一些数据组成序列，使得序列是递增的且所含数据个数最多。

Urings

aimisiyou 发表于 2020-3-2 22:57
从无重复数据且数据都是整数的lst中按顺序挑选（可以跳着选，但前后关系不能变）一些数据组成序列，使得 ...

现在看明白了，这就烧脑了
你已经写出来了，厉害

aimisiyou

Urings 发表于 2020-3-2 23:04
现在看明白了，这就烧脑了
你已经写出来了，厉害

递归很容易写，但效率低不适用。

aimisiyou

_$ (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))

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

aimisiyou

正反两方向最长路径合并好像也不是全部最长路径，夹在中间的一些点可能也在最长路径上，而这些路径没有算进来。仔细论证后，可以得出正反两方向的合并集（去重）就是所有始末路径上经过点数最多的路径，也就是所有最长递增序列集合。

鬼子兵

算法是基础，学习啦！

aimisiyou

如果只找到一个解就可以的话，复杂度O（n）.
_$ (defun tt (lst)
(defun ff(kk)
   (setq nk kk klst nil)
   (while (> nk 0)(setq nk (- nk 1))(setq klst (cons nk klst)))
  )
(setq vlst (mapcar 'list (ff (length lst)) lst) plst nil)
(while vlst
     (setq pt (cdr (car (vl-sort (mapcar '(lambda (x) (cons (+ (car x) (cadr x)) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))))     
         (setq vlst (vl-remove nil (mapcar '(lambda (x) (if (or (<= (car x) (car pt)) (<= (cadr x) (cadr pt))) nil x)) vlst)))
    (setq plst (cons pt plst))
  )
(setq plst (reverse (mapcar 'cadr plst)))
)
TT
_$ (tt '(3 5 4 6 11 2 10 1 8 9 7))
(3 5 6 11)
_$ (tt '(5 1 3 2 0 8 9 10 4 6 7))
(1 3 4 6 7)
_$ (tt '(3 5 4 6 10 0 1 9 8 2 7))
(3 5 6 10)
_$ (tt '(0 1 9 10 2 3 4 5 6 8 7))
(0 1 2 3 4 5 6 8)
_$ (tt '(6 1 0 3 11 10 4 5 8 9 2 7))
(1 3 4 5 8 9)
_$

aimisiyou

还可以精简到极致
(defun tt(lst)
  (setq vlst nil)
  (while lst
       (setq pt (cadr (car (vl-sort (mapcar '(lambda (x) (cons (+ x (vl-position x lst)) (list x))) lst) '(lambda (ea eb) (<  (car ea) (car eb)))))))
      (setq vlst (cons pt vlst))
      (setq lst (vl-remove nil (mapcar '(lambda (x) (if (<= x pt) nil x)) lst)))
   )
   (reverse vlst)
)

aimisiyou

aimisiyou 发表于 2020-3-3 23:23
还可以精简到极致
(defun tt(lst)
  (setq vlst nil)

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

程序存在错误。

zjj237558536

学习到了，牛牛牛

zjj237558536

学习到了，牛牛牛