Rosetta Code

Rare numbers: Difference between revisions

Page Discussion

Rare numbers (view source)

Revision as of 23:54, 29 February 2020

16,096 bytes added ,  4 years ago
→‎{{header|Visual Basic .NET}}: added quicker version
m (→‎Quicker: updated output)
(→‎{{header|Visual Basic .NET}}: added quicker version)
Line 2,904:
 
=={{header|Visual Basic .NET}}==
===Traditional===
{{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
Line 3,100 ⟶ 3,101:
24: 441,054,594,034,340
25: 816,984,566,129,618</pre>
===Quicker===
{{trans|C#}} (translation of the quicker version)
 
Performance is better, only about 4% slower than '''C#'''.
<lang vbnet>Imports System.Math
Imports System.Console
Imports llst = System.Collections.Generic.List(Of Integer())
 
Module Module1
Dim d, dac As Integer(), drar As Integer() = New Integer(19) {} : Dim ac, pp As Long(), p As Long() = New Long(18) {}
Dim odd As Boolean = False : Dim sum, rt As Long : Dim ln, dl As Integer, cn As Integer = 0, nd As Integer = 2, nd1 As Integer = nd - 1
Dim sw As Stopwatch = New Stopwatch(), swt As Stopwatch = New Stopwatch() : Dim sr As List(Of Long) = New List(Of Long)()
ReadOnly tlo As Integer() = New Integer() {0, 1, 4, 5, 6}, all As Integer() = Seq(-9, 9), odl As Integer() = Seq(-9, 9, 2), evl As Integer() = Seq(-8, 8, 2),
thi As Integer() = New Integer() {4, 5, 6, 9, 10, 11, 14, 15, 16}, alh As Integer() = Seq(0, 18), odh As Integer() = Seq(1, 17, 2),
evh As Integer() = Seq(0, 18, 2), ten As Integer() = Seq(0, 9), z As Integer() = Seq(0, 0), t7 As Integer() = New Integer() {-3, 7}, nin As Integer() = New Integer() {9}, tn As Integer() = New Integer() {10}, t12 As Integer() = New Integer() {2, 12}, o11 As Integer() = New Integer() {1, 11}, pos As Integer() = New Integer() {0, 1, 4, 5, 6, 9}
Dim lu, l2 As llst, lul As llst = New llst From {z, odl, Nothing, Nothing, evl, t7, odl},
luh As llst = New llst From {tn, evh, Nothing, Nothing, evh, t12, odh, Nothing, Nothing, evh, nin, odh, Nothing, Nothing, odh, o11, evh},
l2l As llst = New llst From {pos, Nothing, Nothing, Nothing, all, Nothing, all},
l2h As llst = New llst From {Nothing, Nothing, Nothing, Nothing, alh, Nothing, alh, Nothing, Nothing, Nothing, alh, Nothing, Nothing, Nothing, alh, Nothing, alh}
Dim chTen As Integer()() = New Integer()() {New Integer() {0, 2, 5, 8, 9}, New Integer() {0, 3, 4, 6, 9}, New Integer() {1, 4, 7, 8},
New Integer() {2, 3, 5, 8}, New Integer() {0, 3, 6, 7, 9}, New Integer() {1, 2, 4, 7},
New Integer() {2, 5, 6, 8}, New Integer() {0, 1, 3, 6, 9}, New Integer() {1, 4, 5, 7}}
Dim chAH As Integer()() = New Integer()() {
New Integer() {0, 2, 5, 8, 9, 11, 14, 17, 18}, New Integer() {0, 3, 4, 6, 9, 12, 13, 15, 18}, New Integer() {1, 4, 7, 8, 10, 13, 16, 17},
New Integer() {2, 3, 5, 8, 11, 12, 14, 17}, New Integer() {0, 3, 6, 7, 9, 12, 15, 16, 18}, New Integer() {1, 2, 4, 7, 10, 11, 13, 16},
New Integer() {2, 5, 6, 8, 11, 14, 15, 17}, New Integer() {0, 1, 3, 6, 9, 10, 12, 15, 18}, New Integer() {1, 4, 5, 7, 10, 13, 14, 16}}
 
Function Seq(ByVal f As Integer, ByVal t As Integer, ByVal Optional s As Integer = 1) As Integer()
Dim r As Integer() = New Integer((t - f) / s + 1 - 1) {}
For i As Integer = 0 To r.Length - 1 : r(i) = f : f += s : Next : Return r : End Function
 
Function ISR(ByVal s As Long) As Long
Return Sqrt(s) : End Function
 
Function IsRev(ByVal nd As Integer, ByVal f As Long, ByVal r As Long) As Boolean
nd -= 1 : Return If(f \ p(nd) <> r Mod 10, False, (If(nd < 1, True, IsRev(nd, f Mod p(nd), r \ 10)))) : End Function
 
Sub RecurseLE5(ByVal lst As llst, ByVal lv As Integer)
If lv = dl Then
sum = ac(lv - 1) : If sum > 0 Then rt = CLng(Sqrt(sum)) : If rt * rt = sum Then sr.Add(sum)
Else For Each n As Integer In lst(lv)
d(lv) = n : If lv = 0 Then ac(0) = pp(0) * n Else ac(lv) = ac(lv - 1) + pp(lv) * n
RecurseLE5(lst, lv + 1) : Next : End If : End Sub
 
Sub Recursehi(ByVal lst As llst, ByVal lv As Integer)
Dim lv1 As Integer = lv - 1 : If lv = dl Then
sum = ac(lv1) : If (&H202021202030213 And (1L << (sum And 63))) > 0 Then rt = CLng(Sqrt(sum)) : If rt * rt = sum Then sr.Add(sum)
Else For Each n As Integer In lst(lv)
d(lv) = n : If lv = 0 Then ac(0) = pp(0) * n : dac(0) = drar(n) _
Else ac(lv) = ac(lv1) + pp(lv) * n : dac(lv) = dac(lv1) + drar(n) : If dac(lv) > 8 Then dac(lv) -= 9
Select Case lv
Case 0 : ln = n : lst(1) = lu(n) : lst(2) = l2(n)
Case 1 : Select Case ln
Case 5, 15 : lst(2) = If(n < 10, evh, odh)
Case 9 : lst(2) = If(((n >> 1) And 1) = 0, evh, odh)
Case 11 : lst(2) = If(((n >> 1) And 1) = 1, evh, odh)
End Select : End Select
If lv = dl - 2 Then lst(dl - 1) = If(odd, chTen(dac(dl - 2)), chAH(dac(dl - 2)))
Recursehi(lst, lv + 1) : Next : End If : End Sub
 
Sub Recurselo(ByVal lst As llst, ByVal lv As Integer)
Dim lv1 As Integer = lv - 1 : If lv = dl Then
sum = ac(lv1) : If sum > 0 Then rt = CLng(Sqrt(sum)) : If rt * rt = sum Then sr.Add(sum)
Else For Each n As Integer In lst(lv)
d(lv) = n : If lv = 0 Then ac(0) = pp(0) * n Else ac(lv) = ac(lv1) + pp(lv) * n
Select Case lv
Case 0 : ln = n : lst(1) = lu(n) : lst(2) = l2(n)
Case 1 : Select Case ln
Case 1 : lst(2) = If((((n + 9) >> 1) And 1) = 0, evl, odl)
Case 5 : lst(2) = If(n < 0, evl, odl)
End Select : End Select
Recurselo(lst, lv + 1) : Next : End If : End Sub
 
Function listEm(ByVal lst As llst, ByVal plu As llst, ByVal pl2 As llst) As List(Of Long)
dl = lst.Count : d = New Integer(dl - 1) {} : sr.Clear() : lu = plu : l2 = pl2
ac = New Long(dl - 1) {} : dac = New Integer(dl - 1) {} : pp = New Long(dl - 1) {}
Dim j As Integer = nd1 : For i As Integer = 0 To dl - 1 : pp(i) = If(lst(0).Length > 6, p(j) + p(i), p(j) - p(i)) : j -= 1 : Next
If nd <= 5 Then RecurseLE5(lst, 0) Else If lst(0).Length > 6 Then Recursehi(lst, 0) Else Recurselo(lst, 0)
Return sr : End Function
 
Sub Reveal(ByVal lo As List(Of Long), ByVal hi As List(Of Long))
Dim s As List(Of String) = New List(Of String)() : For Each l As Long In lo : For Each h As Long In hi
Dim r As Long = (h - l) \ 2, f As Long = h - r
If IsRev(nd, f, r) Then s.Add(String.Format("{0,20} {1,11} {2,10} ", f, ISR(h), ISR(l)))
Next : Next : s.Sort() : If s.Count > 0 Then _
For Each t As String In s : cn += 1 : Write("{0,2} {1}{2}", cn, t, If(t = s.Last(), "", vbLf)) : Next Else Write("{0,48}", "")
End Sub
 
Sub Main(ByVal args As String())
WriteLine("{0,3}{1,20} {2,11} {3,10} {4,4}{5,16} {6, 17}", "nth", "forward", "rt.sum", "rt.dif", "digs", "block time", "total time")
p(0) = 1 : Dim j As Integer = 0 : For i As Integer = 1 To p.Length - 1 : p(i) = p(j) * 10 : j = i : Next
For i As Integer = 0 To drar.Length - 1 : drar(i) = (i * 2) Mod 9 : Next
Dim lls As llst = New llst From {tlo}, hls As llst = New llst From {thi} : sw.Start() : swt.Start()
While nd <= 18
If nd > 2 Then If odd Then hls.Add(ten) Else lls.Add(all) : hls(hls.Count - 1) = alh
Reveal(listEm(lls, lul, l2l).ToList(), listEm(hls, luh, l2h))
If Not odd AndAlso nd > 5 Then hls(hls.Count - 1) = alh
WriteLine("{0,2}: {1} {2}", nd, sw.Elapsed, swt.Elapsed) : sw.Restart()
nd1 = nd : nd += 1 : odd = Not odd
End While
' 19
hls.Add(ten)
Reveal(listEmU(lls, lul, l2l).ToList(), listEmU(hls, luh, l2h))
WriteLine("{0,2}: {1} {2}", nd, sw.Elapsed, swt.Elapsed) : End Sub
#Region "19"
Dim usum, urt As ULong
Dim acu, ppu As ULong()
Dim sru As List(Of ULong) = New List(Of ULong)()
 
Sub Reveal(ByVal lo As List(Of ULong), ByVal hi As List(Of ULong))
Dim s As List(Of String) = New List(Of String)() : For Each l As ULong In lo : For Each h As ULong In hi
Dim r As ULong = (h - l) >> 1, f As ULong = h - r
If IsRev(nd, f, r) Then s.Add(String.Format("{0,20} {1,11} {2,10} ", f, ISR(h), ISR(l)))
Next : Next : s.Sort() : If s.Count > 0 Then _
For Each t As String In s : cn += 1 : Write("{0,2} {1}{2}", cn, t, If(t = s.Last(), "", vbLf)) : Next Else Write("{0,48}", "")
End Sub
 
Function listEmU(ByVal lst As llst, ByVal plu As llst, ByVal pl2 As llst) As List(Of ULong)
dl = lst.Count : d = New Integer(dl - 1) {} : sru.Clear() : lu = plu : l2 = pl2
acu = New ULong(dl - 1) {} : dac = New Integer(dl - 1) {} : ppu = New ULong(dl - 1) {}
Dim j As Integer = nd1 : For i As Integer = 0 To dl - 1 : ppu(i) = CULng(If(lst(0).Length > 6, p(j) + p(i), p(j) - p(i))) : j -= 1 : Next
If lst(0).Length > 8 Then RecurseUhi(lst, 0) Else RecurseUlo(lst, 0)
Return sru : End Function
 
Sub RecurseUhi(ByVal lst As llst, ByVal lv As Integer)
Dim lv1 As Integer = lv - 1 : If lv = dl Then
usum = acu(lv1)
If (&H202021202030213 And (1UL << (usum And 63))) <> 0 Then urt = Sqrt(usum) : If urt * urt = usum Then sru.Add(usum)
Else For Each n As Integer In lst(lv)
d(lv) = n : If lv = 0 Then
acu(0) = ppu(0) * CUInt(n) : dac(0) = drar(n)
Else
acu(lv) = If(n >= 0, acu(lv1) + ppu(lv) * CUInt(n), acu(lv1) - ppu(lv) * CUInt(-n))
dac(lv) = dac(lv1) + drar(n) : If dac(lv) > 8 Then dac(lv) -= 9
End If
Select Case lv
Case 0 : ln = n : lst(1) = lu(n) : lst(2) = l2(n)
Case 1 : Select Case ln
Case 5, 15 : lst(2) = If(n < 10, evh, odh)
Case 9 : lst(2) = If(((n >> 1) And 1) = 0, evh, odh)
Case 11 : lst(2) = If(((n >> 1) And 1) = 1, evh, odh)
End Select : End Select
If lv = dl - 2 Then lst(dl - 1) = If(odd, chTen(dac(dl - 2)), chAH(dac(dl - 2)))
RecurseUhi(lst, lv + 1) : Next : End If : End Sub
 
Sub RecurseUlo(ByVal lst As llst, ByVal lv As Integer)
Dim lv1 As Integer = lv - 1 : If lv = dl Then
usum = acu(lv1)
If usum > 0 Then urt = Sqrt(usum) : If urt * urt = usum Then sru.Add(usum)
Else For Each n As Integer In lst(lv)
d(lv) = n : If lv = 0 Then acu(0) = ppu(0) * CUInt(n) Else _
acu(lv) = If(n >= 0, acu(lv1) + ppu(lv) * CUInt(n), acu(lv1) - ppu(lv) * CUInt(-n))
Select Case lv
Case 0 : ln = n : lst(1) = lu(n) : lst(2) = l2(n)
Case 1 : Select Case ln
Case 1 : lst(2) = If((((n + 9) >> 1) And 1) = 0, evl, odl)
Case 5 : lst(2) = If(n < 0, evl, odl)
End Select : End Select
RecurseUlo(lst, lv + 1) : Next : End If : End Sub
 
Function ISR(ByVal s As ULong) As ULong
Return Sqrt(s) : End Function
 
Function IsRev(ByVal nd As Integer, ByVal f As ULong, ByVal r As ULong) As Boolean
nd -= 1 : Return If(f \ CULng(p(nd)) <> r Mod 10, False, (If(nd < 1, True, IsRev(nd, f Mod CULng(p(nd)), r \ 10UL)))) : End Function
#End Region
End Module</lang>
Results on the core i7-7700 @ 3.6Ghz.
<pre style="height:64ex;overflow:scroll">nth forward rt.sum rt.dif digs block time total time
1 65 11 3 2: 00:00:00.0037657 00:00:00.0037657
3: 00:00:00.0001034 00:00:00.0040327
4: 00:00:00.0000951 00:00:00.0042102
5: 00:00:00.0000928 00:00:00.0043867
2 621770 836 738 6: 00:00:00.0022229 00:00:00.0066922
7: 00:00:00.0001703 00:00:00.0069250
8: 00:00:00.0002647 00:00:00.0072713
3 281089082 23708 330 9: 00:00:00.0013320 00:00:00.0086847
4 2022652202 63602 300
5 2042832002 63602 6360 10: 00:00:00.0043004 00:00:00.0130515
11: 00:00:00.0202717 00:00:00.0334094
6 868591084757 1275175 333333
7 872546974178 1320616 32670
8 872568754178 1320616 33330 12: 00:00:00.0553298 00:00:00.0889160
9 6979302951885 3586209 1047717 13: 00:00:00.3615348 00:00:00.4505467
10 20313693904202 6368252 269730
11 20313839704202 6368252 270270
12 20331657922202 6368252 329670
13 20331875722202 6368252 330330
14 20333875702202 6368252 336330
15 40313893704200 6368252 6330336
16 40351893720200 6368252 6336336 14: 00:00:00.9808061 00:00:01.4315251
17 200142385731002 20006998 69300
18 204238494066002 20122102 1891560
19 221462345754122 21045662 69300
20 244062891224042 22011022 1908060
21 245518996076442 22140228 921030
22 248359494187442 22206778 1891560
23 403058392434500 20211202 19940514
24 441054594034340 22011022 19940514
25 816984566129618 40421606 250800 15: 00:00:06.8062687 00:00:08.2378833
26 2078311262161202 64030648 7529850
27 2133786945766212 65272218 2666730
28 2135568943984212 65272218 3267330
29 2135764587964212 65272218 3326670
30 2135786765764212 65272218 3333330
31 4135786945764210 65272218 63333336
32 6157577986646405 105849161 33333333
33 6889765708183410 83866464 82133718
34 8052956026592517 123312255 29999997
35 8052956206592517 123312255 30000003
36 8191154686620818 127950856 3299670
37 8191156864620818 127950856 3300330
38 8191376864400818 127950856 3366330
39 8650327689541457 127246955 33299667
40 8650349867341457 127246955 33300333 16: 00:00:18.5333654 00:00:26.7713563
41 22542040692914522 212329862 333300
42 67725910561765640 269040196 251135808
43 86965750494756968 417050956 33000 17: 00:02:08.5301411 00:02:35.3016150
44 225342456863243522 671330638 297000
45 225342458663243522 671330638 303000
46 225342478643243522 671330638 363000
47 284684666566486482 754565658 30000
48 284684868364486482 754565658 636000
49 297128548234950692 770186978 32697330
50 297128722852950692 770186978 32702670
51 297148324656930692 770186978 33296670
52 297148546434930692 770186978 33303330
53 497168548234910690 770186978 633363336
54 619431353040136925 1071943279 299667003
55 619631153042134925 1071943279 300333003
56 631688638047992345 1083968809 297302703
57 633288858025996145 1083968809 302637303
58 633488632647994145 1083968809 303296697
59 653488856225994125 1083968809 363303363
60 811865096390477018 1273828556 33030330
61 865721270017296468 1315452006 32071170
62 871975098681469178 1320582934 3303300
63 898907259301737498 1339270086 64576740 18: 00:05:50.9239434 00:08:26.2256326
64 2042401829204402402 2021001202 18915600
65 2060303819041450202 2020110202 199405140
66 2420424089100600242 2200110022 19080600
67 2551755006254571552 2259094848 693000
68 2702373360882732072 2324811012 693000
69 2825378427312735282 2377130742 2508000
70 6531727101458000045 3454234451 1063822617
71 6988066446726832640 2729551744 2554541088
72 8066308349502036608 4016542096 2508000
73 8197906905009010818 4046976144 133408770
74 8200756128308135597 4019461925 495417087
75 8320411466598809138 4079154376 36366330 19: 00:45:09.0009635 00:53:36.4768204</pre>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/293931"