Rare numbers: Difference between revisions
Added Visual Basic .NET version
m (→{{header|C#}}: updated output to 19 digits, edited performance remarks) |
(Added Visual Basic .NET version) |
||
Line 888:
8th rare number is: 872,568,754,178
</pre>
=={{header|Visual Basic .NET}}==
{{trans|C#}} via {{trans|Go}} Surprisingly slow, I expected performance to be a little slower than C#, but this is quite a bit slower. This vb.net version takes 1 2/3 minutes to do what the C# version can do in 2/3 of a minute.
<lang vbnet>Imports System.Console
Imports DT = System.DateTime
Imports Lsb = System.Collections.Generic.List(Of SByte)
Imports Lst = System.Collections.Generic.List(Of System.Collections.Generic.List(Of SByte))
Imports UI = System.UInt64
Module Module1
Const MxD As SByte = 15
Public Structure term
Public coeff As UI : Public a, b As SByte
Public Sub New(ByVal c As UI, ByVal a_ As Integer, ByVal b_ As Integer)
coeff = c : a = CSByte(a_) : b = CSByte(b_)
End Sub
End Structure
Dim nd, nd2, count As Integer, digs, cnd, di As Integer()
Dim res As List(Of UI), st As DT, tLst As List(Of List(Of term))
Dim lists As List(Of Lst), fml, dmd As Dictionary(Of Integer, Lst)
Dim dl, zl, el, ol, il As Lsb, odd As Boolean, ixs, dis As Lst, Dif As UI
' converts digs array to the "difference"
Function ToDif() As UI
Dim r As UI = 0 : For i As Integer = 0 To digs.Length - 1 : r = r * 10 + digs(i)
Next : Return r
End Function
' converts digs array to the "sum"
Function ToSum() As UI
Dim r As UI = 0 : For i As Integer = digs.Length - 1 To 0 Step -1 : r = r * 10 + digs(i)
Next : Return Dif + (r << 1)
End Function
' determines if the nmbr is square or not
Function IsSquare(nmbr As UI) As Boolean
If (&H202021202030213 And (1UL << (nmbr And 63))) <> 0 Then _
Dim r As UI = Math.Sqrt(nmbr) : Return r * r = nmbr Else Return False
End Function
'// returns sequence of SBbytes
Function Seq(from As SByte, upto As Integer, Optional stp As SByte = 1) As Lsb
Dim res As Lsb = New Lsb()
For item As SByte = from To upto Step stp : res.Add(item) : Next : Return res
End Function
' Recursive closure to generate (n+r) candidates from (n-r) candidates
Sub Fnpr(ByVal lev As Integer)
If lev = dis.Count Then
digs(ixs(0)(0)) = fml(cnd(0))(di(0))(0) : digs(ixs(0)(1)) = fml(cnd(0))(di(0))(1)
Dim le As Integer = di.Length, i As Integer = 1
If odd Then le -= 1 : digs(nd >> 1) = di(le)
For Each d As SByte In di.Skip(1).Take(le - 1)
digs(ixs(i)(0)) = dmd(cnd(i))(d)(0)
digs(ixs(i)(1)) = dmd(cnd(i))(d)(1) : i += 1 : Next
If Not IsSquare(ToSum()) Then Return
res.Add(ToDif()) : count += 1
WriteLine("{0,16:n0}{1,4} ({2:n0})", (DT.Now - st).TotalMilliseconds, count, res.Last())
Else
For Each n In dis(lev) : di(lev) = n : Fnpr(lev + 1) : Next
End If
End Sub
' Recursive closure to generate (n-r) candidates with a given number of digits.
Sub Fnmr(ByVal list As Lst, ByVal lev As Integer)
If lev = list.Count Then
Dif = 0 : Dim i As SByte = 0 : For Each t In tLst(nd2)
If cnd(i) < 0 Then Dif -= t.coeff * CULng(-cnd(i)) _
Else Dif += t.coeff * CULng(cnd(i))
i += 1 : Next
If Dif <= 0 OrElse Not IsSquare(Dif) Then Return
dis = New Lst From {Seq(0, fml(cnd(0)).Count - 1)}
For Each i In cnd.Skip(1) : dis.Add(Seq(0, dmd(i).Count - 1)) : Next
If odd Then dis.Add(il)
di = New Integer(dis.Count - 1) {} : Fnpr(0)
Else
For Each n As SByte In list(lev) : cnd(lev) = n : Fnmr(list, lev + 1) : Next
End If
End Sub
Sub init()
Dim pow As UI = 1
' terms of (n-r) expression for number of digits from 2 to maxDigits
tLst = New List(Of List(Of term))() : For Each r As Integer In Seq(2, MxD)
Dim terms As List(Of term) = New List(Of term)()
pow *= 10 : Dim p1 As UI = pow, p2 As UI = 1
Dim i1 As Integer = 0, i2 As Integer = r - 1
While i1 < i2 : terms.Add(New term(p1 - p2, i1, i2))
p1 = p1 / 10 : p2 = p2 * 10 : i1 += 1 : i2 -= 1 : End While
tLst.Add(terms) : Next
' map of first minus last digits for 'n' to pairs giving this value
fml = New Dictionary(Of Integer, Lst)() From {
{0, New Lst() From {New Lsb() From {2, 2}, New Lsb() From {8, 8}}},
{1, New Lst() From {New Lsb() From {6, 5}, New Lsb() From {8, 7}}},
{4, New Lst() From {New Lsb() From {4, 0}}},
{6, New Lst() From {New Lsb() From {6, 0}, New Lsb() From {8, 2}}}}
' map of other digit differences for 'n' to pairs giving this value
dmd = New Dictionary(Of Integer, Lst)()
For i As SByte = 0 To 10 - 1 : Dim j As SByte = 0, d As SByte = i
While j < 10 : If dmd.ContainsKey(d) Then dmd(d).Add(New Lsb From {i, j}) _
Else dmd(d) = New Lst From {New Lsb From {i, j}}
j += 1 : d -= 1 : End While : Next
dl = Seq(-9, 9) ' all differences
zl = Seq(0, 0) ' zero difference
el = Seq(-8, 8, 2) ' even differences
ol = Seq(-9, 9, 2) ' odd differences
il = Seq(0, 9)
lists = New List(Of Lst)()
For Each f As SByte In fml.Keys : lists.Add(New Lst From {New Lsb From {f}}) : Next
End Sub
Sub Main(ByVal args As String())
init() : res = New List(Of UI)() : st = DT.Now : count = 0
WriteLine("{0,5}{1,12}{2,4}{3,14}", "digs", "elapsed(ms)", "R/N", "Rare Numbers")
nd = 2 : nd2 = 0 : odd = False : While nd <= MxD
digs = New Integer(nd - 1) {} : If nd = 4 Then
lists(0).Add(zl) : lists(1).Add(ol) : lists(2).Add(el) : lists(3).Add(ol)
ElseIf tLst(nd2).Count > lists(0).Count Then
For Each list As Lst In lists : list.Add(dl) : Next : End If
ixs = New Lst() : For Each t As term In tLst(nd2) : ixs.Add(New Lsb From {t.a, t.b}) : Next
For Each list As Lst In lists : cnd = New Integer(list.Count - 1) {} : Fnmr(list, 0) : Next
WriteLine(" {0,2} {1,10:n0}", nd, (DT.Now - st).TotalMilliseconds)
nd += 1 : nd2 += 1 : odd = Not odd : End While
res.Sort() : WriteLine(vbLf & "The {0} rare numbers with up to {1} digits are:", res.Count, MxD)
count = 0 : For Each rare In res : count += 1 : WriteLine("{0,2}:{1,27:n0}", count, rare) : Next
If System.Diagnostics.Debugger.IsAttached Then ReadKey()
End Sub
End Module</lang>
{{out}}
<pre style="height:64ex;overflow:scroll"> digs elapsed(ms) R/N Rare Numbers
25 1 (65)
2 26
3 26
4 27
5 27
28 2 (621,770)
6 29
7 30
8 41
42 3 (281,089,082)
9 46
47 4 (2,022,652,202)
116 5 (2,042,832,002)
10 273
11 422
1,363 6 (872,546,974,178)
1,476 7 (872,568,754,178)
2,937 8 (868,591,084,757)
12 3,584
4,560 9 (6,979,302,951,885)
13 5,817
18,234 10 (20,313,693,904,202)
18,471 11 (20,313,839,704,202)
23,626 12 (20,331,657,922,202)
24,454 13 (20,331,875,722,202)
26,599 14 (20,333,875,702,202)
60,784 15 (40,313,893,704,200)
61,246 16 (40,351,893,720,200)
14 65,387
65,465 17 (200,142,385,731,002)
66,225 18 (221,462,345,754,122)
76,417 19 (816,984,566,129,618)
81,727 20 (245,518,996,076,442)
82,461 21 (204,238,494,066,002)
82,694 22 (248,359,494,187,442)
83,729 23 (244,062,891,224,042)
99,241 24 (403,058,392,434,500)
100,009 25 (441,054,594,034,340)
15 104,207
The 25 rare numbers with up to 15 digits are:
1: 65
2: 621,770
3: 281,089,082
4: 2,022,652,202
5: 2,042,832,002
6: 868,591,084,757
7: 872,546,974,178
8: 872,568,754,178
9: 6,979,302,951,885
10: 20,313,693,904,202
11: 20,313,839,704,202
12: 20,331,657,922,202
13: 20,331,875,722,202
14: 20,333,875,702,202
15: 40,313,893,704,200
16: 40,351,893,720,200
17: 200,142,385,731,002
18: 204,238,494,066,002
19: 221,462,345,754,122
20: 244,062,891,224,042
21: 245,518,996,076,442
22: 248,359,494,187,442
23: 403,058,392,434,500
24: 441,054,594,034,340
25: 816,984,566,129,618</pre>
| |||