RosettaCodeData/Task/Attractive-numbers/PureBasic/attractive-numbers.basic
2023-07-01 13:44:08 -04:00

28 lines
826 B
Text

#MAX=120
Dim prime.b(#MAX)
FillMemory(@prime(),#MAX,#True,#PB_Byte) : FillMemory(@prime(),2,#False,#PB_Byte)
For i=2 To Int(Sqr(#MAX)) : n=i*i : While n<#MAX : prime(n)=#False : n+i : Wend : Next
Procedure.i pfCount(n.i)
Shared prime()
If n=1 : ProcedureReturn 0 : EndIf
If prime(n) : ProcedureReturn 1 : EndIf
count=0 : f=2
Repeat
If n%f=0 : count+1 : n/f
If n=1 : ProcedureReturn count : EndIf
If prime(n) : f=n : EndIf
ElseIf f>=3 : f+2
Else : f=3
EndIf
ForEver
EndProcedure
OpenConsole()
PrintN("The attractive numbers up to and including "+Str(#MAX)+" are:")
For i=1 To #MAX
If prime(pfCount(i))
Print(RSet(Str(i),4)) : count+1 : If count%20=0 : PrintN("") : EndIf
EndIf
Next
PrintN("") : Input()