[求助]：多点连线路径最短

superxzg

在平面上有若干点，坐标已知，若从一点连线，经过所有点，最短路径如何获得？

fengluoguo

carrot1983 发表于 2007-1-29 20:58
我也来占个位子。这个贴子有没有应用的意义呢？
答案：没有。。。。
有没有研究的意义呢？

商旅问题本就是一个实际问题需要模型来解决，怎么就没意义呢

carrot1983

我也来占个位子。这个贴子有没有应用的意义呢？
答案：没有。。。。
有没有研究的意义呢？
答案：没有。。。。
就算有研究的意义，没有应用的意义，也是没意义。

zml84

经过半天的思索，完成了如下代码，
经过测试，基本满足1楼楼主的要求。

<br>
为了便于表达，注释内容较多，见谅！
[PHP]
;;;===================================================================
;;;搜索平面上点的连线最短路径                                         
;;;                                                                  
;;;                                                                  
;;;  参  数：a---待排序的数据表（不包含起终点）。类型：表            
;;;        pt0---起点坐标，类型：点对表                              
;;;        pt1---终点坐标，类型：点对表                              
;;;  返回值：从起点的终点依次连接的点位（不包含起终点）。类型：表     
;;;  日  期：zml84 于2007-01-29                                       
;;;===================================================================
(defun min-line        (a pt0 pt1 / b c pt3)
    (if        (= (length a) 1)
        a
        (progn
            ;;第1步
            ;;UCS设置，建立当前用户坐标系
            (command "_ucs"
                     "n"
                     "3"
                     pt0
                     pt1
                     (polar pt0
                            (+ (angle pt0 pt1) (* pi 0.5))
                            10
                     )
            )
            ;;将点位坐标数据，由世界坐标系转换为用户坐标系
            (setq b (mapcar '(lambda (pt) (trans pt 0 1)) a))
            ;;第2步
            ;;根据X坐标进行排序。
            (setq b
                     (vl-sort b
                              (function
                                  (lambda (e1 e2)
                                      (< (car e1) (car e2))
                                  )
                              )
                     )
            )

            ;;第3步.提取路径点，放入变量pt3中
            ;;目的是：在排序后的表b中，找到X坐标最接近0的的负值的点位，
            ;;                        （若无负坐标，则找X最小的点位）。
            ;;
            ;;判断第一个点是否满足条件
            (if        (> (car (car b)) 0)
                (progn
                    (setq pt3 (car b)
                          c   (cdr b)
                    )
                )
                ;;判断最后一个点是否满足条件
                (if (<= (car (last b)) 0)
                    (setq pt3 (last b)
                          c   (car (reverse b))
                    )
                    ;;从第二个点开始向后搜索
                    (progn
                        (setq n          1
                              pt3 '()
                              c          '()
                        )
                        (repeat        (- (length b) 1) ;循环次数，坐标个数-1
                            (if        (and (> (car (nth n b)) 0)
                                     (<= (car (nth (1- n) b)) 0)
                                )
                                (setq pt3 (nth (1- n) b)
                                )
                                (setq c (cons (nth (1- n) b) c))
                            )
                            (setq n (1+ n))
                        ) ;结束repeat
                        (setq c (cons (last b) c))
                    )
                )
            ) ;结束if

            ;;第4步
            ;;将点位坐标数据，由用户坐标系转换为世界坐标系
            (setq pt3 (trans pt3 1 0)
                  c   (mapcar '(lambda (pt) (trans pt 1 0)) c)
            )
            ;;恢复UCS设置
            (command "_ucs" "")

            ;;第5步.递归求解
            (cons pt3 (min-line c pt3 pt1))
        ) ;结束progn
    )

)        ;结束defun
;;;===================================================================
[/PHP]
测试代码如下：
[PHP]
;;|
;;测试1
(defun c:t1 ()
    (princ "\n测试1>>>\n点位坐标：\n")
    (princ (setq lst1 (list
                          '(1.0000 8.0000)  '(5.0000 5.0000)
                          '(3.0000 3.0000)  '(10.0000 5.0000)
                          '(7.0000 13.0000) '(12.0000 1.0000)
                         )
           )
    )
    (princ "\n起终点：\n")
    (princ (setq pt0 '(4 4)))
    (princ (setq pt1 '(10 10)))
    (princ "\n结果：\n")
    (princ (min-line lst1 pt0 pt1))
    (princ)
)
|        ;                                        ;
;;;===================================================================
;;|
;;测试2
(defun c:t2 ()
    (princ "\n测试2>>>\n")
    (setq lst2 '()
          pt   nil
    )
    (if        (setq pt (getpoint "\n请点取点位坐标："))
        (progn
            (setq lst2 (cons pt lst2))
            (while (/= nil
                       (setq pt (getpoint pt "\n请点取点位坐标："))
                   )
                (setq lst2 (cons pt lst2))
                (princ pt)
            )
            (if        (setq pt0 (getpoint "\n请点取起点位置："))
                (if (setq pt1 (getpoint pt0 "\n请点取终点位置："))
                    (progn
                        (princ pt0)
                        (princ pt1)
                        (princ "\n结果：\n")
                        (princ (setq d (min-line lst2 pt0 pt1)))
                        ;;绘制路径
                        (command "_pline")
                        (foreach n d (command n))
                        (command "")
                        (command "_line" pt0 pt1 "")
                    )
                )
            )
        )
    )
    (princ)
)
|        ;                                        ;
;;;===================================================================
[/PHP]
以上代码，希望大家多提意见，共同进步。

highflybird

呵呵，这恐怕属于计算几何的问题了，一个很有名的问题:TSP问题，又叫货郎担问题,或旅行商问题，到网上查找相关方面的资料和算法吧。

taner

1.先取任意一点(p1),求与之最近的点(p2).
2.再求点表内(除去p1的点)与p2最近的点.
3.如此类推.

superxzg

货担郎问题要求回到起点，但是这个问题不用回到起点，三楼的方法我也想过，但是，如果发现有多个点距离相等，怎么办？而且，可能这样做计算量极大，可能为指数级，所以请教各位有什么更好的解法。

舟自横

看看高手的絕招

(defun z_timer (/ stime h m s)
  (if (not zhf_time_dot)
    (setq zhf_time_dot (getvar "date") h nil)
    (progn
      (setq stime (getvar "date"))
      (setq stime (- stime zhf_time_dot))
      (setq stime (* 86400.0 (- stime (fix stime))))
      (setq h (fix (/ stime 3600)))
      (setq m (fix (/ (- stime (* h 3600)) 60)))
      (setq s (fix (- stime (* m 60) (* h 3600))))
      (setq zhf_time_dot nil)
      
      (strcat (if (> h 0)
        (strcat (rtos h 2 0) "小时")""
          )
          (if (> m 0)
        (strcat (rtos m 2 0) "分钟")""
          )
          (rtos s 2 0)
          "秒"
      )
      )
    )
  )
(defun show (lst stop)
  (mapcar '(lambda (x) (redraw (vlax-vla-object->ename x) 3))
      lst
  )
  (if stop (progn(getpoint)
  (mapcar '(lambda (x) (redraw (vlax-vla-object->ename x) 4))
      lst
  )))
)
(defun ss2lst (ss vla / re e)
  (if ss
    (repeat (setq n (sslength ss))
      (if vla
    (setq e (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    (setq e (ssname ss (setq n (1- n))))
      )
      (setq re (append re (list e)))
    )
  )
  re
)
(defun getss@ (p)
  (ssget "c"
     p
     (polar p (/ pi 4) (/ (getvar "viewsize") 5000))
     '((0 . "arc,ellipse,*line"))
  )
)
(defun getconnect (e)
  (vl-remove e
         (append (ss2lst (getss@ (vlax-curve-getStartpoint e)) t)
             (ss2lst (getss@ (vlax-curve-getEndpoint e)) t)
         )
  )
)
(defun remove:same (lst / re)
  (foreach n lst
    (if    (member n re)
      ()
      (setq re (append re (list re)))
    )
  )
  re
)
(defun get:len (e)
  (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
(defun main (pt1 pt2 show / ss sse line path paths shortlen shortlst ss1 shortest)
  (setq count 0)
  (setq    ss  (ss2lst (getss@ pt1) t)
    sse (ss2lst (getss@ pt2) t)
  )
  (if (and ss sse)
    (progn      
      (setq passed-ss ss
        path-ss   (mapcar '(lambda (x) (list x)) ss)
        dist-ss   (mapcar '(lambda (x) (list x (get:len x))) ss)
        dist-ss   (vl-sort dist-ss '(lambda (a b) (< (cadr a) (cadr b))))
        complete  nil
           
      )
      (mapcar '(lambda (x)
         (if (member x sse)
           (setq complete (append complete (list(list x (get:len x)))))
         )
           )
          ss
      )
      (if complete
    (setq complete (vl-sort    complete
                '(lambda (a b) (< (cadr a) (cadr b)))
               )
          shortest (cadar complete)
    )
      )
      
      (if (and shortest (= shortest (distance pt1 pt2)))
    (progn
    (list (cadar complete) (list(caar complete)))
    )
    (progn
      (while (and dist-ss (> (length sse) (length complete)))
    (setq now     (car dist-ss)
          dist-ss (cdr dist-ss)
    )
    ;;;_____________________________
    ;;;_____________________________
    ;;;_____________________________
    (if show
      (progn
        (vlax-put (car now) 'color (+ 21 (* 10 (rem count 20))))
        (vla-update (car now))
      )
    )
    ;;;_____________________________
    ;;;_____________________________
    ;;;_____________________________
      (if (member (car now) sse)
        (progn
          (setq complete (append complete (list now)))
          ;;;__________________________________________________
          ;;;到达终点后剔出所有距离已经超出最小路由长度的未完成方向
          (setq complete
             (vl-sort complete
                  '(lambda (a b) (< (cadr a) (cadr b)))
             )
            shortest (cadar complete)
            dist-ss (mapcar '(lambda(x)(if (< (cadr x) shortest) x nil)) dist-ss)
            dist-ss (vl-remove nil dist-ss)
          )
          ;;;__________________________________________________
          ;;;__________________________________________________
        )
        (progn
          (setq count (1+ count))
          (setq ss (getconnect (car now)))
          (mapcar '(lambda (x) (setq ss (vl-remove x ss)))
              passed-ss
          )
          (setq passed-ss (append passed-ss ss)
            path-ss   (append
                path-ss
                (mapcar '(lambda (x) (list x (car now))) ss)
                  )
            dist-ss   (append
                dist-ss
                (mapcar
                  '(lambda (x)
                     (if (or (not shortest) (< (get:len x) shortest))(list x (+ (cadr now) (get:len x))))
                   )
                  ss
                )
                  )
            dist-ss (vl-remove nil dist-ss)
            dist-ss   (vl-sort dist-ss
                       '(lambda (a b) (< (cadr a) (cadr b)))
                  )
          )
      )
    )
    )
      ;;;_____________________________
      ;;;_____________________________
      ;;;_____________________________
    (if show
      (progn
        (mapcar '(lambda (x) (vlax-put x 'color 0)) passed-ss)
        (mapcar '(lambda (x) (vla-update x)) passed-ss)
      )
    )
      ;;;_____________________________
      ;;;_____________________________
      ;;;_____________________________
      (if complete
    (progn
      (setq
        complete (vl-sort complete
                  '(lambda (a b) (< (cadr a) (cadr b)))
             )
        n (car complete)
         
      )      
      (setq    len (cadr n)
        n   (car n)
      )
      (while n
        (setq ss1 (append ss1 (list n)))
        (setq n (cadr (assoc n path-ss)))
      )      
      (list len (reverse ss1 ))
    )
    nil
      )
    )))
    nil
  )   
)
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
(defun c:tt (/ pt1 pt2 ss1 ss2 complete)
  (redraw)
  (setq    pt1 (getpoint "\n起点:")
    pt2 (getpoint "\n终点:")
  )
  (mapcar
    '(lambda (pt)
       (grdraw (polar pt (* pi 0.25) (/ (getvar "viewsize") 40))
           (polar pt (* pi -0.75) (/ (getvar "viewsize") 40))
           1
       )
       (grdraw (polar pt (* pi 0.75) (/ (getvar "viewsize") 40))
           (polar pt (* pi -0.25) (/ (getvar "viewsize") 40))
           1
       )
     )
    (list pt1 pt2)
  )
  (setq zhf_time_dot nil)
  (z_timer)
  (setq ss1 (main pt1 pt2 t))   
  (if ss1
    (progn
      (setq ss2 (ssadd))
      (mapcar '(lambda (x)
         (setq ss2 (ssadd (vlax-vla-object->ename x) ss2))
           )
          (cadr ss1)
      )
      (princ (strcat "\n虚线显示最短路线, 共需" (itoa (sslength ss2)) "步,总长度为:"
             (rtos (car ss1))
             "  历时:"
             (z_timer)
         )
      )
      (show (cadr ss1) nil)
      
    )
    (princ (strcat "\n两点间没有可连通路径,历时:" (z_timer)))
  )   
  (princ)
)
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
(princ "\n寻找连接两点的最近路线,by wkai @ xdcad ")
(princ "\n前提 所有路线只在交点处交叉,起点和终点选择路线的端点.")
(princ "\n核心函数 (main 起点 终点 是否显示搜索过程) ")
(princ "\n返回值   (最短路线长度  最短路线途径实体表)")
(princ "\n测试命令:tt\n")
(princ)

superxzg

好久没来，让楼上的高手久等了，多谢，我先研究研究。有问题再讨论

aeo

这么复杂的问题不要在lisp里搞.

用google "最短路径",搞的我很头大

[php]
1、第一次遇到比自己笨的人

法国伟大的文学家、思想家、革命家孟德斯鸠教导我们说，身为 Google 工程师的最大好处就是 — 你总能在第一时间知道自己离“笨得离谱”还有多远。老孟的话得这么理解：“笨”其实是一种美德，远比“厚道”更易让人神往，尤其是在遇到了一个比你更笨的人之后。

有一次，我笨得忘记了该如何在一个复杂的有向图中找出两点之间的最短路径。身边的一位工程师很郑重地告诉我说：“你知道吗？解决这个问题有两种方法，聪明人的方法和笨人的方法。聪明人的方法是：照着算法教科书的讲解，实现那个时间复杂度相当大的名叫嘀嘀哒嘀哒的最短路径算法。笨人的方法时间复杂度最低：找一堆线头来，按照有向图的结构连成一张网，然后一手拿一个顶点，向两边一抻，中间拉直了的那条路就是最短路径呀。”

“哇噻！笨是一种多么伟大的品格呀！”我眩晕得说不出话来。于是，我们这两个自认为足够笨的工程师足足花了两周的时间，用计算机程序模拟了不同材质的细线在北半球的重力条件下相互连接并在两个反方向作用力的影响下向两边伸展的整个物理过程，然后以此为基础实现了时间复杂度最小的最短路径算法。——瞧，在 Google，什么东西都可以自己动手实现，什么东西也都可以推陈出新，我们的杰出表现就是最好的证明。[/php]

zml84

最初由 aeo 发布
[PHP]
用计算机程序模拟了不同材质的细线在北半球的重力条件下相互连接并在两个反方向作用力的影响下向两边伸展的整个物理过程，然后以此为基础实现了时间复杂度最小的最短路径算法。[/PHP][/B]

<br>
建立平面力学模型，进行受力分析，采用有限元数值求解的思想是解决问题的一个方法。
但却不能说它“时间复杂度最小“。
我们知道，这个以索为链接建立起来的几何模型在力学分析求解过程中存在几何非线性问题。
采用增量模拟是非常耗费机时的。
<br>
恐怕，遍历的方法也比google中的方法更简洁些。

highflybird

最短路径---这个问题太复杂了，关于它的算法讨论可以用google或者百度找找看。
这个问题的C语言的源码能找到，但要找到lisp的源码很难很难，更别说autolisp了。
[php]
据统计，目前提出的此类最短路径的算法大约有17种。F.Benjamin Zhan等人对其中的15种进行了测试，结果显示有3种效果比较好，它们分别是：TQQ（graph growth with two queues）、DKA (the Dijkstra's algorithm implemented with approximate buckets) 以及 DKD (the Dijkstra?s algorithm implemented with double buckets )，这些算法的具体内容可以参见文献［1］。其中TQQ算法的基础是图增长理论，较适合于计算单源点到其他所有点间的最短距离；后两种算法则是基于Dijkstra的算法，更适合于计算两点间的最短路径问题［1］。总体来说，这些算法采用的数据结构及其实现方法由于受到当时计算机硬件发展水平的限制，将空间存储问题放到了一个很重要的位置，以牺牲适当的时间效率来换取空间节省。目前，空间存储问题已不是要考虑的主要问题，因此有必要对已有的算法重新进行考虑并进行改进，可以用空间换时间来提高最短路径算法的效率。
[/php]
如果有高手能找到时间复杂度低于n^2以下的，估计可以登世界级论文了。

雨箭风刀

是求最短路径,不是求最短连线

zml84

最初由 雨箭风刀 发布
[B]是求最短路径,不是求最短连线 [/B]

将起始点坐标加入结果表的首尾，即是路径。（1楼楼主在要求中特别说明了[B]“经过所有点”[/B]）
<br>

最初由 carrot1983 发布
[B]我也来占个位子。这个贴子有没有应用的意义呢？
答案：没有。。。。
有没有研究的意义呢？
答案：没有。。。。
就算有研究的意义，没有应用的意义，也是没意义。[/B]

楼上的话似乎不大中肯。
这是思维的游戏，是对结构的练习。
按照楼上的想法，编写从1加到100的代码，
也是毫无意义的。

xyz518mm

我认为题目应该的内容应加上终点座标
这样才可以方便找出由起点到终点所经过各点的最短路径
不知道提问者是不是这样想呢

xdcad9819

http://bbs.xdcad.net/forum.php?m ... p;extra=#pid3721310 这个有个帖子，是沿着图纸事先确定的路径自动画线，有兴趣的朋友去看看，