FreeBASIC 友愛数 素数 完全数

' version 04-10-2016
' compile with: fbc -s console
' replaced the function with 2 FOR NEXT loops

' エラトステネスのふるいを使う
' http://rosettacode.org/wiki/Amicable_pairs#using_.22Sieve_of_Erathosthenes.22_style

#Include "vbcompat.bi"   'Now を使えるようにする

'#Define maxNo 20000      ' test for pairs below maxNo
#Define maxNo 500000      ' 以下のペア・テストの最大数
#Define maxNo_1 maxNo -1
 
Dim As String u_str = String(Len(Str(maxNo))+1,"#")
Dim As UInteger n, f
Dim Shared As UInteger sum(maxNo_1)
Dim TimeStart As Double
Dim TimeEnd As Double
 
TimeStart = Now         ' 開始時刻を変数に格納します。

For n = 2 To maxNo_1
  sum(n) = 1
Next
 
For n = 2 To maxNo_1 \ 2
  For f  = n * 2 To maxNo_1 Step n
    sum(f) += n
  Next
Next
 
Print
Print Using "以下は、最大数" & u_str & " の友愛数の対 :"; maxNo
Print
 
For n = 1 To maxNo_1 -1
  f = Sum(n)
  If f <= n OrElse f > maxNo Then Continue For
  If f = sum(n) AndAlso n = sum(f) Then
    Print Using u_str & " と" & u_str ; n; f
  End If
Next

Print
TimeEnd = Now           ' 終了時刻を変数に格納します。
Print  " 処理時間は、" ;
Print Format (TimeEnd - TimeStart, "hh:mm:ss")

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "何かキーを押すとプログラムを終了します"
Sleep
End

' FB 1.05.0
' http://rosettacode.org/wiki/Sieve_of_Eratosthenes

Sub sieve(n As Integer)
  If n < 2 Then Return
  Dim a(2 To n) As Integer
  For i As Integer = 2 To n : a(i) = i : Next
  Dim As Integer p = 2, q
  
  ' 対応する配列要素を 0 に設定して非素数をマークする
  Do
    For j As Integer = p * p To n Step p
      a(j) = 0
    Next j
    ' 'p' の後に配列内の次の非ゼロ要素を探します。
    q = 0
    For j As Integer = p + 1 To Sqr(n)
      If a(j) <> 0 Then
        q = j
        Exit For
      End If
    Next j    
    If q = 0 Then Exit Do
    p = q
  Loop
 
  ' 残りの非ゼロの数字、すなわち素数を表示
  For i As Integer = 2 To n
    If a(i) <> 0 Then
      Print Using "########"; a(i);      
    End If
  Next
  Print
End Sub
 
Print "10,000までの素数は :"
Print
Dim As Double t1=Timer,t2
sieve(10000)
t2=Timer
Print
Print t2 - t1
Print "何かキーを押すと終了します。"
Sleep

'prime numbers searcher in QB
'https://www.freebasic.net/forum/viewtopic.php?f=8&t=27799
'by dodicat ≫ Jan 18, 2020 16:01 

Sub generateprimes(primes() As Integer,nmax As Integer)
    ReDim primes(1 To nmax)
   Var np = 0
    Dim As Integer i, k
    For k = 2 To nmax
        If primes(k) = 0 Then
            np += 1
            primes(np) = k
            For i = 2*k To nmax Step k
                primes(i) = 1
            Next i
        End If
    Next k
    ReDim Preserve primes(1 To np)
End Sub

Dim As Double t1=Timer,t2
ReDim As Integer p()
generateprimes(p(),2000000)
t2=Timer

'For n As Long=1 To 20
'    Print p(n)
'Next
'
'Print ". . ."
'Print ". . ."
'
'For n As Long=UBound(p)-20 To UBound(p)
'    Print p(n)
'Next

For n As Long=1 To 1229
    Print p(n),
Next

Print
Print t2-t1

Sleep

'Perfect numbers
'http://rosettacode.org/wiki/Perfect_numbers#FreeBASIC

' FB 1.05.0 Win64

#Include "vbcompat.bi"   'Now を使えるようにする

Dim TimeStart As Double
Dim TimeEnd As Double

Function isPerfect(n As Integer) As Boolean
   If n < 2 Then Return FALSE
   If n Mod 2 = 1 Then Return FALSE '' 奇数は完全数でないと仮定できます
   Dim As Integer sum = 1, q
   For i As Integer = 2 To Sqr(n)
     If n Mod i = 0 Then
       sum += i
       q = n \ i
       If q > i Then sum += q
     End If
   Next 
   Return n = sum
End Function
 
TimeStart = Now         ' 開始時刻を変数に格納します。

Print "最初の5つの完全数は : "
For i As Integer = 2 To 33550336
  If isPerfect(i) Then Print i; " ";
Next

Print
Print
TimeEnd = Now           ' 終了時刻を変数に格納します。
Print  " 処理時間は、" ;
Print Format (TimeEnd - TimeStart, "hh:mm:ss")

Print
Print "何かキー入力でプログラム終了"
Sleep

'Abundant, deficient and perfect number classifications
'過剰数、不足数、完全数の分類
'(自然数について、その数以外の約数〈1 を含む〉の和と、もとの数を大小比較する)
'http://rosettacode.org/wiki/Abundant,_deficient_and_perfect_number_classifications#FreeBASIC

' FreeBASIC v1.05.0 win64
 
#Include "vbcompat.bi"   'Now を使えるようにする 

Function SumProperDivisors(number As Integer) As Integer
  If number < 2 Then Return 0
  Dim sum As Integer = 0
  For i As Integer = 1 To number \ 2
    If number Mod i = 0 Then sum += i
  Next
  Return sum
End Function
 
Dim As Integer sum, deficient, perfect, abundant
Dim TimeStart As Double
Dim TimeEnd As Double

Print "1から20,000までの完全数は、以下の通りです : "
'完全数は、小さい順に 6, 28, 496, 8128, 33550336, 8589869056, 

TimeStart = Now         ' 開始時刻を変数に格納します。

For n As Integer = 1 To 20000
'For n As Integer = 1 To 40000000
  If n Mod 10000000 = 0 Then 
     Print "カウンター" ; n ;   
     TimeEnd = Now           ' 終了時刻を変数に格納します。
     Print  " 処理時間は、" ;
     Print Format (TimeEnd - TimeStart, "hh:mm:ss")
  ElseIf n Mod 1000000 = 0 Then
   Print "カウンター" ; n ;
     TimeEnd = Now           ' 終了時刻を変数に格納します。
     Print  " 処理時間は、" ;
     Print Format (TimeEnd - TimeStart, "hh:mm:ss")
  End If 

  sum = SumProperDivisors(n)
  If sum < n Then
    deficient += 1
  ElseIf sum = n Then
    perfect += 1
    Print n
  Else
    abundant += 1
  EndIf
Next

Print
Print "1から20,000までの数の分類は、以下の通りです : "
Print
'不足数、輸数◆その数自身を除く全ての約数の和がその数自身よりも小さな整数
Print "不足数 = "; deficient

'完全数◆自分自身を除く正の約数の和に等しくなる自然数
Print "完全数 = "; perfect

'過剰数、豊数◆その数自身を除く全ての約数の和がその数自身よりも大きな整数
Print "過剰数 = "; abundant
Print
Print "何かキーを押すとプログラムを終了します"
Sleep
End