RosettaCodeData/Task/Square-free-integers/FreeBASIC/square-free-integers.basic
2023-07-01 13:44:08 -04:00

89 lines
1.9 KiB
Text

' version 06-07-2018
' compile with: fbc -s console
Const As ULongInt trillion = 1000000000000ull
Const As ULong max = Sqr(trillion + 145)
Dim As UByte list(), sieve()
Dim As ULong prime()
ReDim list(max), prime(max\12), sieve(max)
Dim As ULong a, b, c, i, k, stop_ = Sqr(max)
For i = 4 To max Step 2 ' prime sieve remove even numbers except 2
sieve(i) = 1
Next
For i = 3 To stop_ Step 2 ' proces odd numbers
If sieve(i) = 0 Then
For a = i * i To max Step i * 2
sieve(a) = 1
Next
End If
Next
For i = 2 To max ' move primes to a list
If sieve(i) = 0 Then
c += 1
prime(c) = i
End If
Next
ReDim sieve(145): ReDim Preserve prime(c)
For i = 1 To c ' find all square free integers between 1 and 1000000
a = prime(i) * prime(i)
If a > 1000000 Then Exit For
For k = a To 1000000 Step a
list(k) = 1
Next
Next
k = 0
For i = 1 To 145 ' show all between 1 and 145
If list(i) = 0 Then
Print Using"####"; i;
k +=1
If k Mod 20 = 0 Then Print
End If
Next
Print : Print
sieve(0) = 1 ' = trillion
For i = 1 To 5 ' process primes 2, 3, 5, 7, 11
a = prime(i) * prime(i)
b = a - trillion Mod a
For k = b To 145 Step a
sieve(k) = 1
Next
Next
For i = 6 To c ' process the rest of the primes
a = prime(i) * prime(i)
k = a - trillion Mod a
If k <= 145 Then sieve(k) = 1
Next
k = 0
For i = 0 To 145
If sieve(i) = 0 Then
Print Using "################"; (trillion + i);
k += 1
If k Mod 5 = 0 Then print
End If
Next
Print : Print
a = 1 : b = 100 : k = 0
Do Until b > 1000000 ' count them
For i = a To b
If list(i) = 0 Then k += 1
Next
Print "There are "; k; " square free integers between 1 and "; b
a = b : b *= 10
Loop
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End