107 lines
2.9 KiB
Plaintext
107 lines
2.9 KiB
Plaintext
'Vampire numbers.
|
|
'FreeBASIC version 24. Windows
|
|
'Vampire.bas
|
|
Function WithinString(n As Ulongint,f As Ulongint) As Integer
|
|
var m=Str(n),p=Str(f)
|
|
For z As Integer=0 To Len(p)-1
|
|
var i=Instr(m,Chr(p[z]))
|
|
If i Then
|
|
m=Mid(m,1,i-1)+Mid(m,i+1)
|
|
Else
|
|
Return 0
|
|
End If
|
|
Next z
|
|
Return -1
|
|
End Function
|
|
|
|
Sub AllFactors(N As Ulongint,factors() As Ulongint)
|
|
Dim As String Sn=Str(n)
|
|
Dim As Integer half=Len(sn)\2
|
|
Redim factors(1 To 1)
|
|
#macro bsort(array)
|
|
For p1 As Integer = 1 To Ubound(array) - 1
|
|
For p2 As Integer = p1 + 1 To Ubound(array)
|
|
If array(p1)>array(p2) Then Swap array(p1),array(p2)
|
|
Next p2
|
|
Next p1
|
|
#endmacro
|
|
|
|
Dim As Ulongint c
|
|
For i As Ulongint = 1 To Sqr(N)
|
|
If N Mod i=0 Then
|
|
If Len(Str(i))=half Then
|
|
If WithinString(N,i) Then
|
|
c=c+1
|
|
Redim Preserve factors(1 To c)
|
|
factors(c)=i
|
|
End If
|
|
End If
|
|
If N <> i*i Then
|
|
If Len(Str(n\i))=half Then
|
|
If WithinString(N,n\i) Then
|
|
c=c+1
|
|
Redim Preserve factors(1 To c)
|
|
factors(c)=n\i
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next i
|
|
bsort(factors)
|
|
End Sub
|
|
|
|
Function VampireNumbers(N As Ulongint) As Integer
|
|
Dim As Integer flag
|
|
Dim As Ulongint LastFactor
|
|
Redim As Ulongint Factor()
|
|
AllFactors(N,Factor())
|
|
For p1 As Integer = 1 To Ubound(Factor)
|
|
For p2 As Integer=1 To Ubound(Factor)
|
|
If Factor(p1)*Factor(p2)=n Then
|
|
If Factor(p1) Mod 10<>0 Or Factor(p2) Mod 10 <>0 Then
|
|
If WithinString(n,valulng(Str(Factor(p1))+Str(Factor(p2)))) Then
|
|
If LastFactor=Factor(p2) Then Exit For,For
|
|
flag=1
|
|
Print n;": [";Factor(p1);",";Factor(p2);"]"
|
|
LastFactor=Factor(p1)
|
|
End If
|
|
End If
|
|
End If
|
|
Next p2
|
|
Next p1
|
|
If flag Then Return -1
|
|
End Function
|
|
|
|
'============== IMPLEMENT ==============================
|
|
print "First 28 Vampire numbers"
|
|
print
|
|
Print "Number: [fangs]"
|
|
Print
|
|
Dim As Ulongint n=1000
|
|
Dim As Integer count
|
|
Dim As Double t1,t2
|
|
t1=Timer
|
|
Do
|
|
n=n+1
|
|
Var s=Str(n)
|
|
If Len(s) Mod 2<>0 Then n=n*10
|
|
If vampireNumbers(n) Then count=count+1
|
|
Loop Until count=27
|
|
Print
|
|
print "Individual tests:"
|
|
print
|
|
'individual tests
|
|
n=16758243290880ull
|
|
If Not vampirenumbers(n) Then Print n;": [returns no fangs]"
|
|
Print
|
|
n=24959017348650ull
|
|
If Not vampirenumbers(n) Then Print n;": [returns no fangs]"
|
|
print
|
|
n=14593825548650ull
|
|
If Not vampirenumbers(n) then print n;": [returns no fangs]"
|
|
t2=Timer
|
|
print
|
|
Print "Completed in ";
|
|
Print t2-t1;" Seconds"
|
|
Sleep
|