Любителям тестировать код: разложение на множители

[Sasha_Smirnov]

Sub JustFrac()
'Делит выделенное целое число на его наименьший простой делитель.'
'Когда само это число простое и > 10 000 000, этот алгоритм слишком долог.'

Static NextRun As Boolean, isHexN As Boolean
Dim i As Variant, N As Variant, n2 As Variant, as_3_5_7 As Integer, answer As Long
Dim proportion As Variant, radical As Variant
Dim d0 As Date, t0 As Date, t01 As Single, d1 As Date, t1 As Date, t02 As Single
Dim dumn0 As String, dumn As String

ActiveWindow.ActivePane.View.ShowAll = False 'отключаем отображение знаков пробела'

dumn0 = Selection.Text 'выделенный вами/программой текст (предположительно с числом!)'
If Asc(LTrim(dumn0)) < 48 Then dumn0 = 8 'если выделен невменяемый (нецифробуквенный) текст'

For i = 1 To Len(dumn0)
    If Mid(dumn0, i, 1) Like "[0-9A-Fa-f]" Then dumn = dumn & Mid(dumn0, i, 1)
    If Mid(dumn0, i, 1) Like "[A-Fa-f]" Then isHexN = True
Next    'убрали из числа (делимого) пробелы, табуляции, знаки абзаца и разделители разрядов'



With Selection
    .EndKey unit:=wdStory   'курсор - в конец файла'
    .TypeParagraph              'печать абзаца'
    
N = InputBox("What is your N?", ActiveDocument, dumn)   'ввод N'
If N = vbNullString Then Exit Sub

If Not NextRun Then
    If Not isHexN Then answer = MsgBox("16-ричное будем делить?", vbYesNo + vbDefaultButton2)
    If answer = vbYes Then isHexN = True
End If

If IsNumeric(N) Or isHexN Then
    If isHexN Then 'преобразование введённого числа в число типа Decimal (29 десятичн. знаков)'
    If Len(N) < 12 Then N = CDec("&H" & UCase(N)) Else MsgBox "It’s too big.": isHexN = False: Exit Sub
    Else
    N = CDec(N)
    End If
    radical = Sqr(N) 'квадратный корень (при "зависании" i должно его превзойти, тогда всё OK)'
Else
    MsgBox "Alas, not numeric!": Exit Sub
End If
End With


MsgBox "square radical(" & N & ") " & IIf(radical = Fix(radical), "= ", "~ ") & radical
If N = 1 Or N = 0 Then isHexN = False: Exit Sub
                            
                            d0 = Date: t0 = Time: t01 = Timer 'ЗАСЕКЛИ ВРЕМЯ'

i = 0
n2 = N

        proportion = N / 2
Do
        If proportion = Fix(proportion) Then
            Selection.TypeParagraph
            Selection.TypeText n2 & " = " & 2 & "·" & n2 / 2
            n2 = n2 / 2
            proportion = n2 / 2
            i = i + 1
        Else: If i = Empty Then Exit Do Else i = 2 ^ i: GoTo CHRONOS
        End If
Loop

i = 0
For as_3_5_7 = 3 To 7 Step 2
        
                proportion = N / as_3_5_7
        Do
            If proportion = Fix(proportion) Then
                Selection.TypeParagraph
                Selection.TypeText n2 & " = " & as_3_5_7 & "·" & n2 / as_3_5_7
                n2 = n2 / as_3_5_7
                proportion = n2 / as_3_5_7
                i = i + 1
            Else: If i = Empty Then Exit Do Else i = as_3_5_7 ^ i: GoTo CHRONOS
            End If
        Loop
Next



'Подошли наконец к тому, что этот делитель нечётный и больше 7.'

i = 11

Do
        proportion = N / i
    If proportion = Fix(proportion) Then
        Selection.TypeParagraph
        Selection.TypeText N & " = " & i & "·" & N / i
        Exit Do
    End If
    i = i + 2
Loop


CHRONOS:                    d1 = Date: t1 = Time: t02 = Timer 'ВРЕМЯ ОКОНЧАНИЯ'

If i > 1 Then MsgBox N & " devided by " & "i (i = " & i & ")." Else Exit Sub

If Abs(t02 - t01) > 0.001 And N > 0 Then _
    MsgBox "Start:" & vbTab & "date = " & Format(d0, "yyyy-mm-dd") & vbLf & _
    vbTab & "time = " & Format(t0, "H:nn:ss") & vbLf & vbLf & _
        "Ready:" & vbTab & "date = " & Format(d1, "yyyy-mm-dd") & vbLf & _
    vbTab & "time = " & Format(t1, "H:nn:ss") & vbLf & vbLf & _
        "Total (by date):" & vbTab & DateDiff("s", t0, t1) & " second(s)" & vbLf & _
        "Total (by time):" & _
    vbTab & _
    IIf(t02 >= t01, FormatNumber(t02 - t01, 2), FormatNumber(t02 + 86400 - t01, 2)) _
    & " second(s)" & vbLf & _
    vbTab & "(if totally less than 1 day)" & vbLf & vbLf & _
"Average speed:" & vbTab & FormatNumber(i / (t02 - t01) / 10 ^ 6, 2) & vbLf & vbTab & vbTab & _
"m i l l i o n  numbers  per 1 second" & vbLf & vbTab & vbTab & _
"(миллиона чисел за 1 секунду)"

Selection.MoveLeft wdWord, 1, wdExtend 'выделили напечатанное частное (от деления N на i)'
If Not NextRun Then NextRun = True
Call JustFrac 'продолжение'
End Sub

[Sasha_Smirnov]

Ещё бы двоичные числа делить...
А шестнадцатеричные, как оказалось, Word «переваривает» вплоть до FFF FFFF FFFF FFFF.
Так что Len(N) < 12 — это я перестраховался! Поэтому (и не только) ту строчку заменим на

    If Len(N) < 16 Then N = CDec("&H" & UCase(N)): isHexN = False Else MsgBox "It’s too big.": Exit Sub

[viter.alex]

Сообщение от Sasha_Smirnov

Что-то при импорте в форум выделения цветом не происходит. Ну не суть!

Я спрашивал об этом у админа, говорит, что VB не поддерживаестя

[Sasha_Smirnov]

Так это и без вопросов было ясно! Его изучают одиночки.
Испытали бы вы лучше мой "дрынолёт"!

[viter.alex]

Сообщение от Sasha_Smirnov

Так это и без вопросов было ясно! Его изучают одиночки.
Испытали бы вы лучше мой "дрынолёт"!

Ну, не сердись «Дрынолет» хорош. Только поздно уже для теоретической математики (для прикладной тоже). Завтра посмотрим (хотя уже сегодня)

[viter.alex]

Посмотрел, интересно. Не пойму как работает вот это:

If Asc(LTrim(dumn0)) < 48 Then dumn0 = 8 'если выделен невменяемый (нецифробуквенный) текст'

[Sasha_Smirnov]

А это вставляет "8" в инпутбокс, когда вы в тексте не выделили число.
Практически, заглушка. (48 — [юни]код нуля, а меньше — цифр нет.)

Здравствуйте, отпускники и трудоголики!

Обнаружил свою не закрытую пока тему и решил её развить.

Оказалось, что на это нужно целых полчаса (из которых %50 ушло на поиск кода кнопки*, запускающей макрос)!

Отсюда напрашивается вывод, что до сих пор тема как следует не работала, несмотря на 430 просмотров, — не зная ничего о том, как работает VBA, мало кто сподобится самостоятельно использовать вышеприведённый код.

Посему и прилагаю его в документе.


___________________________
* © Капитан Немо
* О запуске программы (любого макроса), если такой кнопки нет, смотрите здесь (абзац 3).

Пришлось код кнопки несколько дополнить (см. внутри, по альт-F11).

Иначе выделенное в тексте число не разлагалось на множители.

Есть тут (внизу, в похожих темах) подобная программка от Kostia, но там предел 32767 (тип интэджер), и я не могу сравнить быстродействие. Моя же делит тип дэсимал (29 десятичных знаков) и за секунду перебирает (в обратной зависимости от введённого предела) от 3 млн до 100 тыс. делителей (пропуская, конечно, чётные).

Было бы любопытно посмотреть то же самое на Си, приложите экзешник, если есть.

О количестве простых чисел можно узнать и вот здесь.

P/s: говорят, что VBA язык очень медленный, и хочу понять — насколько. И наверно, не я один.

Замечу, что на сайте http://ru.numberempire.com/numberfactorizer.php допустимая длина числа 60 цифр!

И работает (раскладывает на множители) довольно быстро.

[Saggio]

Сообщение от Sasha_Smirnov

Замечу, что на сайте http://ru.numberempire.com/numberfactorizer.php допустимая длина числа 60 цифр!

И работает (раскладывает на множители) довольно быстро.

Добрый вечер. а как Вам написать личное сообщение?

[Sasha_Smirnov]

А никак. Пишите по теме что-нибудь. Спасибо за интерес.