pi.lsp

此位计算Pi和e的autolisp程序。 能输出它们小数后几百位甚至上万位的精度。

;;;highflybird    2008.4.20 Haikou
(defun c:test (/ digit n Result t1 t2 time str)
  (setq digit 10000)                            ;每次输出位数
  (initget 7)   				;非零非负非空
  (setq n (getint "\n请输入精度<不超过16000>:"));输入精度
  (if (> n 16000)                               
    (alert "输入超过16000!")
    (progn  
      (setq t1     (getvar "TDUSRTIMER"))       ;开始计时
      (setq Result (CalPi digit n))             ;计算Pi值
      (setq t2     (getvar "TDUSRTIMER"))       ;计时结束
      (setq time   (* 86400 (- t2 t1)))
      ;;(foreach n (reverse Result)
	;;(setq str (itoa n))
	;;(while (< (strlen str) 4)
	  ;;(setq str (strcat "0" str))
	;;)
	;;(princ str)
      ;;)	
      ;;(setq Result (substr Result 2 n))         ;只精确到指定位数
      ;;(setq Result (strcat "3." Result))        ;加个小数点
      ;;(princ Result)                            ;打印结果
      (princ "\n共耗时<秒>:")                           
      (princ time)                              ;和所耗时间
    )
  )    
  (princ)                                       ;退出
)
;;;计算函数
(defun CalPi (digit n / b c d e f g h r s x)
  (setq file (open "c:\\Pi.txt" "W"))
  (setq c (/ (1+ n) (/ (log 2) (log 10))))  	;需要迭代的次数
  (setq c (fix c))                      	;转化为整数
  (setq	e 0 r "")                               ;存储结果的字符串赋空值
  (setq h (/ digit 5))                          ;从小数后算起
  (repeat c                                     
    (setq f (cons h f))                         ;初始余数为10000 * 2 / 10
  )
  (repeat (1+ (/ n 4))                          ;重复1+ 800/4 = 201次
    (setq d 0)                                  ;每次末位小数为0
    (setq g (+ c c))                            ;
    (setq b c)
    (setq x nil)
    (while (> b 0)
      (setq d (* d b))
      (setq b (1- b))
      (setq d (+ d (* (car f) digit)))
      (setq f (cdr f))
      (setq g (1- g))
      (setq x (cons (rem d g) x))
      (setq d (/ d g))
      (setq g (1- g))
    )
    (setq f (reverse x))
    (repeat 13
      (setq f (cdr f))
    )
    (setq s (+ e (/ d digit)))
    ;;(setq r (cons s r))
    (setq s (itoa s))
    (while (< (strlen s) 4)
      (setq s (strcat "0" s))
    )
    (setq r (strcat r s))
    (princ s file)
    (setq e (rem d digit))
    (setq c (- c 13))
  )
  (close file)
  r
)  
;;;以后给出完全注释版的

(defun CalE (a c / b d e f p s x)
  (setq	b 0 e 0 P "")
  (repeat (1+ c)
    (setq f (cons a f))
  )
  (while (> c 0)
    (setq d 0)
    (setq b c)
    (setq x nil)
    (while (> b 0)    
      (setq d (+ d (* (car f) a)))
      (setq f (cdr f))
      (setq x (cons (rem d b) x))
      (setq d (/ d b))
      (setq b (1- b))
    )
   
    (setq f (reverse x))
    (repeat 14
      (setq f (cdr f))
    )
    (setq c (- c 14))
    (setq s (+ e (/ d a)))
    (setq s (itoa s))
    (while (< (strlen s) 4)
      (setq s (strcat "0" s))
    )
    (setq P (strcat p s))
    (setq e (rem d a))
  )
  p
)
;;for(;b-c;)
;;f[b++]=a;
;;for(;d=0,g=c;c-=14,printf("%.4d ",e+d/a),e=d%a)
;;for(b=c;d+=f[b]*a,f[b]=d%b,d/=b,--b;);