home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 3
/
FREEWARE.BIN
/
fb386
/
paibasic
/
paibasic.bas
next >
Wrap
BASIC Source File
|
1980-01-02
|
9KB
|
247 lines
1000 'BASICによるπ計算プログラム V1.1
1010 'copyright by DDT(NIFTY-SERVE NAA00710) 高橋 大介
1020 ' on 90/05/13
1030 'マチンの式
1040 'π/4=4*ARCTAN(1/5)-ARCTAN(1/239)
1050 'π/4=4*(1/5-1/3*5^3+1/5*5^5+・・・)-(1/239-1/3*239^3+1/5*239^5+・・・)
1060 'π =16*(1/5-1/3*5^3+1/5*5^5+・・・)-4*(1/239-1/3*239^3+1/5*239^5+・・・)
1070 '
1080 '用意するもの( A??()は、配列 )
1090 '
1100 '求める桁数・・・・・1ヶ MAX 0から21億までの間(メモリーがぢゅどーん)
1110 '配列数・・・・・・・・・1ヶ LAST 整数部分と小数部分の必要配列数
1120 'パイ格納庫・・・・・1ヶ ANS() ←ACC1()
1130 '演算配列1・・・・・・1ヶ ACC1() ←ACC2/ARCVAR
1140 '演算配列2・・・・・・1ヶ ACC2() ←1/ARCCON^N (N=3,5,7,・・・)
1150 'arctan変数・・・・・1ヶ ARCVAR ARCTAN展開の際の変数
1160 'arctan定数・・・・・1ヶ ARCCON ARCTAN(1/ARCCON)
1170 '加減算キャリー・1ヶ CARRY
1180 '最上位桁・・・・・・・1ヶ TOP 配列内での最上位有効数字
1190 '汎用カウンター・1ヶ COUNT
1200 '計算開始時刻・・・1ヶ STARTDATE,STARTTIME
1210 '計算所要時間・・・1ヶ CALTIME
1220 '
1230 '配列の構造
1240 'ACC(0)=整数部分
1250 'ACC(1)からACC(LAST)=小数部分 1配列に4桁
1260 '
1270 '------STEP 0 -----初期設定------USER INTERFACE----------
1280 '何桁まで計算するか聞く。計算時間の計測
1290 '------STEP 1------4*(4*ARCTAN(1/5)) の数値設定-----------
1300 '最初にANS()にも格納する
1310 '同時にACC2()に16/5(=3.2)を入れる
1320 'ARCCONに25を代入
1330 'ARCVARに3を代入
1340 'ARCTANサブルーチン負数エントリコール
1350 '-------STEP 2------4*(ARCTAN(1/239))の数値設定----------
1360 '最初にACC2()に4*239を入れる。
1370 'ARCCONに239^2を入れる
1380 'ARCVARに1を代入
1390 'ARCTANサブルーチン負数エントリコール
1400 '-------STEP 3------結果表示------USER INTERFACE---------
1410 'ユーザーの要求するデータを表示して終了する。
1420 '-------STEP 4------ARCTAN サブルーチン-------------------
1430 '負数からの開始エントリー
1440 ' ACC2()/ARCCON->ACC2()
1450 ' ACC2()/ARCVAR->ACC1()
1460 ' ANS()-ACC1() ->ANS()
1470 ' ARCVAL=ARCVAL+2
1480 '正数からの開始エントリー
1490 ' ACC2()/ARCCON->ACC2()
1500 ' ACC2()/ARCVAR->ACC1()
1510 ' ANS()+ACC1() ->ANS()
1520 ' ARCVAL=ARCVAL+2
1530 '負数エントリーへジャンプ
1540 '(リターンはACC1(LAST)の内容が0になった時点)
1550 '
1560 '------------------付記-----------------------
1570 'このプログラムを作るきっかけは
1580 'NIFTY-SERVE のTOWNS FORUM で、
1590 'πの計算式をBASIC で組んでみたら
1600 '実数の精度である15桁までしか求められなかったという、
1610 '発言に対してしんたろ(これはハンドル=ペンネームです)さんが
1620 'マチンの式の原型π/4を求めるプログラムを発表したことです。
1630 '
1640 '実はDDTも同じ発言を読んで作り始めたのですが、
1650 '一週間後に大学の卒業試験が始まるために、原型のみしかできず、
1660 '試験が終わる頃にはしんたろさんがNIFTY-SERVEに発表していました。
1670 '後から発表するのなら、と思い、
1680 'π/4ではなくて、πそのものを求めるようにしたり、
1690 'ユーザーインターフェース(といっても大したことは無いが)の改良、
1700 '高速化(といっても、たかがBASIC)をはかりました。
1710 '
1720 '
1730 'もう少し時間があれば、エラー処理(例えば同じ名前のファイルが
1740 'あった時の処理=今はまだエラーストップする)などや、
1750 '途中中断してデータセーブ→後刻再開するという機能を、
1760 'このコレクションにバグ入りのものを入れたくなかったので、
1770 '今回は断念しました。
1780 '(自分でやりたい方の為に→1100行からある変数が対象です)
1790 '
1800 'STEP 0の2行目で使用頻度順登録などというセコイまねをする反面、
1810 'このような巨大なドキュメントを頭においたり
1820 '一番必要なはずの計算ルーチンを最後尾にもってきたり、
1830 '節操無さがみえみえのプログラムですが、
1840 '旅行するときなどにでも実行してみて下さい。
1850 '
1860 '計算時間の目安は、プログラムの冒頭でも表示されますが、
1870 '大体1000桁で12分、1万桁で20時間、
1880 '桁数がN倍になると、時間はN^2倍かかると思ってください。
1890 '10万桁で2000時間=80日となります。(^_^;)
1900 'なお、BASICのフリーエリアの関係で
1910 '12万桁位までしか計算できません(これでも約4ヶ月かかる)(^_^;)
1920 '何かありましたら、NIFTY-SERVE NAA00710 までメールをどうぞ
1930 '---------------プログラム部分------------------
1940 '
1950 '------------------STEP 0-----------------------
1960 DEFLNG A-Z '32ビット整数、2MモデルでMAX 12万桁位まで
1970 COUNT=CARRY+ARCCON+ARCVAL+MAX+TOP+LAST '使用頻度順登録
1980 INPUT "πを何桁まで求めますか? 何桁か余分に計算します。 ",MAX
1990 PRINT:MAX=ABS(MAX) '一応念のため
2000 PRINT "現在のフリーエリアは"FRE(3)"バイトで、"
2010 PRINT "計算に必要なメモリーはおよそ"INT(MAX*3)"バイトです。"
2020 CALTIME=INT(712*4^(LOG((MAX+10)/1000)/LOG(2))) 'FB386 L20のスピード
2030 PRINT "計算に要する時間はおよそ"CALTIME"秒です。":PRINT
2040 A$="用意"
2050 IF MAX>=100 THEN A$="都合"
2060 IF MAX>=1000 THEN A$="覚悟"
2070 IF MAX>=10000 THEN A$="忍耐"
2080 PRINT A$+"はよろしいですか? ((Y)es/or Else ->Abort)"
2090 A$=INPUT$(1)
2100 IF INSTR("Yyン",A$)=0 THEN PRINT "それが賢明です(^_^) ":GOTO *終了1
2110 PRINT "では始めます"
2120 PRINT "計算開始時刻は "+DATE$+" "TIME$+"です。"
2130 STARTTIME=TIME:STARTDATE=DATE
2140 '----------配列用意
2150 LAST=1+(MAX+3)\4 '整数部分と小数部分の必要配列数
2160 DIM ANS(LAST),ACC1(LAST),ACC2(LAST)
2170 '
2180 '------------------STEP 1----------------------
2190 ANS(0)=3:ANS(1)=.2!*10000
2200 ACC2(0)=3:ACC2(1)=.2!*10000
2210 ARCCON=25 '5^2
2220 ARCVAL=3 '1/5の項は計算済
2230 GOSUB *ARCMINUS '負数エントリ
2240 '------------------STEP 2----------------------
2250 ERASE ACC2:DIM ACC2(LAST) 'ACC2の内容を消去する
2260 ACC2(0)=4*239
2270 ARCCON=239*239 '239^2
2280 ARCVAL=1 '4/239の項を計算するための処置
2290 GOSUB *ARCMINUS '負数エントリ
2300 '-------------------STEP 3-----------------------
2310 CALTIME=(DATE-STARTDATE)*86400+TIME-STARTTIME
2320 PRINT:PRINT "計算時間は"CALTIME" 秒でした。"
2330 COUNT=0 'うるうるモード(^_^;)
2340 *出力モード
2350 PRINT
2360 PRINT "画面表示する・・・・・・HIT '1' KEY"
2370 PRINT "印字する・・・・・・・・HIT '2' KEY"
2380 PRINT "ファイル出力する・・・・HIT '3' KEY"
2390 PRINT "処理を終わる・・・・・・HIT '0' KEY"
2400 PRINT
2410 *コマンド待ち
2420 A$=INPUT$(1):A=INSTR("1230",A$)
2430 IF A=0 THEN GOTO *コマンド待ち
2440 IF A>=1 AND A<=3 THEN *出力ルーチン
2450 IF COUNT=0 THEN PRINT:PRINT "せっかく計算したのに・・・・・(;_;)"
2460 PRINT "本当に終了しますか?((Y)es/or Else ->Abort)"
2470 A$=INPUT$(1):A=INSTR("Yyン",A$)
2480 IF A THEN GOTO *終了 ELSE *出力モード
2490 *出力ルーチン
2500 IF A=3 THEN PRINT "カレントディレクトリに出力します。"
2510 IF A=3 THEN OPEN "O",#1,"π"+RIGHT$(STR$(MAX+1000000),6)
2520 LBUFF$="πの小数点以下"+STR$(MAX)+" 桁の値です。 "
2530 GOSUB *出力サブ:LBUFF$="":GOSUB *出力サブ
2540 LBUFF$="00000001:"+RIGHT$(STR$(ANS(0))+".",2)
2550 COUNT=0
2560 *小数作成
2570 COUNT=COUNT+1
2580 LBUFF$=LBUFF$+RIGHT$(STR$(ANS(COUNT)+10000)+" ",5)
2590 IF COUNT=LAST THEN GOSUB *出力サブ:GOTO *出力完了
2600 IF COUNT MOD 10<>0 THEN GOTO *小数作成
2610 GOSUB *出力サブ '改行
2620 IF A=2 AND COUNT MOD 500 =0 THEN GOSUB *用紙変更
2630 LBUFF$=RIGHT$(STR$(100000001+COUNT*4),8)+": " '桁数
2640 GOTO *小数作成
2650 *出力サブ
2660 IF A=1 THEN PRINT LBUFF$:RETURN
2670 IF A=2 THEN LPRINT LBUFF$:RETURN
2680 IF A=3 THEN PRINT #1,LBUFF$:RETURN
2690 '
2700 *出力完了
2710 CLOSE #1:PRINT
2720 GOTO *出力モード
2730 *用紙変更
2740 PRINT"給紙確認。HIT ANY KEY":A$=INPUT$(1):RETURN
2750 '----------ARCTAN SUBROUTINE
2760 *ARCMINUS
2770 TOP=0
2780 WHILE TOP<LAST OR ACC2(LAST)
2790 GOSUB *ARCMAIN
2800 GOSUB *SUB
2810 ARCVAL=ARCVAL+2
2820 GOSUB *ARCMAIN
2830 GOSUB *ADD
2840 ARCVAL=ARCVAL+2
2850 WEND
2860 RETURN
2870 *ARCMAIN
2880 '---------有効数字の最上位桁を求める
2890 WHILE TOP<LAST AND ACC2(TOP)=0
2900 TOP=TOP+1
2910 WEND
2920 '---------ACC2/ARCCON ->ACC2
2930 CARRY=0
2940 FOR I=TOP TO LAST
2950 COUNT=CARRY*10000+ACC2(I) '前の余りが次の4桁の頭へ付く
2960 CARRY=COUNT MOD ARCCON '余り
2970 ACC2(I)=COUNT \ ARCCON '商
2980 NEXT
2990 IF CARRY>=5000 THEN ACC2(LAST)=ACC2(LAST)+1 '四捨五入
3000 '---------ACC2/ARCVAL ->ACC1
3010 CARRY=0
3020 FOR I=TOP TO LAST
3030 COUNT=CARRY*10000+ACC2(I)
3040 CARRY=COUNT MOD ARCVAL
3050 ACC1(I)=COUNT \ ARCVAL
3060 NEXT
3070 IF CARRY>=5000 THEN ACC1(LAST)=ACC1(LAST)+1
3080 RETURN
3090 '
3100 *SUB '--------減算ルーチン
3110 '------ACC1,ACC2は4桁に収まっていないことを考慮する
3120 CARRY=0:I=LAST
3130 WHILE I>=TOP OR CARRY>0
3140 ANS(I)=ANS(I)-ACC1(I)-CARRY
3150 CARRY=0
3160 WHILE ANS(I)<0
3170 ANS(I)=ANS(I)+10000:CARRY=CARRY+1
3180 WEND
3190 I=I-1
3200 WEND
3210 '
3220 RETURN
3230 '
3240 *ADD '--------加算ルーチン
3250 '------ACC1,ACC2は4桁に収まっていないことを考慮する
3260 CARRY=0:I=LAST
3270 WHILE I>=TOP OR CARRY>0
3280 ANS(I)=ANS(I)+ACC1(I)+CARRY
3290 CARRY=ANS(I) \ 10000
3300 ANS(I)=ANS(I) MOD 10000
3310 I=I-1
3320 WEND
3330 '
3340 RETURN
3350 '
3360 *終了
3370 FOR I=0 TO 1000:NEXT
3380 PRINT:CLOSE
3390 PRINT
3400 PRINT "本日はTOWNSをご利用頂き誠に有り難うございました。"
3410 PRINT "またのご利用をお願い致します。"
3420 END
3430 '
3440 '付記・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
3450 '