十進BASIC 第2掲示板 過去ログ

RANDOMIZE

LET N=6 !コインを投げる回数

DIM s(-N TO N) !点xに戻る回数
MAT s=ZER

LET iter=50000 !試行回数
FOR i=1 TO iter

   LET x=0 !原点
   FOR k=1 TO N !コインを投げる
      IF RND<0.5 THEN LET x=x+1 ELSE LET x=x-1 !表なら＋１、裏なら－１
   NEXT k
   LET s(x)=s(x)+1 !結果

NEXT i

FOR i=-N TO N !点xに戻る確率
   PRINT i;s(i)/iter
NEXT i
PRINT

FOR i=-N TO N !場合の数
   PRINT USING "###: ###.##": i,s(i)/s(N) !x=Nを１とする
NEXT i

END

LET x=0 !原点

LET k=(x+N)/2 !整数解があれば
IF k=INT(k) THEN
   PRINT k; comb(N,k)*(1/2)^k*(1-1/2)^(N-k)
ELSE
   PRINT "到達しません。"
END IF

END

!パスカルの三角形

LET N=10 !コインを投げる回数

LET a=1 !パスカルの三角形
LET b=0
LET c=1

DIM P(-N TO N) !数直線上の各点
MAT P=ZER
LET P(0)=1 !原点に位置付ける

FOR i=-N TO N !目盛り
   PRINT USING " ####": i;
NEXT i
PRINT
FOR i=-N TO N !数直線
   PRINT "----+";
NEXT i
PRINT

FOR i=0 TO N !指定回数

   MAT PRINT USING(REPEAT$(" ####",2*N+1)): P; !現状
   PRINT USING " ### 回の場合": i

   LET T1=0 !左　※左端
   LET T2=P(-N) !中央
   FOR x=-N TO N !左から右へ走査する
      IF x+1>N THEN LET T3=0 ELSE LET T3=P(x+1) !右

      LET P(x)=a*T1+b*T2+c*T3

      LET T1=T2 !次へ
      LET T2=T3
   NEXT x

NEXT i

END

!九九表（乗算表）と～数

!１の段　－　自然数
!２の段　－　偶数
!各段　－　倍数


LET N=9 !※書式（PRINT USING）の桁を調整すれば変更可能

DIM A(0 TO 2*N) !数列 An
DIM S(0 TO 2*N) !数列 Sn


!●平方数（四角数）　n^2
MAT A=ZER
PRINT

FOR i=1 TO N
   FOR j=1 TO N
      LET t=i*j !乗算

      IF i=j THEN !対角線上なら
         PRINT USING "(####)": t;
         LET A(i)=t
      ELSE
         PRINT USING " #### ": t;
      END IF

   NEXT j
   PRINT
NEXT i
PRINT


!四角錐数（平方数の和）Square Pyramid Numbers
!　Σ[k=1,n]k^2
! =1^2 + 2^2 + 3^2 + … + (n-1)^2 + n^2
! =n*(n+1)*(2*n+1)/6
MAT S=ZER

FOR i=1 TO N
   LET S(i)=S(i-1)+A(i) !和　※A()は上記の平方数
NEXT i
FOR i=1 TO N !～数を表示する
   PRINT S(i);
NEXT i
PRINT
PRINT


!奇数の和　1 + 3 + 5 + … + (2*n-3) + (2*n-1)
!　Σ[k=1,n](2*k-1)
! =n^2
MAT S=ZER

FOR i=1 TO N
   LET S(i)=A(i)-A(i-1) !階差　※A()は上記の平方数
NEXT i
FOR i=1 TO N !～数を表示する
   PRINT S(i);
NEXT i
PRINT
PRINT



!●四面体数（三角数の和、三角錐数 tetrahedral number）
!　Σ[k=1,n]k*(n-k+1)
! =1*n+2*(n-1)+3*(n-2)+ … +(n-1)*2+n*1
! =n*(n+1)*(n+2)/6
MAT A=ZER
PRINT

FOR i=1 TO N
   FOR j=1 TO N
      LET t=i*j !乗算

      LET A(i+j-1)=A(i+j-1)+t !右斜め（／）に加算する
      PRINT USING "####": t;

   NEXT j
   PRINT
   IF i<N THEN PRINT "　";REPEAT$("　／",N-1) !行間
NEXT i
PRINT

FOR i=1 TO N !～数を表示する
   PRINT A(i);
NEXT i
PRINT
PRINT



!●立方数　n^3
MAT A=ZER
PRINT

FOR i=1 TO N
   FOR j=1 TO N
      LET t=i*j !乗算

      IF i<j THEN !Ｌ字に加算する
         LET A(j)=A(j)+t
         PRINT USING "│####": t;
      ELSE
         LET A(i)=A(i)+t
         PRINT USING "　####": t;
      END IF

   NEXT j
   PRINT "│" !行末
   PRINT REPEAT$("───",i);"┘";REPEAT$("　　│",N-i) !行間
NEXT i
PRINT

FOR i=1 TO N !～数を表示する
   PRINT A(i);
NEXT i
PRINT
PRINT



!立方数の和
!　Σ[k=1,n]k^3=(n*(n+1)/2)^2の導出
!　1*Σ[k=1,n]k + 2*Σ[k=1,n]k + 3*Σ[k=1,n]k + … + (n-1)*Σ[k=1,n]k + n*Σ[k=1,n]k
! =(1+2+ … +(n-1)+n)*Σ[k=1,n]k
! =(Σ[k=1,n]k)^2
PRINT

FOR i=1 TO N
   FOR j=1 TO N
      LET t=i*j !乗算
      PRINT USING " ####": t;
   NEXT j
   PRINT "　←１段目の";i;"倍"
NEXT i
PRINT

MAT S=ZER
FOR i=1 TO N
   LET S(i)=S(i-1)+A(i) !※A()は上記の立方数
NEXT i
FOR i=1 TO N !～数を表示する
   PRINT S(i);
NEXT i
PRINT
PRINT


END

OPTION ARITHMETIC RATIONAL

LET N=20

PRINT fact(N) !検算


LET A=N
LET S=0 !5の数を数える
DO UNTIL A=0
   LET A=INT(A/5) !5,5^2,5^3,…で割る
   LET S=S+A
LOOP
PRINT S;"個"


!LET A=N
!LET S=0 !2の数を数える
!DO UNTIL A=0
!   LET A=INT(A/2) !2,2^2,2^3,…で割る
!   LET S=S+A
!LOOP
!PRINT S;"個"

END

LET N=20

FOR i=2 TO N
   IF isPRIME(i)=-1 THEN !素数に対して

      LET a=N
      LET s=0 !素数iの個数
      DO UNTIL a=0
         LET a=INT(a/i)
         LET s=s+a
      LOOP
      PRINT STR$(i);"^";STR$(s) !べき乗で表示

   END IF
NEXT i

END


!●素数かどうか判定する（エラトステネスのふるい法）
!　変数 N： 判定する数値。※２以上
!　関数値：k>0 素数でない（kは約数）、-1 素数
EXTERNAL FUNCTION isPRIME(N)
IF MOD(N,2)=0 THEN !2で割り切れるなら素数でない
   LET isPRIME=2
   IF N=2 THEN LET isPRIME=-1 !2は素数
ELSE
   LET isPRIME=-1 !素数である
   FOR i=3 TO SQR(N) STEP 2 !Nの平方根までの奇数で繰り返す
   !!!FOR i=3 TO INTSQR(N) STEP 2 !Nの平方根までの奇数で繰り返す
      IF MOD(N,i)=0 THEN !iで割り切れるなら素数でない
         LET isPRIME=i
         EXIT FOR
      END IF
   NEXT i
END IF
END FUNCTION

! 10!=1*2*3*4*5*6*7*8*9*10の場合

! 中央値　m=6
! 5と7　(m-1)*(m+1)=m^2-1=36-1=35、d=1
! 4と8　(m-2)*(m+2)=m^2-4=(m^2-1)-3=35-3=32、d=3
! 3と9　(m-3)*(m+3)=m^2-9=(m^2-4)-5=32-5=27、d=5
! 2と10　(m-4)*(m+4)=m^2-16=(m^2-9)-7=27-7=20、d=7
! 1　無視
! ∴10!=6*35*32*27*20

LET N=10

LET m=INT(N/2+1) !中央値
LET s=m
LET mm=m*m

LET d=1
FOR i=1 TO N-m
   LET mm=mm-d
   LET s=s*mm

   LET d=d+2 !1,3,5,7,…　奇数
NEXT i

PRINT s

END

!●記数法の計算

LET N=5 !桁数
DATA 1,1,0,1,0,1 !２進法 110101

DIM A2(0 TO N),Q2(0 TO N)
FOR i=N TO 0 STEP -1
   READ A2(i)
NEXT i
CALL poly_divByLin(A2,2, Q2,R) !p(x)/(x-2)
PRINT R !10進法



!●多項式のテイラー展開

LET N=4 !次数
DATA 1,-2,-20,23,13 !x^4-2*x^3-20*x^2+23*x+13
DATA 5 !x=a

DIM A(0 TO N) !係数
FOR i=N TO 0 STEP -1
   READ A(i)
NEXT i
READ v


DIM Q(0 TO N),AA(0 TO N) !作業用

MAT AA=A
FOR i=0 TO N-1 !Σf[k](a)/k!*(x-a)^k
   CALL poly_divByLin(AA,v, Q,R) !ｋ階微分係数　※<----------
   PRINT R;" * ( x -";v;") ^";i

   MAT AA=Q !次へ
NEXT i
PRINT Q(0);" * ( x -";v;") ^";N



!●代数方程式の根をニュートン法で求める（関数値、微分係数）

LET cEps=1e-10 !精度  ※要調整

LET N=3 !次数
DATA 1,-2,0,-9 !x^3-2*x^2-9=(x-3)*(x^2+x+3)

LET Xk=2 !近似根

DIM A3(0 TO N),Q3(0 TO N),QQ3(0 TO N)
FOR i=N TO 0 STEP -1
   READ A3(i)
NEXT i

LET iter=200 !反復回数
FOR k=1 TO iter
   CALL poly_divByLin(A3,Xk, Q3,f) !関数値※<----------
   CALL poly_divByLin(Q3,Xk, QQ3,df) !微分係数　※<----------
   LET WXk=Xk-f/df !Xk+1=Xk-f(Xk)/f'(Xk)
   IF ABS(WXk-Xk)<=ABS(Xk)*cEps THEN EXIT FOR !収束すれば終了
   LET Xk=WXk !次へ
NEXT k
IF k>iter THEN
   PRINT iter;"回では収束しません。"
   STOP
END IF

PRINT USING "## ##.###############": k,Xk


END


!補助ルーチン

!変数xの多項式 Σ[k=0,n]a(k)*x^k=a(n)*x^n+a(n-1)*x^(n-1)+ … +a(1)*x+a(0)

!演算関連

EXTERNAL FUNCTION poly_degree(A()) !次数を得る
FOR i=UBOUND(A) TO 1 STEP -1
   IF A(i)<>0 THEN EXIT FOR !係数が０でない最初の位置
NEXT i
LET poly_degree=i
END FUNCTION

EXTERNAL SUB poly_divByLin(A(),v, Q(),R) !多項式a(x)をx-αで割ったときの商q(x)と余りrを求める
MAT Q=ZER
LET s=0
FOR i=poly_degree(A) TO 0 STEP -1 !ホーナーの方法
   LET Q(i)=s !※「係数にｘを掛けて次の係数を加える」が組立除法になる
   LET s=s*v+A(i) !(…(((An*X+An-1)*X+An-2)*X+An-3)*X+…+A1)*X+A0
NEXT i
LET R=s
END SUB

!●接線の方程式

!整関数y=f(x)は、組立除法で、y=Q(x)*(x-a)^2+m*(x-a)+nに変形できる。
!y=f(x)上の点P(a,f(a))における接線は、y=m*(x-a)+nになる。

LET N=3 !次数

DATA 1,0,0,0 !y=f(x)=x^3
LET a=1 !点P

DIM A2(0 TO N)
FOR i=N TO 0 STEP -1
   READ A2(i)
NEXT i

CALL FxdFx(N,A2,a, f,df) !関数値と微分係数　※<----------
PRINT df;"* (x + "; -a;") +";f !y=f'(a)*(x-a)+f(a)



!●代数方程式の根をニュートン法で求める（関数値、微分係数）

LET cEps=1e-10 !精度  ※要調整

!LET N=3 !次数
!DATA 1,-2,0,-9 !x^3-2*x^2-9=(x-3)*(x^2+x+3)
LET N=4
DATA 1,-4,-1,10,6 !(x+1)(x-3)(x^2-2*x-2)

LET Xk=4 !近似根

DIM A3(0 TO N)
FOR i=N TO 0 STEP -1
   READ A3(i)
NEXT i

LET iter=200 !反復回数
FOR k=1 TO iter
   CALL FxdFx(N,A3,Xk, f,df) !関数値と微分係数　※<----------
   LET WXk=Xk-f/df !Xk+1=Xk-f(Xk)/f'(Xk)
   IF ABS(WXk-Xk)<=ABS(Xk)*cEps THEN EXIT FOR !収束すれば終了
   LET Xk=WXk !次へ
NEXT k
IF k>iter THEN
   PRINT iter;"回では収束しません。"
   STOP
END IF

PRINT USING "## ##.###############": k,Xk


END


!補助ルーチン

!変数xの多項式 Σ[k=0,n]a(k)*x^k=a(n)*x^n+a(n-1)*x^(n-1)+ … +a(1)*x+a(0)

!演算関連

EXTERNAL SUB FxdFx(n,a(),x0, f,df) !関数値f(x0)と微分係数f'(x0)を求める　※n≧1
LET f=a(n)
LET df=f
FOR j=n-1 TO 1 STEP -1 !ホーナー法（組立除法）
   LET f=f*x0+a(j)
   LET df=df*x0+f
NEXT j
LET f=f*x0+a(0)
END SUB