Простые числа как двоичные палиндромы

[Sasha_Smirnov]

Option Explicit
Dim flags() As Boolean 'массив признаков того, что i-й элемент — число простое'
Dim numerator As Long 'счётчик искомых ("симметрично-простых") двоичных чисел'
Sub PrintAndCountMirrorBinaryPrimes()
'Программа печатает в документе Word все простые числа (до 100 000 000),'
'двоичное представление которых симметрично относительно их центра,'
'а заодно — их восьмеричные и десятеричные аналоги.'
'В VBA 5 функция StrReverse отсутствует, так что используйте VBA 6.'
Selection.HomeKey wdStory 'Курсор - в начало документа Word.'

Const top = 10000 'предложение по умолчанию'
Dim N As Long, i As Long, j As Long, qP As Long
N = Fix(Val(InputBox("До какого N?", "До N <= 100 000 001", Val(top))))
If N >= 3 And N < 10 ^ 8 + 2 Then _
ReDim flags(1 To N) As Boolean Else: MsgBox "Измените N.": Exit Sub

'Берём для начала все нечётные положительные числа, за исключением единицы.'
For i = 3 To N Step 2: flags(i) = True: Next i

For i = 3 To Fix(Sqr(N)) Step 2
    If flags(i) Then
    j = i + i
        Do While j <= N
        flags(j) = False 'Вырубаем из нечётного ряда чисел каждое j-е число (т. к. оно кратно i).'
        j = j + i
        Loop
    End If
Next i
'По сути, просеяли числа-кандидаты (нечётные) через решето Эратосфена.'

    Selection.TypeText _
    Chr(185) & vbTab & "Основания системы счисления" & vbLf & vbTab & "10" & _
    vbTab & "8" & vbTab & "2" & vbLf & String(32, "_") & vbLf & vbLf

For i = 3 To N:  qP= qP + IIf(flags(i) And IsMirrorBin(i), 1, 0): Next i 
'qP — кол-во чисел, простых и притом симметричных'

MsgBox "Среди чисел до " & N & " программа нашла простых: " & qP & "," & vbCr & _
"таких, что при записи их в двоичном представлении" & vbCr & "получаем симметричную строку."
numerator = 0 'сброс счётчика искомых чисел'

With Selection
    .HomeKey wdStory, wdExtend 'возврат в начало документа и его выделение'
    .MoveDown Count:=4, Extend:=wdExtend 'снятие выделения с 4 заголовочных строк'
'    .ConvertToTable 'преобразование вывода в таблицу Word (при желании)'
'    .ParagraphFormat.Alignment = wdAlignParagraphRight 'выравнивание (в таблице) вправо'
End With
End Sub



Function IsMirrorBin(ByRef i As Long) As Boolean
Dim d As Integer, OctMask As String, BinMask As String
OctMask = Oct(i) 'Сначала представляем в восьмеричном счислении...'

For d = Len(OctMask) To 1 Step -1 'Сканируем восьмеричную маску справа налево.'
BinMask = Choose(Mid$(OctMask, d, 1) + 1, _
"000", "001", "010", "011", "100", "101", "110", "111") & BinMask
'И заменяем соответственно цифры 0, 1, 2, 3, 4, 5, 6, 7 их двоичными аналогами.'
Next d

BinMask = Mid$(BinMask, InStr(BinMask, "1")) 'Убор начальных нулей из BinMask.'

If BinMask = StrReverse$(BinMask) Then
    If flags(i) Then: numerator = numerator + 1: Selection.TypeText _
    numerator & vbTab & i & vbTab & OctMask & vbTab & BinMask & vbCr  'Печать.'
    IsMirrorBin = True
End If
End Function

[Sasha_Smirnov]

№ Основания системы счисления
___ 10 _____8 ______2
________________________________

319 2031599 7577757 111101111111111101111

323 2067007 7705077 111111000101000111111

600 8358143 37704377 11111111000100011111111

601 16864513 100252401 1000000010101010100000001

690 19987993 114177031 1001100001111111000011001
<...>
1499 99125437 572104275 101111010001000100010111101
1500 99154109 572174275 101111010001111100010111101
1501 99220669 572376275 101111010011111110010111101
1502 99265213 572525275 101111010101010101010111101
1503 99353021 573000675 101111011000000000110111101
1504 99396029 573124675 101111011001010100110111101
1505 99416509 573174675 101111011001111100110111101
1506 99419581 573202675 101111011010000010110111101
1507 99448253 573272675 101111011010111010110111101
1508 99462589 573326675 101111011011010110110111101
1509 99614653 573777675 101111011111111111110111101
1510 99657853 574124175 101111100001010100001111101
1511 99670141 574154175 101111100001101100001111101
1512 99744893 574376175 101111100011111110001111101
1513 99940733 575174575 101111101001111100101111101

[Sasha_Smirnov]

Кстати, а что нам мешает сделать то же самое с десятеричными числами? Да ничего.

В функции (её название пока оставим IsMirrorBin) строку

If BinMask = StrReverse$(BinMask) Then

заменим на

If i = StrReverse(i) Then 'StrReverse$(i), как оказалось, работает с i несколько «тормознутее» '

или на

If OctMask = StrReverse$(OctMask) Then

Соответственно получим 10-чные или 8-ричные простые перевёртыши.
В частности, для N = 100 000, секунд за 10 вычисляется нижеследующее (№, 10-чный палиндром и его аналоги по основанию 8 и 2 соответственно).

1 3 3 11
2 5 5 101
3 7 7 111
4 11 13 1011
5 101 145 1100101
6 131 203 10000011
7 151 227 10010111
8 181 265 10110101
9 191 277 10111111
10 313 471 100111001
11 353 541 101100001
12 373 565 101110101
13 383 577 101111111
14 727 1327 1011010111
15 757 1365 1011110101
16 787 1423 1100010011
17 797 1435 1100011101
18 919 1627 1110010111
19 929 1641 1110100001
20 10301 24075 10100000111101
21 10501 24405 10100100000101
22 10601 24551 10100101101001
23 11311 26057 10110000101111
24 11411 26223 10110010010011
25 12421 30205 11000010000101
26 12721 30661 11000110110001
27 12821 31025 11001000010101
28 13331 32023 11010000010011
29 13831 33007 11011000000111
30 13931 33153 11011001101011
31 14341 34005 11100000000101
32 14741 34625 11100110010101
33 15451 36133 11110001011011
34 15551 36277 11110010111111
35 16061 37275 11111010111101
36 16361 37751 11111111101001
37 16561 40261 100000010110001
38 16661 40425 100000100010101
39 17471 42077 100010000111111
40 17971 43063 100011000110011
41 18181 43405 100011100000101
42 18481 44061 100100000110001
43 19391 45677 100101110111111
44 19891 46663 100110110110011
45 19991 47027 100111000010111
46 30103 72627 111010110010111
47 30203 72773 111010111111011
48 30403 73303 111011011000011
49 30703 73757 111011111101111
50 30803 74123 111100001010011
51 31013 74445 111100100100101
52 31513 75431 111101100011001
53 32323 77103 111111001000011
54 32423 77247 111111010100111
55 33533 101375 1000001011111101
56 34543 103357 1000011011101111
57 34843 104033 1000100000011011
58 35053 104355 1000100011101101
59 35153 104521 1000100101010001
60 35353 105031 1000101000011001
61 35753 105651 1000101110101001
62 36263 106647 1000110110100111
63 36563 107323 1000111011010011
64 37273 110631 1001000110011001
65 37573 111305 1001001011000101
66 38083 112303 1001010011000011
67 38183 112447 1001010100100111
68 38783 113577 1001011101111111
69 39293 114575 1001100101111101
70 70207 211077 10001001000111111
71 70507 211553 10001001101101011
72 70607 211717 10001001111001111
73 71317 213225 10001011010010101
74 71917 214355 10001100011101101
75 72227 215043 10001101000100011
76 72727 216027 10001110000010111
77 73037 216515 10001110101001101
78 73237 217025 10001111000010101
79 73637 217645 10001111110100101
80 74047 220477 10010000100111111
81 74747 221773 10010001111111011
82 75557 223445 10010011100100101
83 76367 225117 10010101001001111
84 76667 225573 10010101101111011
85 77377 227101 10010111001000001
86 77477 227245 10010111010100101
87 77977 230231 10011000010011001
88 78487 231227 10011001010010111
89 78787 231703 10011001111000011
90 78887 232047 10011010000100111
91 79397 233045 10011011000100101
92 79697 233521 10011011101010001
93 79997 234175 10011100001111101
94 90709 261125 10110001001010101
95 91019 261613 10110001110001011
96 93139 265723 10110101111010011
97 93239 266067 10110110000110111
98 93739 267053 10110111000101011
99 94049 267541 10110111101100001
100 94349 270215 10111000010001101
101 94649 270671 10111000110111001
102 94849 271201 10111001010000001
103 94949 271345 10111001011100101
104 95959 273327 10111011011010111
105 96269 274015 10111100000001101
106 96469 274325 10111100011010101
107 96769 275001 10111101000000001
108 97379 276143 10111110001100011
109 97579 276453 10111110100101011
110 97879 277127 10111111001010111
111 98389 300125 11000000001010101
112 98689 300601 11000000110000001