RosettaCodeData/Task/Vampire-number/PureBasic/vampire-number.basic

63 lines
1.3 KiB
Plaintext

EnableExplicit
DisableDebugger
Macro CheckVamp(CheckNum)
c=0 : i=CheckNum : Print(~"\nCheck number: "+Str(i)+~"\n")
Gosub VampireLoop : If c=0 : Print(Str(i)+" is not vampiric.") : EndIf : PrintN("")
EndMacro
Procedure.i Factor(number.i,counter.i)
If number>0 And number>=counter*counter And number%counter=0
ProcedureReturn counter
EndIf
ProcedureReturn 0
EndProcedure
Procedure.b IsVampire(f1.i,f2.i)
Define a.s=Str(f1*f2),
b.s=Str(f1),
c.s=Str(f2),
d.s=b+c,
i.i
If Len(a)=Len(d) And Len(b)=Len(c)
While Len(a)
i=FindString(d,Left(a,1))
If i
a=Mid(a,2)
d=RemoveString(d,Mid(d,i,1),#PB_String_NoCase,i,1)
Else
ProcedureReturn #False
EndIf
Wend
ProcedureReturn Bool(Len(d)=0)
EndIf
ProcedureReturn #False
EndProcedure
OpenConsole("Vampire number")
Define i.i,
j.i,
m.i,
c.i=0
PrintN("The first 25 Vampire numbers...")
While c<25 : i+1 : Gosub VampireLoop : Wend
PrintN("")
CheckVamp(16758243290880) : CheckVamp(24959017348650) : CheckVamp(14593825548650)
Input()
End
VampireLoop:
For j=1 To Int(Sqr(i))
If Factor(i,j)>0
m=i/j
Else
Continue
EndIf
If IsVampire(m,j)
c+1
PrintN(RSet(Str(c),3," ")+". "+RSet(Str(i),10," ")+": ["+Str(j)+", "+Str(m)+"]")
EndIf
Next
Return