Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Power Basic

Страница: 1 | 2 |

 

  Вопрос: (QuickSort and (PB vs VB6)) = VB6 - рулез Добавлено: 30.07.04 20:05  

Автор вопроса:  sne | Web-сайт: hw.t-k.ru | ICQ: 233286456 
Люди!!! CyRax, вы не поверите :) Или я не верю... То-ли я на VB хорошо програмлю а на PB совсем некудышно, то-ли руки не из того места растут, но факт остается фактом, только что при изучении метода быстрой сортировки VB в щепки разнес PB по скорости, отсортировав массив в 100 000 элементов менее чем за 80 мс... (у меня результат - 60 мс) против 200 мс, у PowerBasic'a...

PS

1. Исходник был один и тот же, ниже выложу к обоим компиляторам...

2. Замечено что в VB метод обмена значений переменных через XOR в разы быстрее, чем стандартный, через присвоение временной переменной одного из значений...

3. Замечено что в PB вышеуказанные два метода проходят, практически, с одинаковой скоростью... чем объяснить !? Сам не знаю...


Так что господа Гуру, попробуйте мне объяснить данный феномен...

Ответить

  Ответы Всего ответов: 24  

Номер ответа: 1
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #1
Добавлено: 30.07.04 20:05
' VB --------------------------

Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub Main()
    ;Dim i As Long, tmr As Long
    ;Dim TestArray() As Long
    ReDim TestArray(100000) As Long

    Call Randomize(Timer)
    For i = 0& To UBound(TestArray)
        TestArray(i) = Rnd * &H100000
    Next

    tmr = GetTickCount

    Call QSort(TestArray(), 0&, UBound(TestArray))

    tmr = GetTickCount - tmr
    MsgBox "Время сортировки 100 000 элементов: " & _
        Str$(tmr) & " ms."

    ;Dim nf As Integer
    nf = FreeFile
    Open "log.txt" For Binary Access Write Lock Read As nf
        For i = 0& To UBound(TestArray)
            Put nf, LOF(nf) + 1&, TestArray(i) & vbCrLf
        Next
    Close

    tmr = GetTickCount
    For i = 0 To UBound(TestArray) - 1&
        If TestArray(i) > TestArray(i + 1&;) Then _
            MsgBox "Массив не отсортирован :( " & Str$(i) & " " & Str$(TestArray(i)) & " " & Str$(TestArray(i + 1)): _
            Exit Sub
    Next

    tmr = GetTickCount - tmr
    MsgBox "Проверка массива на отсортированность завершена за: " & _
        Str$(tmr) & " ms."
End Sub

Sub FastSwap(ByRef First As Long, ByRef Second As Long)
    First = First Xor Second
    Second = Second Xor First
    First = First Xor Second
End Sub

Sub QSort(ByRef inArr() As Long, ByVal low As Long, ByVal high As Long)
    ;Dim scanUp As Long, scanDown As Long, _
        mid As Long, pivot As Long

    If Not (high - low > 0&;) Then
        Exit Sub


    ElseIf (high - low = 1&;) Then
        If (inArr(high) < inArr(low)) Then
            Call FastSwap(inArr(low), inArr(high))
            Exit Sub
        End If
    End If

    mid = (low + high) \ 2& ' Целочисленное деление работает шустрей
    pivot = inArr(mid)

    Call FastSwap(inArr(mid), inArr(low))

    scanUp = low + 1&
    scanDown = high

    ;Do
        ;Do Until ((scanUp > scanDown) Or (inArr(scanUp) > pivot))
            scanUp = scanUp + 1&
        Loop

        ;Do While (inArr(scanDown) > pivot)
            scanDown = scanDown - 1&
        Loop

        If (scanUp < scanDown) Then
            Call FastSwap(inArr(scanUp), inArr(scanDown))
        End If
    Loop While (scanUp < scanDown)

    inArr(low) = inArr(scanDown)
    inArr(scanDown) = pivot

    If (low < scanDown - 1) Then Call QSort(inArr(), low, scanDown - 1&;)
    If (scanDown + 1& < high) Then Call QSort(inArr(), scanDown + 1&, high)
End Sub

Ответить

Номер ответа: 2
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #2
Добавлено: 30.07.04 20:07
    #Compile Exe "QSort.exe"
    #Dim All

    #Include ";D:\PBWin70\WinAPI\Win32API.inc"

Function PBMain As Long
    Local i As Dword, tmr As Dword
    Local TestArray() As Long
    ReDim TestArray(100000) As Long

    Randomize(Timer)
    For i = 0& To UBound(TestArray)
        TestArray(i) = Rnd * &H100000
    Next

    tmr = GetTickCount

    Call QSort(TestArray(), 0&, UBound(TestArray))

    tmr = GetTickCount - tmr
    MsgBox "Время сортировки 100 000 элементов: " & _
        Str$(tmr) & " ms."

    ;Dim nf As Integer, str As String
    nf = FreeFile
    Open "log.txt" For Binary Access Write Lock Read As nf
        For i = 0& To UBound(TestArray)
            str = Str$(TestArray(i)) & $CrLf
            Put nf, Lof(nf) + 1&, str
        Next
    Close

    tmr = GetTickCount
    For i = 0 To UBound(TestArray) - 1&
        If TestArray(i) > TestArray(i + 1&;) Then _
            MsgBox "Массив не отсортирован :( " & Str$(i) & " " & Str$(TestArray(i)) & " " & Str$(TestArray(i+1)): _
            Exit Function
    Next

    tmr = GetTickCount - tmr
    MsgBox "Проверка массива на отсортированность завершена за: " & _
        Str$(tmr) & " ms."
End Function

Sub FastSwap(ByRef First As Long, ByRef Second As Long)
    First = First Xor Second
    Second = Second Xor First
    First = First Xor Second
End Sub

Sub QSort(ByRef inArr() As Long, ByVal low As Long, ByVal high As Long)
    Local scanUp As Dword, scanDown As Dword, _
          mid As Dword, pivot As Dword

    If Not (high - low > 0&;) Then
        Exit Sub


    ElseIf (high - low = 1&;) Then
        If (inArr(high) < inArr(low)) Then
            Call FastSwap(inArr(low), inArr(high))
            Exit Sub
        End If
    End If

    mid = (low + high) \ 2& ' Целочисленное деление работает шустрей
    pivot = inArr(mid)

    Call FastSwap(inArr(mid), inArr(low))

    scanUp = low + 1&
    scanDown = high

    ;Do
        ;Do Until ((scanUp > scanDown) Or (inArr(scanUp) > pivot))
            scanUp = scanUp + 1&
        Loop

        ;Do While (inArr(scanDown) > pivot)
            scanDown = scanDown - 1&
        Loop

        If (scanUp < scanDown) Then
            Call FastSwap(inArr(scanUp), inArr(scanDown))
        End If
    Loop While (scanUp < scanDown)

    inArr(low) = inArr(scanDown)
    inArr(scanDown) = pivot

    If (low < scanDown - 1) Then Call QSort(inArr(), low, scanDown - 1&;)
    If (scanDown + 1& < high) Then Call QSort(inArr(), scanDown + 1&, high)
End Sub

Ответить

Номер ответа: 3
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #3
Добавлено: 30.07.04 20:19
Откомпилированное добро:
ftp://crts.ru/sne/VB/QSort.zip

Ответить

Номер ответа: 4
Автор ответа:
 cresta



Вопросов: 117
Ответов: 1538
 Профиль | | #4 Добавлено: 30.07.04 22:26
sne, не надо добивать PB. Пусть живёт для разнообразия. А то после топика "ГЛЮК ИЛИ ОСОБЕННОСТЬ" вообще в этот форум никто не постил. По поводу теста:
1.Видимо значительная доля скорости достигается за счёт XOR. Ей ведь никакие VB-оболочки не нужны. Наипростейшая операция.
2.Если заменить QSort на ARRAY SORT inArr(), ASCEND, то PB уже быстрее сортирует 45 - 65 мс против 60 - 65 мс у VB.
3.Алгоритмов сортировки великое множество, возможно, для данного расположения элементов в массиве звёзды на небе стали благоприятно к VB/задницей к PB.
А как называется данный алгоритм?

Ответить

Номер ответа: 5
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #5
Добавлено: 30.07.04 23:03
К сожалению, я ничего не гажу, я констатирую факт :(

1. По-видимому, в PB XOR организован не лучшим образом :(

2. Видимо, это оптимизированная фишка... А вот кодом-то... выходит медленней :(

Самая быстрая сортировка, для большого кол-ва аргументов, а именно: быстрая сортировка... (QuickSort)

Скоро еще посмотрю на сортировку методом пирамиды и поразрядную (Radix)...

Потом мне это все нужно еще будет переписать на Дельфи, так что сравню еще и с ним... думаю на ассемблер это переписывать никому не надо... поэтому сэкономлю свое время и не стану ;)

Ответить

Номер ответа: 6
Автор ответа:
 cresta



Вопросов: 117
Ответов: 1538
 Профиль | | #6 Добавлено: 31.07.04 01:55
В masm32 Library тоже есть этот метод. Отдельной ф-цией.
SortDwordArray proc
LOCAL Members :DWORD
LOCAL ArrPointer :DWORD

invoke VirtualAlloc, NULL, 4000000, MEM_COMMIT, PAGE_READWRITE
mov ArrPointer, eax
mov Members,1000000
push edi
mov edi, ArrPointer
@Loop:
invoke GetTickCount
invoke nrandom,eax
stosd
dec Members
jnz @Loop
PrintLine
invoke GetTickCount
push eax
mov eax, ArrPointer
invoke nrQsortA,eax,1000000
invoke GetTickCount
pop edx
sub eax, edx
PrintDec eax
invoke VirtualFree, ArrPointer, 4000000, MEM_DECOMMIT

pop edi
ret

SortDwordArray endp

При 100000 разброс очень большой, со временем трудно определиться, поэтому довёл до 1000000. Время сортировки 200-220 мс. Предположительно при 100000 получится 20-22 мс.

Ответить

Номер ответа: 7
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #7
Добавлено: 31.07.04 02:41
Ну что же... значит VB в три-четыре раза уступает ассемблеру ;)
Не так и плохо :)

Ответить

Номер ответа: 8
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
 Web-сайт: basicproduction.nm.ru
 Профиль | | #8
Добавлено: 31.07.04 14:15
sne,
 Чего это у тебя счётчик объявлен как DWORD, а начало отсчёта 0&;(LONG):
Local i As Dword
    For i = 0& To UBound(TestArray)
Хотя думаю это не принципиально.

Ответить

Номер ответа: 9
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
 Web-сайт: basicproduction.nm.ru
 Профиль | | #9
Добавлено: 31.07.04 15:14
 Послал это добро на Powerbasic.com
 Пусть они там голову ломают.

Ответить

Номер ответа: 10
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #10
Добавлено: 31.07.04 15:23
:) глядишь и версия новенькая выйдет ;)
Вот только нам ее бесплатно все-равно не отдадут :(

А на счет счетчик - привычка :)

Ответить

Номер ответа: 11
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #11
Добавлено: 31.07.04 16:08
2cresta, самое удивительное что в хелпе есть, а в пакете nrQsortA нет...
все объискал... сейчас пойду еще раз скачаю...

Ответить

Номер ответа: 12
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #12
Добавлено: 31.07.04 16:20
скачал, обыскал еще раз, наешл :)

Ответить

Номер ответа: 13
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
 Web-сайт: basicproduction.nm.ru
 Профиль | | #13
Добавлено: 31.07.04 18:00
 sne,
 Твою проблему решили довольно быстро.
Вот ответ:
    Local scanUp As Long, scanDown As Long, mid As Long, pivot As Long

Ответить

Номер ответа: 14
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
 Web-сайт: basicproduction.nm.ru
 Профиль | | #14
Добавлено: 31.07.04 18:04
 PB: 285-350 мс.
 VB: 470-560 мс.

Ответить

Номер ответа: 15
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #15
Добавлено: 31.07.04 19:55
Хм... с чего бы это DWORD работает медленней LONG... Или беззнаковая арифметика на пару с переменными у него храмает ?
Ну да ладно, это уже больше походит на дело :)

А вот на счет МАСМ32... они его обновили... и молчат, партизаны...
Теперь он и устанавливается быстрее (инсталлер от 7zip) и макросов в нем поболее стало... раза в полтора :) ну и инстументы чуть обновились...

а вот компилятор все тот же... даже из 2003 студии брать не стали...

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам