|
|
> No.1813[元記事へ]
永野護さんへのお返事です。
> 不思議数を70から小さい順に列記すると
>
> 70, 836, 4030, 5830, 7192, 7912, 9272, 10430, 10570, 10792, 10990, 11410, 11690, 12110, 12530, 12670, 13370, 13510, …
10万は、マシンパワーがかなり必要です。
!不思議数
LET t0=TIME
LET N=20000 !検索範囲 [1,N]
FOR i=0 TO N
IF WeirdNumberQ(i)=1 THEN PRINT i;"は、不思議数です。"
NEXT i
PRINT "計算時間=";TIME-t0
END
EXTERNAL FUNCTION WeirdNumberQ(N) !不思議数かどうか確認する 1:不思議数、0:そうでない
LET WeirdNumberQ=0
IF N<0 OR N<>INT(N) THEN EXIT FUNCTION !引数を確認する
!０以上の整数なら
IF MOD(N,6)<>0 THEN !∵完全数6とその倍数は、n=n/2+n/3+n/6より、擬似完全数となる
LET M=INT(N/2)+1 !高々
DIM D(M)
CALL Divisors(N,C,D) !約数を得る
LET S=0 !その数自身を除くすべての約数の和
FOR k=1 TO C-1
LET S=S+D(k)
NEXT k
IF S>N THEN !過剰数なら
!!!PRINT N;C !debug
FOR L=0 TO 2^(C-1)-1 !組合せと2進法（ビットパターン）を対応させる
LET t=L
LET S=0 !その数自身を除くいくつかの約数の和
LET k=C-1 !大きい約数から順に
DO WHILE t>0
IF MOD(t,2)=1 THEN
LET S=S+D(k)
IF S>N THEN EXIT DO !これ以降は可能性なし
END IF
LET t=INT(t/2)
LET k=k-1
LOOP
IF S=N THEN EXIT FOR !一致する
NEXT L
IF L>2^(C-1)-1 THEN LET WeirdNumberQ=1 !すべての組合せで一致しないなら
END IF
END IF
END FUNCTION
EXTERNAL SUB Divisors(N, C,D()) !正の約数を列挙する ※N≧1
LET C=0 !個数
IF N<1 OR N<>INT(N) THEN EXIT SUB !引数を確認する
!１以上の整数なら
LET C=1
LET D(1)=1 !１
LET i=2
DO WHILE i*i<=N !２～√Ｎ
IF MOD(N,i)=0 THEN !割り切れるなら
LET C=C+1
LET D(C)=i !除数
END IF
LET i=i+1
LOOP
LET M=C !残りの片方を求める
IF D(C)*D(C)=N THEN LET M=M-1 !平方数の場合
FOR i=1 TO M
LET D(C+i)=N/D(M-i+1) !商
NEXT i
LET C=C+M !個数
END SUB
|
|