[推荐]：AutoCAD, VisualLISP与分形几何学

e2002 · 发表于 2002-4-30 09:23:33

分形几何: 这是一门匪夷所思的精深科学....

太美妙了

liver · 发表于 2002-4-30 09:48:26

程序如下,图上桔红圆圈处是第一个出错点

[FONT=courier new]
(defun c:cc (/ cshape pt1 pt2 ang oldvar)
(defun cshape (p1 p2 ang)
(if (> (distance p1 p2) 10.0)
(progn
(setq p3 (polar p1
(+ ang (angle p1 p2))
(* (distance p1 p2) (abs (/ 0.5 (cos ang))))
)
)
(command "pline" p1 p3 p2 pause "")
(cshape p1 p3 ang)
(cshape p3 p2 ang)
)
) p3 ;end if
) ;end defun cshape
;;main
(setq p1 (getpoint "\n first point"))
(setq
p2 (getpoint p1 "\n second point(最终收敛值为10,请注意长度):")
)
(setq ang (getangle "\n angle(not equal 60.0 degree: "))
(setq oldvar (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq p3 (cshape p1 p2 ang))
(setvar "OSMODE" oldvar)
(princ)
) ;end defun c:cc
[CODE]
[FONT=courier new][/FONT]

[FONT=courier new] 
(defun c:cc (/ cshape pt1 pt2 ang oldvar) 
 
  (defun cshape        (p1 p2 ang) 
    (if        (> (distance p1 p2) 10.0) 
      (progn 
        (setq p3 (polar        p1 
                        (+ ang (angle p1 p2)) 
                        (* (distance p1 p2) (abs (/ 0.5 (cos ang)))) 
                 ) 
        ) 
        (command "pline" p1 p3 p2 pause "") 
        (cshape p1 p3 ang) 
        (cshape p3 p2 ang) 
      ) 
    )        p3                                ;end if 
  )                                        ;end defun cshape 
 
  ;;main 
  (setq p1 (getpoint "\n first point")) 
  (setq 
    p2        (getpoint p1 "\n second point(最终收敛值为10,请注意长度):") 
  ) 
  (setq ang (getangle "\n angle(not equal 60.0 degree: ")) 
  (setq oldvar (getvar "OSMODE")) 
  (setvar "OSMODE" 0) 
  (setq p3 (cshape p1 p2 ang)) 
  (setvar "OSMODE" oldvar) 
  (princ) 
)                                        ;end defun c:cc 
 
[CODE] 
[FONT=courier new][/FONT]

liver · 发表于 2002-4-30 09:50:39

可以避免这样的错误,但是运行不到底,我再跟踪看看

名稱:  C Shape碎形
作者:  林峰田
輸入:  以滑鼠輸入二個點
主要變數:
tobe 待生成頂點之線段端點座標串列
d 最小點距,點陣解析度(結束要件)
主要原理:
1.給予二點,利用polar指令,計算以上述二點為底之直角等腰三角形之頂點.
2.以tobe串列紀錄待計算之底邊
3.subcshape為遞迴函式,以d及tobe為結束條件    |;

(defun subcshape(p1 p2)
(setq ang (+ (/ PI 4) (angle p1 p2)))
(setq d (/ (* (sqrt 2) (distance p1 p2)) 2))
(princ "d = ")
(princ d)
(princ "\n")
(setq p3 (polar p1 ang d))
(command "point" p3 "")
(if (> d 1.0)
(progn
(setq tobe (cons p2 tobe))
(setq tobe (cons p3 tobe))
(setq tobe (cons p3 tobe))
(setq tobe (cons p1 tobe))
)
)
(princ "length of tobe = ")
(princ (length tobe))
;(princ "\n")

(if (> (length tobe) 0)
(progn
(setq a (car tobe))
(setq b (cadr tobe))
(setq tobe (cddr tobe))

(princ " ;length of tobe2 = ")
(princ (length tobe))
(princ "\n")

(subcshape a b)

)
)
)

(defun c:Cshape()

     (gc);garbage collection
     (command "erase" "all" "");clean the screen
(command "pdmode" "0" "");set point style

(setq tobe '())
(setq p1 (getpoint "enter the first point:  "))
(setq p2 (getpoint "enter the second point:  "))
(command "point" p1 "")
(command "point" p2 "")
(subcshape p1 p2)

)

XDSoft · 发表于 2002-4-30 09:53:04

最初由 liver 发布
[B]程序如下,图上桔红圆圈处是第一个出错点

[(defun c:cc (/ cshape pt1 pt2 ang oldvar)

(defun cshape (p1 p2 ang)
(if (> (distance p1 p2) 10.0)
(progn
(setq p... [/B]

(cshape p1 p3 ang)
这个地方你没有改成 (setq p3 (cshape p1 p3 ang)) 啊？

liver · 发表于 2002-4-30 10:06:03

出错点还在原来的位置,后来我把下面一句也改成
(setq p3 (cshape p3 p2 ang))
还是原来的样子,现在程序如下:

(defun c:cc (/ cshape pt1 pt2 ang oldvar)

  (defun cshape (p1 p2 ang)
(if (> (distance p1 p2) 10.0)
   (progn
(setq p3 (polar p1
(+ ang (angle p1 p2))
(* (distance p1 p2) (abs (/ 0.5 (cos ang))))
   )
)
(command "pline" p1 p3 p2 pause "")
(setq p3 (cshape p1 p3 ang))
(setq p3 (cshape p3 p2 ang))
   )
) p3 ;end if
  ) ;end defun cshape

  ;;main
  (setq p1 (getpoint "\n first point"))
  (setq
p2 (getpoint p1 "\n second point(最终收敛值为10,请注意长度):")
  )
  (setq ang (getangle "\n angle(not equal 60.0 degree: "))
  (setq oldvar (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq p3 (cshape p1 p2 ang))
  (setvar "OSMODE" oldvar)
  (princ)
) ;end defun c:cc

最后出来的是这个结果:

liver · 发表于 2002-4-30 10:14:11

他是把所有计算出来的值放在集合里面再一一取出
这样大概能够确保一层递归结束後返回正确的值

但是居然会断在中间,初始两点距离为11时还是对的,到12就错了
左边distance=11,右边distance=12

liver · 发表于 2002-4-30 10:16:37

我要走了,byebye

谢谢各位:)

XDSoft · 发表于 2002-4-30 10:19:23

下面图是我的运行结果，没有错误啊

程序代码是：

[FONT=courier new]
(defun c:cc (/ cshape pt1 pt2 ang oldvar)
(defun cshape (p1 p2 ang)
(if (> (distance p1 p2) 10.0)
(progn
(setq p3 (polar p1 (+ ang (angle p1 p2)) (* (distance p1 p2)
(abs (/ 0.5
(cos ang)
)
)
)
)
)
(command "pline" p1 p3 p2 "")
(setq p3 (cshape p1 p3 ang))
(cshape p3 p2 ang)
p3
)
) ; end if
) ; end defun cshape
;; main
(setq p1 (getpoint "\n first point"))
(setq p2 (getpoint p1 "\n second point(最终收敛值为10,请注意长度):"))
(setq ang (getangle "\n angle(not equal 60.0 degree: "))
(setq oldvar (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq p3 (cshape p1 p2 ang))
(setvar "OSMODE" oldvar)
(princ)
)
[/FONT]

[FONT=courier new] 
(defun c:cc (/ cshape pt1 pt2 ang oldvar) 
 
  (defun cshape (p1 p2 ang) 
    (if (> (distance p1 p2) 10.0) 
      (progn 
        (setq p3 (polar p1 (+ ang (angle p1 p2)) (* (distance p1 p2) 
                                                    (abs (/ 0.5 
                                                            (cos ang) 
                                                         ) 
                                                    ) 
                                                 ) 
                 ) 
        ) 
        (command "pline" p1 p3 p2 "") 
        (setq p3 (cshape p1 p3 ang)) 
        (cshape p3 p2 ang) 
        p3 
      ) 
    )                                       ; end if 
 
  )                                       ; end defun cshape 
 
  ;; main 
  (setq p1 (getpoint "\n first point")) 
  (setq p2 (getpoint p1 "\n second point(最终收敛值为10,请注意长度):")) 
  (setq ang (getangle "\n angle(not equal 60.0 degree: ")) 
  (setq oldvar (getvar "OSMODE")) 
  (setvar "OSMODE" 0) 
  (setq p3 (cshape p1 p2 ang)) 
  (setvar "OSMODE" oldvar) 
  (princ) 
) 
[/FONT]

XDSoft · 发表于 2002-4-30 10:27:10

角度是70度的情况：

XDSoft · 发表于 2002-4-30 10:36:11

LISP的“递归”肯定是没有问题的，任何一个语言的递归中的变量的变化也不能影响到外部。

因为“递归”使用的是“栈”，是个临时存储区，递归的时候，要保存现场，即把当前的变量等值入栈。

递归完成后，要恢复现场和清除递归时候的内部的变量使用的“栈”，返回后，所有递归前的变量保持不变。所以递归时候的变量P3始终是外面的值，递归不能修改它。

解决方法就是使用函数的返回值或者用个“堆”中的全局变量表储存递过内部的变化。

在其他语言中，比如C,C++，除了用函数返回值外，如果需要多个修改的变量，那么还可以使用指针，传递给函数的是变量内存的地址，这也是C灵活的，最高效的地方。
可惜的是LISP没有“指针”传递，所以一个变量变化可以用“返回值”来保存。多个，就要建立个全局表。

liver · 发表于 2002-4-30 23:36:14

你现在的程序只完成了一半都不到,请看:
螺旋线旋到底还要出来呢,
我的天,在网上讨论问题太困难了
大概你并没有去abbs看我的原贴

XDSoft · 发表于 2002-4-30 23:39:23

在LISP中，递归要返回多个值，可以使用LISP的全局表来模拟入栈和出栈的操作。

在递归函数里面把要保存的数据LIST后，CONS加入到全局表头（入栈）。在递归外面用CAR使用保存的数据，然后CDR全局表，弹出栈顶元素。

这样就可以不管递归多少层，都可以用一个很小的全局表来保存我们需要的数据了。

XDSoft · 发表于 2002-4-30 23:45:02

最初由 liver 发布
[B]你现在的程序只完成了一半都不到,请看:
螺旋线旋到底还要出来呢,
我的天,在网上讨论问题太困难了
大概你并没有去abbs看我的原贴 [/B]

ABBS我很少去，还没有仔细看全部程序的算法，我只是看你昨天讨论那个地方图有问题，讨论递归，我只是看了我画的图和你不同，就贴出来了。你说程序执行到这个地方，接着还要画什么地方？是程序的那行代码执行完能画到这个地方？

如果不能完成全部的图，就在考虑考虑算法。用递归肯定没有问题的，这个问题用递归解决是最方便的。

liver · 发表于 2002-4-30 23:55:39

cchape是不断由两个点p1, p2推出第三点p3,但是一旦推出第三点p3就出来两组新变量(p1 p3)和(p3 p2),分别由(p1 p3)和(p3 p2)推出自己的第三点,于是形成一个很复杂的图案.你现在的程序只是在不断进行(p1 p3)的计算而(p3 p2)由于出错而终止,所以出现的只是一个旋转的图案,而且应该有出错信息,不是正常程序结束时的返回值,

我运行了一下出错信息显示的是:

Command: error: bad argument type
(DISTANCE P1 P2)
(> (DISTANCE P1 P2) 10.0)
....

XDSoft · 发表于 2002-4-30 23:59:31

最初由 liver 发布
[B]cchape是不断由两个点p1, p2推出第三点p3,但是一旦推出第三点p3就出来两组新变量(p1 p3)和(p3 p2),分别由(p1 p3)和(p3 p2)推出自己的第三点,于是形成一个很复杂的图案.你现在的程序只是在不断进行(p1 p3)的计算而(p3... [/B]

没有出错信息啊，在我这里，可能我用的是2002。

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

[推荐]：AutoCAD, VisualLISP与分形几何学

好像还是不对,出错情况差不多

书上给出的代码

Re: 好像还是不对,出错情况差不多

嗯,我改了一下

我看了一下林峰田的程序

今天到此结束

xd,正确的图形应该是这样的

Re: xd,正确的图形应该是这样的

是的,林峰田正是这么解决的

Re: 是的,林峰田正是这么解决的