mahuan1279
发表于 2020-3-2 20:31:26
对于数据都是整数,还可以用曼哈顿距离来处理。
mahuan1279
发表于 2020-3-2 21:50:20
本帖最后由 mahuan1279 于 2020-3-2 21:55 编辑
_$ (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
发表于 2020-3-2 22:28:57
本帖最后由 mahuan1279 于 2020-3-2 22:30 编辑
递归的效率太低了,数据量少的还勉强凑合运行。如果数值都是整形,可以添加左下角和右上角两个辅助点(最后结果删除掉),要求最长递增序列,可以看成左下角点沿着向右向上方式到达右上角点且经过最多点的路径方式。,可以从右上角点开始逆向寻找,找距它曼哈顿距离(横坐标之差与纵坐标之差的和)最小的点,若只有一个点,就从此点接着往下找;如果有多个点的曼哈顿距离相等,就都保留,每个点接着往下找……直到到达左下角那个点。所有路径就是经过点数最多的路径,然后去掉首尾辅助点,就得到所有最长递增序列。
mahuan1279
发表于 2020-3-3 03:30:46
本帖最后由 mahuan1279 于 2020-3-3 11:21 编辑
_$ (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))
)
)
(iffflst
(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
发表于 2020-3-3 03:43:09
正反两方向最长路径合并好像也不是全部最长路径,夹在中间的一些点可能也在最长路径上,而这些路径没有算进来。
mahuan1279
发表于 2020-3-3 08:37:59
本帖最后由 mahuan1279 于 2020-3-3 10:59 编辑
经过仔细论证后,可以得出正反两方向的合并集(去重)就是所有始末路径上经过点数最多的路径,也就是所有最长递增序列集合!!!
mahuan1279
发表于 2020-3-3 21:34:19
如果只找到一个解就可以的话,复杂度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)
_$
mahuan1279
发表于 2020-3-3 23:26:13
还可以精简到极致
(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)
)
Bao_lai
发表于 2020-3-3 23:38:35
Mahuan专业!
mahuan1279
发表于 2020-3-4 00:47:23
Bao_lai 发表于 2020-3-3 23:38
Mahuan专业!
其实我是业余的。