home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 3 / FreeSoftwareCollection3pd199x-jp.img / fb386 / paibasic / paibasic.bas next >
BASIC Source File  |  1980-01-02  |  9KB  |  247 lines
  1. 1000 'ＢＡＳＩＣによるπ計算プログラム V1.1
  2. 1010 'copyright by ＤＤＴ(NIFTY-SERVE NAA00710) 高橋  大介
  3. 1020 '          on 90/05/13
  4. 1030 'マチンの式
  5. 1040 'π/4=4*ARCTAN(1/5)-ARCTAN(1/239)
  6. 1050 'π/4=4*(1/5-1/3*5^3+1/5*5^5+･･･)-(1/239-1/3*239^3+1/5*239^5+･･･) 
  7. 1060 'π  =16*(1/5-1/3*5^3+1/5*5^5+･･･)-4*(1/239-1/3*239^3+1/5*239^5+･･･) 
  8. 1070 '
  9. 1080 '用意するもの( A??()は､配列 )
  10. 1090 '
  11. 1100 '求める桁数･････1ヶ  MAX    0から21億までの間(ﾒﾓﾘｰがぢゅどーん)
  12. 1110 '配列数･････････1ヶ  LAST   整数部分と小数部分の必要配列数
  13. 1120 'パイ格納庫･････1ヶ  ANS()  ←ACC1()
  14. 1130 '演算配列1･･････1ヶ  ACC1() ←ACC2/ARCVAR
  15. 1140 '演算配列2･･････1ヶ  ACC2() ←1/ARCCON^N (N=3,5,7,･･･)
  16. 1150 'arctan変数･････1ヶ  ARCVAR ARCTAN展開の際の変数
  17. 1160 'arctan定数･････1ヶ  ARCCON  ARCTAN(1/ARCCON)
  18. 1170 '加減算キャリー･1ヶ  CARRY
  19. 1180 '最上位桁･･･････1ヶ  TOP    配列内での最上位有効数字
  20. 1190 '汎用カウンター･1ヶ  COUNT
  21. 1200 '計算開始時刻･･･1ヶ  STARTDATE,STARTTIME
  22. 1210 '計算所要時間･･･1ヶ  CALTIME
  23. 1220 '
  24. 1230 '配列の構造
  25. 1240 'ACC(0)=整数部分
  26. 1250 'ACC(1)からACC(LAST)=小数部分   1配列に4桁
  27. 1260 '
  28. 1270 '------STEP 0 -----初期設定------USER INTERFACE----------  
  29. 1280 '何桁まで計算するか聞く。計算時間の計測
  30. 1290 '------STEP 1------4*(4*ARCTAN(1/5)) の数値設定-----------
  31. 1300 '最初にANS()にも格納する
  32. 1310 '同時にACC2()に16/5(=3.2)を入れる
  33. 1320 'ARCCONに25を代入
  34. 1330 'ARCVARに3を代入 
  35. 1340 'ARCTANサブルーチン負数エントリコール
  36. 1350 '-------STEP 2------4*(ARCTAN(1/239))の数値設定----------
  37. 1360 '最初にACC2()に4*239を入れる｡
  38. 1370 'ARCCONに239^2を入れる
  39. 1380 'ARCVARに1を代入
  40. 1390 'ARCTANサブルーチン負数エントリコール
  41. 1400 '-------STEP 3------結果表示------USER INTERFACE--------- 
  42. 1410 'ユーザーの要求するデータを表示して終了する｡
  43. 1420 '-------STEP 4------ARCTAN サブルーチン-------------------
  44. 1430 '負数からの開始エントリー
  45. 1440 '   ACC2()/ARCCON->ACC2()
  46. 1450 '   ACC2()/ARCVAR->ACC1()
  47. 1460 '   ANS()-ACC1() ->ANS()
  48. 1470 '   ARCVAL=ARCVAL+2
  49. 1480 '正数からの開始エントリー
  50. 1490 '   ACC2()/ARCCON->ACC2()
  51. 1500 '   ACC2()/ARCVAR->ACC1()
  52. 1510 '   ANS()+ACC1() ->ANS()
  53. 1520 '   ARCVAL=ARCVAL+2
  54. 1530 '負数エントリーへジャンプ
  55. 1540 '(リターンはACC1(LAST)の内容が0になった時点)
  56. 1550 '
  57. 1560 '------------------付記-----------------------
  58. 1570 'このプログラムを作るきっかけは
  59. 1580 'NIFTY-SERVE のTOWNS FORUM で、
  60. 1590 'πの計算式をBASIC で組んでみたら
  61. 1600 '実数の精度である15桁までしか求められなかったという、
  62. 1610 '発言に対してしんたろ（これはハンドル＝ペンネームです）さんが
  63. 1620 'マチンの式の原型π／４を求めるプログラムを発表したことです。
  64. 1630 '
  65. 1640 '実はＤＤＴも同じ発言を読んで作り始めたのですが、
  66. 1650 '一週間後に大学の卒業試験が始まるために、原型のみしかできず、
  67. 1660 '試験が終わる頃にはしんたろさんがNIFTY-SERVEに発表していました。
  68. 1670 '後から発表するのなら、と思い、
  69. 1680 'π／４ではなくて、πそのものを求めるようにしたり、
  70. 1690 'ユーザーインターフェース（といっても大したことは無いが）の改良、
  71. 1700 '高速化（といっても、たかがＢＡＳＩＣ）をはかりました。
  72. 1710 '
  73. 1720 '
  74. 1730 'もう少し時間があれば、エラー処理（例えば同じ名前のファイルが
  75. 1740 'あった時の処理＝今はまだエラーストップする）などや、
  76. 1750 '途中中断してデータセーブ→後刻再開するという機能を、
  77. 1760 'このコレクションにバグ入りのものを入れたくなかったので、
  78. 1770 '今回は断念しました。
  79. 1780 '（自分でやりたい方の為に→1100行からある変数が対象です）
  80. 1790 '
  81. 1800 'STEP 0の２行目で使用頻度順登録などというセコイまねをする反面、
  82. 1810 'このような巨大なドキュメントを頭においたり
  83. 1820 '一番必要なはずの計算ルーチンを最後尾にもってきたり、
  84. 1830 '節操無さがみえみえのプログラムですが、
  85. 1840 '旅行するときなどにでも実行してみて下さい。
  86. 1850 '
  87. 1860 '計算時間の目安は、プログラムの冒頭でも表示されますが、
  88. 1870 '大体1000桁で12分、１万桁で20時間、
  89. 1880 '桁数がＮ倍になると、時間はＮ＾２倍かかると思ってください。
  90. 1890 '10万桁で２０００時間＝８０日となります。(^_^;)
  91. 1900 'なお、ＢＡＳＩＣのフリーエリアの関係で
  92. 1910 '12万桁位までしか計算できません（これでも約４ヶ月かかる）(^_^;)
  93. 1920 '何かありましたら、NIFTY-SERVE NAA00710 までメールをどうぞ
  94. 1930 '---------------プログラム部分------------------
  95. 1940 '
  96. 1950 '------------------STEP 0-----------------------
  97. 1960 DEFLNG A-Z '32ビット整数、2MモデルでMAX 12万桁位まで
  98. 1970 COUNT=CARRY+ARCCON+ARCVAL+MAX+TOP+LAST '使用頻度順登録
  99. 1980 INPUT "πを何桁まで求めますか？ 何桁か余分に計算します｡ ",MAX
  100. 1990 PRINT:MAX=ABS(MAX) '一応念のため
  101. 2000 PRINT "現在のフリーエリアは"FRE(3)"バイトで､"
  102. 2010 PRINT "計算に必要なメモリーはおよそ"INT(MAX*3)"バイトです。"
  103. 2020 CALTIME=INT(712*4^(LOG((MAX+10)/1000)/LOG(2))) 'FB386 L20のスピード
  104. 2030 PRINT "計算に要する時間はおよそ"CALTIME"秒です｡":PRINT
  105. 2040 A$="用意"
  106. 2050 IF MAX>=100 THEN A$="都合"
  107. 2060 IF MAX>=1000 THEN A$="覚悟"
  108. 2070 IF MAX>=10000 THEN A$="忍耐"
  109. 2080 PRINT A$+"はよろしいですか？ ((Y)es/or Else ->Abort)"
  110. 2090 A$=INPUT$(1)
  111. 2100 IF INSTR("Yyﾝ",A$)=0 THEN PRINT "それが賢明です(^_^) ":GOTO *終了1
  112. 2110 PRINT "では始めます"
  113. 2120 PRINT "計算開始時刻は "+DATE$+" "TIME$+"です。"
  114. 2130 STARTTIME=TIME:STARTDATE=DATE
  115. 2140 '----------配列用意
  116. 2150 LAST=1+(MAX+3)\4 '整数部分と小数部分の必要配列数
  117. 2160 DIM ANS(LAST),ACC1(LAST),ACC2(LAST)
  118. 2170 '
  119. 2180 '------------------STEP 1----------------------
  120. 2190 ANS(0)=3:ANS(1)=.2!*10000
  121. 2200 ACC2(0)=3:ACC2(1)=.2!*10000
  122. 2210 ARCCON=25 '5^2
  123. 2220 ARCVAL=3 '1/5の項は計算済
  124. 2230 GOSUB *ARCMINUS '負数エントリ
  125. 2240 '------------------STEP 2----------------------
  126. 2250 ERASE ACC2:DIM ACC2(LAST) 'ACC2の内容を消去する
  127. 2260 ACC2(0)=4*239
  128. 2270 ARCCON=239*239 '239^2
  129. 2280 ARCVAL=1 '4/239の項を計算するための処置
  130. 2290 GOSUB *ARCMINUS '負数エントリ
  131. 2300 '-------------------STEP 3-----------------------
  132. 2310 CALTIME=(DATE-STARTDATE)*86400+TIME-STARTTIME
  133. 2320 PRINT:PRINT "計算時間は"CALTIME" 秒でした｡"
  134. 2330 COUNT=0 'うるうるモード(^_^;)
  135. 2340 *出力モード
  136. 2350 PRINT
  137. 2360 PRINT "画面表示する・・・・・・HIT '1' KEY"
  138. 2370 PRINT "印字する・・・・・・・・HIT '2' KEY"
  139. 2380 PRINT "ファイル出力する・・・・HIT '3' KEY"
  140. 2390 PRINT "処理を終わる・・・・・・HIT '0' KEY"
  141. 2400 PRINT
  142. 2410 *コマンド待ち
  143. 2420 A$=INPUT$(1):A=INSTR("1230",A$)
  144. 2430 IF A=0 THEN GOTO *コマンド待ち
  145. 2440 IF A>=1 AND A<=3 THEN *出力ルーチン
  146. 2450 IF COUNT=0 THEN PRINT:PRINT "せっかく計算したのに･････(;_;)" 
  147. 2460 PRINT "本当に終了しますか？((Y)es/or Else ->Abort)"
  148. 2470 A$=INPUT$(1):A=INSTR("Yyﾝ",A$)
  149. 2480 IF A THEN GOTO *終了 ELSE *出力モード 
  150. 2490 *出力ルーチン
  151. 2500 IF A=3 THEN PRINT "カレントディレクトリに出力します。"
  152. 2510 IF A=3 THEN OPEN "O",#1,"π"+RIGHT$(STR$(MAX+1000000),6)
  153. 2520 LBUFF$="πの小数点以下"+STR$(MAX)+" 桁の値です｡ "
  154. 2530 GOSUB *出力サブ:LBUFF$="":GOSUB *出力サブ 
  155. 2540 LBUFF$="00000001:"+RIGHT$(STR$(ANS(0))+".",2)
  156. 2550 COUNT=0
  157. 2560 *小数作成
  158. 2570 COUNT=COUNT+1
  159. 2580 LBUFF$=LBUFF$+RIGHT$(STR$(ANS(COUNT)+10000)+" ",5)
  160. 2590 IF COUNT=LAST THEN GOSUB *出力サブ:GOTO *出力完了
  161. 2600 IF COUNT MOD 10<>0 THEN GOTO *小数作成 
  162. 2610    GOSUB *出力サブ '改行
  163. 2620    IF A=2 AND COUNT MOD 500 =0 THEN GOSUB *用紙変更
  164. 2630    LBUFF$=RIGHT$(STR$(100000001+COUNT*4),8)+":  " '桁数
  165. 2640 GOTO *小数作成
  166. 2650 *出力サブ
  167. 2660 IF A=1 THEN PRINT LBUFF$:RETURN
  168. 2670 IF A=2 THEN LPRINT LBUFF$:RETURN
  169. 2680 IF A=3 THEN PRINT #1,LBUFF$:RETURN
  170. 2690 '
  171. 2700 *出力完了
  172. 2710 CLOSE #1:PRINT
  173. 2720 GOTO *出力モード
  174. 2730 *用紙変更
  175. 2740 PRINT"給紙確認。HIT ANY KEY":A$=INPUT$(1):RETURN
  176. 2750 '----------ARCTAN SUBROUTINE
  177. 2760 *ARCMINUS
  178. 2770 TOP=0
  179. 2780 WHILE TOP<LAST OR ACC2(LAST)
  180. 2790 GOSUB *ARCMAIN
  181. 2800 GOSUB *SUB
  182. 2810 ARCVAL=ARCVAL+2
  183. 2820 GOSUB *ARCMAIN
  184. 2830 GOSUB *ADD
  185. 2840 ARCVAL=ARCVAL+2
  186. 2850 WEND
  187. 2860 RETURN
  188. 2870 *ARCMAIN 
  189. 2880 '---------有効数字の最上位桁を求める
  190. 2890 WHILE TOP<LAST AND ACC2(TOP)=0
  191. 2900 TOP=TOP+1
  192. 2910 WEND
  193. 2920 '---------ACC2/ARCCON ->ACC2
  194. 2930 CARRY=0
  195. 2940 FOR I=TOP TO LAST
  196. 2950 COUNT=CARRY*10000+ACC2(I) '前の余りが次の4桁の頭へ付く
  197. 2960 CARRY=COUNT MOD ARCCON '余り
  198. 2970 ACC2(I)=COUNT \ ARCCON '商
  199. 2980 NEXT
  200. 2990 IF CARRY>=5000 THEN ACC2(LAST)=ACC2(LAST)+1 '四捨五入
  201. 3000 '---------ACC2/ARCVAL ->ACC1
  202. 3010 CARRY=0 
  203. 3020 FOR I=TOP TO LAST
  204. 3030 COUNT=CARRY*10000+ACC2(I)
  205. 3040 CARRY=COUNT MOD ARCVAL
  206. 3050 ACC1(I)=COUNT \ ARCVAL
  207. 3060 NEXT
  208. 3070 IF CARRY>=5000 THEN ACC1(LAST)=ACC1(LAST)+1
  209. 3080 RETURN
  210. 3090 '
  211. 3100 *SUB '--------減算ルーチン
  212. 3110 '------ACC1,ACC2は4桁に収まっていないことを考慮する
  213. 3120 CARRY=0:I=LAST
  214. 3130 WHILE I>=TOP OR CARRY>0
  215. 3140 ANS(I)=ANS(I)-ACC1(I)-CARRY
  216. 3150 CARRY=0
  217. 3160 WHILE ANS(I)<0
  218. 3170 ANS(I)=ANS(I)+10000:CARRY=CARRY+1
  219. 3180 WEND
  220. 3190 I=I-1
  221. 3200 WEND
  222. 3210 '
  223. 3220 RETURN
  224. 3230 '
  225. 3240 *ADD '--------加算ルーチン
  226. 3250 '------ACC1,ACC2は4桁に収まっていないことを考慮する
  227. 3260 CARRY=0:I=LAST
  228. 3270 WHILE I>=TOP OR CARRY>0
  229. 3280 ANS(I)=ANS(I)+ACC1(I)+CARRY
  230. 3290 CARRY=ANS(I) \ 10000
  231. 3300 ANS(I)=ANS(I) MOD 10000
  232. 3310 I=I-1
  233. 3320 WEND
  234. 3330 '
  235. 3340 RETURN
  236. 3350 '
  237. 3360 *終了
  238. 3370 FOR I=0 TO 1000:NEXT
  239. 3380 PRINT:CLOSE
  240. 3390 PRINT
  241. 3400 PRINT "本日はTOWNSをご利用頂き誠に有り難うございました。"
  242. 3410 PRINT "またのご利用をお願い致します｡"
  243. 3420 END
  244. 3430 '
  245. 3440 '付記･････････････････････････････････････････････
  246. 3450 '
  247.