本程序采用LISP计算高精度Pi的数值，可计算到小数点后16000位。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 |
;;;----------------------------------------------------; ;;;highflybird 2008.4.20 Haikou ; ;;;采用LISP计算高精度Pi的数值，可计算到小数点后16000位 ; ;;;测试运行部分 ; ;;;----------------------------------------------------; (defun c:test (/ digits i n Result t1 t2 time str FILE KEY PATH) (setq digits 10000) ;每次输出位数 (initget 7) ;非零非负非空 (setq n (getint "nn请输入精度<不超过16000>:")) ;输入精度 (if (> n 16000) (alert "输入超过16000!") (progn (setq t1 (getvar "TDUSRTIMER")) ;开始计时 (setq Result (CalPi digits n)) ;计算Pi值 (setq t2 (getvar "TDUSRTIMER")) ;计时结束 (setq time (* 86400 (- t2 t1))) (princ "n计算Pi共用时(秒):") (princ time) ;和所耗时间 (initget 1 "Yes No") (setq key (getkword "n要打印到文件吗[是(Yes)/否(No)]：")) (if (and (= key "Yes") (setq path (getfiled "输入文件名:" "c:/" "txt" 1)) ) (progn (setq file (open path "w")) (princ "3n.141" file) ;这个是为了打印需要 (setq i 2) (foreach n (cdr Result) (setq str (itoa n)) (while (< (strlen str) 4) (setq str (strcat "0" str)) ) (princ str file) (if (= (rem i 25) 0) (princ (strcat " --" (itoa (* i 4)) "n") file) ) (setq i (1+ i)) ) (close file) (startapp "Notepad" path) ) ) ) ) (princ) ;退出 ) ;;;----------------------------------------------------; ;;;highflybird 2008.4.20 Haikou ; ;;;采用LISP计算高精度Pi的数值，可计算到小数点后16000位 ; ;;;函数求值部分 ; ;;;----------------------------------------------------; (defun CalPi (digits n / b c d e f g h r s x) (setq c (/ (1+ n) (/ (log 2) (log 10)))) ;需要迭代的次数 (setq c (fix c)) ;转化为整数 (setq e 0 r nil) ;存储结果的字符串赋空值 (setq h (/ digits 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)) ;分母。因为每次循环都输出了4位，所以在后面运算时乘以了a，所以这里得 -2 (setq b c) ;分子 (setq x nil) (while (> b 0) ;;根据公式，乘以分子 (setq d (* d b)) (setq b (1- b)) (setq d (+ d (* (car f) digits))) ;因为每次外循环都输出了4位 ;;根据公式，除以分母 (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 digits))) ;printf("%.4d", e+d/a); (setq r (cons s r)) ;算出的每一项，注意表的每项如果不足4位要加零补全 (setq e (rem d digits)) ;e = d % a; (setq c (- c 13)) ;精度固定为800位,每输出4位后,相当于精度需求降低了4位,故每次可少算13项 ) (reverse r) ;把表项反转 ) ;;;----------------------------------------------------; ;;;highflybird 2008.4.20 Haikou ; ;;;采用LISP计算高精度e的数值，可计算到小数点后16000位 ; ;;;函数求值部分 ; ;;;----------------------------------------------------; (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 ) ;|以下是C的源代码: -------------------------------------------------------- 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;); -------------------------------------------------------- |;; |