Gauss-Legendre积分法

阿然

学习lisp这么久以来，深感不是不能理解Lisp的各种函数使用方法，而是算法方面的知识缺失更加困扰我，痛定思痛，努力向各前辈学习各种算法，下面是刚学习的Gauss-legendre积分法，请各位指教，谢谢

1. ;;;5阶Gauss-Legendre积分法
   
2. ;;; a    下限
   
3. ;;; b    上限
   
4. ;;; eps  精度
   
5. ;;; 其中函数fun为自定义被积函数计算式
   
6. 
   
7. (defun gauss (a b eps / m i j s p ep h aa bb w x g tk c)
   
8.   (setq  tk '(-0.9061798459 -0.5384693101 0.0 0.5384693101 0.9061798459)
   
9.   c '(0.2369268851 0.4786286705 0.5688888889 0.4786286705
   
10.       0.2369268851)
    
11.   )
    
12.   (setq  m  1
    
13.   h  (- b a)
    
14.   s  (abs (* 0.001 h))
    
15.   p  1.0e+35
    
16.   ep (+ eps 1.0)
    
17.   )
    
18.   (while (and (>= ep eps)
    
19.         (> (abs h) s)
    
20.    )
    
21.     (setq g 0.0
    
22.     i 1
    
23.     )
    
24.     (while (<= i m)
    
25.       (setq aa (+ a (* (- i 1) h))
    
26.       bb (+ a (* i h))
    
27.       w  0.0
    
28.       )
    
29.       (setq j 0)
    
30.       (repeat 5
    
31.   (setq x  (/ (+ (* (- bb aa) (nth j tk)) bb aa) 2.0)
    
32.         w  (+ w (* (fun x) (nth j c)))
    
33.   )
    
34.   (setq j (1+ j))
    
35.       )
    
36.       (setq g (+ g w)
    
37.       i (1+ i)
    
38.       )
    
39.     )
    
40.     (setq g  (* g h 0.5)
    
41.     ep (/ (abs (- g p)) (+ 1.0 (abs g)))
    
42.     p  g
    
43.     m  (1+ m)
    
44.     h  (/ (- b a) m)
    
45.     )
    
46.   )
    
47.   g
    
48. )
    
49. (defun fun (x)
    
50.   (setq y (+ (* x x) (sin x)))
    
51. )

;;;5阶Gauss-Legendre积分法<br /> ;;; a    下限<br /> ;;; b    上限<br /> ;;; eps  精度<br /> ;;; 其中函数fun为自定义被积函数计算式<br /> <br /> (defun gauss (a b eps / m i j s p ep h aa bb w x g tk c)<br />   (setq  tk '(-0.9061798459 -0.5384693101 0.0 0.5384693101 0.9061798459)<br />   c '(0.2369268851 0.4786286705 0.5688888889 0.4786286705<br />       0.2369268851)<br />   )<br />   (setq  m  1<br />   h  (- b a)<br />   s  (abs (* 0.001 h))<br />   p  1.0e+35<br />   ep (+ eps 1.0)<br />   )<br />   (while (and (>= ep eps)<br />         (> (abs h) s)<br />    )<br />     (setq g 0.0<br />     i 1<br />     )<br />     (while (<= i m)<br />       (setq aa (+ a (* (- i 1) h))<br />       bb (+ a (* i h))<br />       w  0.0<br />       )<br />       (setq j 0)<br />       (repeat 5<br />   (setq x  (/ (+ (* (- bb aa) (nth j tk)) bb aa) 2.0)<br />         w  (+ w (* (fun x) (nth j c)))<br />   )<br />   (setq j (1+ j))<br />       )<br />       (setq g (+ g w)<br />       i (1+ i)<br />       )<br />     )<br />     (setq g  (* g h 0.5)<br />     ep (/ (abs (- g p)) (+ 1.0 (abs g)))<br />     p  g<br />     m  (1+ m)<br />     h  (/ (- b a) m)<br />     )<br />   )<br />   g<br /> )<br /> (defun fun (x)<br />   (setq y (+ (* x x) (sin x)))<br /> )

lpx530115

大佬，你好，这个http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100248（批量相同组合图元关联修改）的帖子里的完整程序，可以提供一下吗，冲压模具上比较有用？谢谢。