FC2ブログ

FreeBASIC 学習:QSort - CRT 改造版

2019-08-21 :  PCクリニック
FreeBASIC では、ソートはどうする?

と云うことで、

「FreeBASIC qsort」検索を行って、
Sort Array - freebasic.net」を見つけた。

これの[1番目]は、
  I found the code in JustBasic. Works like a quick.
  On my computer, sorted 1000000 for 0.22 .... second.
  Someone can offer a faster version?


[2番目] は コード ( [3番目]も同一 ):
Dim As UInteger MaxSize = 2000000
Dim Shared NumArray(MaxSize) As UInteger
Randomize Timer
Sub Qsort(start As Integer,Finish As UInteger)
Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A
While I <= J
While NumArray(I) < X
I+=1
Wend
While NumArray(J) > X
J-=1
Wend
If I<=J Then
A = NumArray(I)
NumArray(I) = NumArray(J)
NumArray(J) = A
I+=1
J-=1
EndIf
Wend
If J > Start Then Qsort(start,J)
If I < Finish Then Qsort(I,Finish)
End Sub

Sub ASM_QSort(a() As Integer, l As Integer, r As Integer)
Dim As Integer i=l, j=r, x=a((l+r)\2)
Asm
QS_L0: 'Do
mov ecx, [a]
mov ecx, [ecx]
QS_L1:
mov ebx, [i]
lea edi, [ecx+ebx*4]
mov ebx, [x]
cmp [edi], ebx 'While a(i) jge QS_L2
inc dword ptr [i] 'i+=1
jmp QS_L1
QS_L2:
mov ebx, [j]
lea esi, [ecx+ebx*4]
mov eax, [esi]
cmp [x], eax 'While x jge QS_L3
dec dword ptr [j] 'j-=1
jmp QS_L2
QS_L3:
cmp [i], ebx 'If i<=j Then
jg QS_L4
mov eax, [edi] 'Swap a(i), a(j)
xchg eax, [esi]
mov [edi], eax
inc dword ptr [i] 'i+=1
dec dword ptr [j] 'j-=1
QS_L4:
cmp [i], ebx 'Loop Until i>j
jle QS_L0
End Asm
If l If iEnd Sub

Sub RapidSort (Item()As Integer, LoElement As Integer, HiElement As Integer)
Dim As Integer n, wert, nptr, arr, rep, LoVal, HiVal
LoVal=Item(LoElement)
HiVal=Item(HiElement)
For n=LoElement To HiElement
If LoVal> Item(n) Then LoVal=Item(n)
If HiVal< Item(n) Then HiVal=Item(n)
Next
ReDim SortArray(LoVal To HiVal) As Integer
For n=LoElement To HiElement
wert=Item(n)
SortArray(wert)=SortArray(wert)+1
Next
nptr=LoElement-1
For arr=LoVal To HiVal
rep=SortArray(arr)
For n=1 To rep
nptr=nptr+1
Item(nptr)=arr
Next
Next
Erase SortArray
End Sub

Dim t As Double
Print "Qsort ";
For I As Integer=1 To MaxSize
NumArray(I) = Int(Rnd*MaxSize)
Next
t=Timer
Qsort(1,MaxSize)
?Timer-t

Print "ASM_QSort ";
For I As Integer=1 To MaxSize
NumArray(I) = Int(Rnd*MaxSize)
Next
t=Timer
ASM_QSort(NumArray(),1,MaxSize)
?Timer-t

Print "RapidSort ";
For I As Integer=1 To MaxSize
NumArray(I) = Int(Rnd*MaxSize)
Next
t=Timer
RapidSort(NumArray(),1,MaxSize)
?Timer-t
Sleep
コンパイル/リンク OK
そして、実行
     QSort 0.35
     ASM_QSort 0.31
     RapidSort 0.055


[4番目]
  RapidSort is good! Thanks.

  Yes because 'RapidSort' algorithm is optimized for the particular case
   where the variables are integers.
  The principle is to compute the distribution 'SortArray()' of
   the variables to order.


[5番目]~[7番目] : 上記のディスカッション


[8番目]
  The CRT qsort function implements a compiler-optimized,
  non-recursive quick sort-insertion sort hybrid,
  that despite having to call a separate function for each comparison is
  much faster than your simple recursive version.
 ===
  CRTのqsort関数は、コンパイラごとに最適化された、
  非再帰的なクイックソート - 挿入ソートハイブリッドを実装していますが、
  比較ごとに別々の関数を呼び出す必要があるにもかかわらず、
  単純な再帰バージョンよりはるかに高速です。

 そのコード:
''==========================================
#include "crt.bi"
''==========================================
Dim As UInteger MaxSize = 1000000
Dim Shared NumArray(MaxSize) As UInteger
Randomize Timer
''==========================================

function compare naked cdecl( byval elem1 as any ptr, _
byval elem2 as any ptr ) as integer
asm
mov ecx, [esp+4]
mov edx, [esp+8]
mov eax, [ecx]
sub eax, [edx]
ret
end asm
end function

''==========================================

Sub _Qsort(start As Integer,Finish As UInteger)
Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A
While I <= J
While NumArray(I) < X
I+=1
Wend
While NumArray(J) > X
J-=1
Wend
If I<=J Then
A = NumArray(I)
NumArray(I) = NumArray(J)
NumArray(J) = A
I+=1
J-=1
EndIf
Wend
If J > Start Then _Qsort(start,J)
If I < Finish Then _Qsort(I,Finish)
End Sub

''==========================================
/' ------------------------------------
Print "Unsorted Array"
For I As Integer=1 To MaxSize
NumArray(I) = Int(Rnd*100)
Print NumArray(I);" ";
Next
print
_Qsort(1,MaxSize)
Print "Sorted Array"
For I As Integer=1 To MaxSize
Print NumArray(I);" ";
Next
print

Print "Unsorted Array"
For I As Integer=1 To MaxSize
NumArray(I) = Int(Rnd*100)
Print NumArray(I);" ";
Next
print
qsort( @NumArray(1), MaxSize, 4, @compare )
Print "Sorted Array"
For I As Integer=1 To MaxSize
Print NumArray(I);" ";
Next
print
-------------------------------------'/

sleep 3000

dim as double t
t = timer
_Qsort(1,MaxSize)
print using "##.###";timer-t

t = timer
qsort( @NumArray(1), MaxSize, 4, @compare )
print using "##.###";timer-t

sleep
と云うことで、・・・・・

実行結果:
     0.090
     0.003

速い!


本日はここまで。


FreeBASIC 学習は続く。


見ていただいた序でとは厚かましい限りですが、
お帰りに投票して頂けるとなお嬉しいです。 ⇒

190509
関連記事
スポンサーサイト



コメントの投稿

管理者にだけ表示を許可する

人気blog Ranking/おきてがみ


おきてがみ
最新記事
カレンダー
08 | 2019/09 | 10
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 - - - - -
月別アーカイブ
カテゴリ
最新コメント
検索フォーム
リンク
プロフィール

<紙>

Author:<紙>
ようこそ。
「パソコンヲタクの雑記帳」
もろもろなことを綴っています。
パソコン ヲタクってねくら?
画像は kami でなく kani です。

カウンター(fc2、i2i) /Google Analytics


i2i(from 2010-08-24)
Total =
Today  =  
Yesterday=
アンチエイジング

Google Analytics
ブックマーク