ソートロジック大会

メッセージ

omasu

お世話になります。

　ついにクイックソートを真似できました。

ここをクリックすると実行速度比較が表示されます。 [ここをクリックすると内容が表示されます]

実行環境　　　　　　　　　　（ＡｃｔｉｖｅＢａｓｉｃ　Ｖｅｒ．４．１０～４．１１．０３）
　　　　　　　　　　　　　　（Ｃｐｕ　Ｐｅｎｔｉｕｍ４　周波数２．６６ＧＨｚ　メモリ２５６ＭＢyte）

テストｃｓｖファイル　　　　５桁のランダム数字も５桁のランダム文字もソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

ａｒさん　　　　　　ラディックス　　　　　　　　　　　　０．０１０　　　０．０３０　　　　０．０６０　　　　０．２５０　　　　０．５５１　　ラディックス最速
ａｒさん　　　　　　マージ　　　　　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．４１１　　　　０．８９２　　マージ最速
ａｒさん　　　　　　クイック　　　　　　　　　　　　　　０．０１０　　　０．０５０　　　　０．１１０　　　　０．４１０　　　　０．９５２　　クイック最速
ｏｍａｓｕ　　　　　マージ（ａｒさん版）　　　　　　　　０．０３０　　　０．１６０　　　　０．３８０　　　　２．１２３　　　　４．５２７　　
ｏｍａｓｕ　　　　　クイック（入門編）　　　　　　　　　０．０４０　　　０．２１０　　　　０．４５０　　　　２．８３４　　　　６．６３９　　
マティさん　　　　　クイック改４（８００万件）　　　　　０．０５０　　　０．０８０　　　　０．１２０　　　　０．８２１　　　　６．６４９　　
〃　　　　　　　　　〃　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　８００万件　２０８０．６３１秒　最大件数ソート可能
イグトランスさん　　クイック　　　　　　　　　　　　　　０．０４０　　　０．２４１　　　　０．５２１　　　　３．２３５　　　　６．７０９　　
ｏｍａｓｕ　　　　　シェル４（０．８９７５＋０．４５）　０．０６０　　　０．２６１　　　　０．５８１　　　　３．６１６　　　　７．８６１　　シェル最速
ｏｍａｓｕ　　　　　シェル３（０．８９７５＋￥３）　　　０．０６０　　　０．２９０　　　　０．６８１　　　　４．６２７　　　　９．２２３　　
ｏｍａｓｕ　　　　　コーム２（挿入法１．４）　　　　　　０．０９１　　　０．３９１　　　　０．８２２　　　　４．７６７　　　１０．７０５　　コ－ム最速
ｏｍａｓｕ　　　　　シェル２（クヌース大大先生）　　　　０．０５０　　　０．３１１　　　　０．７２１　　　　４．９０７　　　１１．６７７　　
河川屋さん　　　　　コム（挿入法）　　　　　　　　　　　０．０７０　　　０．４１１　　　　０．９０１　　　　５．９５８　　　１２．３０８　　
河川屋さん　　　　　改シェル法（クヌース大先生）　　　　０．０６０　　　０．３６１　　　　０．７２１　　　　５．０５７　　　１２．５２８　　
ｏｍａｓｕ　　　　　コーム２（バブル１．４）　　　　　　０．１３０　　　０．４００　　　　０．９２２　　　　５．５７８　　　１２．８９９　　
ｏｍａｓｕ　　　　　シェル（ノーマル）　　　　　　　　　０．０７０　　　０．３５１　　　　０．８５１　　　　５．７４８　　　１３．１４９　　
ｏｍａｓｕ　　　　　コーム（ノーマル）　　　　　　　　　０．１２１　　　０．４５０　　　　１．０３２　　　　６．３５９　　　１３．６２０　　
ｏｍａｓｕ　　　　　単純挿入法（バイナリサーチ）　　　　０．０８０　　　０．８１１　　　　２．８９５　　　６５．５９５　　２６１．５７６　　単純挿入法最速
ｏｍａｓｕ　　　　　マージ（非再帰・非ワーク）　　　　　０．０６０　　　０．５３１　　　　１．８５３　　　３９．１７６　　１５５．７８４　　
ｏｍａｓｕ　　　　　シェル（選択法）　　　　　　　　　　０．３８１　　　４．７４７　　　１３．７７０　　１７７．３０５　　―――――――　　
ｏｍａｓｕ　　　　　シェル（ノーマル・再帰）　　　　　　０．６６１　　１４．８０１　　　６０．００６　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　単純挿入法　　　　　　　　　　　　　０．８６２　　１８．７７８　　　７７．０３１　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　シェーカー（バブル）　　　　　　　　１．１９１　　２７．８８０　　１１６．２３７　　―――――――　　―――――――　　シェーカー最速
ｏｍａｓｕ　　　　　単純選択法　　　　　　　　　　　　　１．４３２　　３６．６０３　　１４３．６３２　　―――――――　　―――――――　　単純選択法最速
ｏｍａｓｕ　　　　　バブル　　　　　　　　　　　　　　　１．４８２　　３８．２１５　　１５０．５６７　　―――――――　　―――――――　　バブル最速
　　　　　　　　　　トーナメント法　　　　　　　　　　　ただいま勉強中です。
　　　　　　　　　　ヒープ　　　　　　　　　　　　　　　ただいま勉強中です。

テストｃｓｖファイル　　　　５桁のランダム数字をソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

河川屋さん　　　　　（ＰＪ）クイック（改２）　　　　　　０．０８０　　　０．１４０　　　　０．２７１　　　　０．８０１　　　　１．１４２　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（改１）　　　　　　０．０２０　　　０．１３０　　　　０．１７０　　　　０．７３２　　　　１．１５１　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（ノーマル版）　　　０．１３０　　　０．１６０　　　　０．２１０　　　　０．８３１　　　　１．１９２　　クイック最速
マティさん　　　　　（ＰＪ）コーム　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．５８１　　　　１．６４３　　コーム最速

クイックソート（入門編） [ここをクリックすると内容が表示されます]

コード: 全て選択


Sub Sort(ByVal S As Long,ByVal E As Long)
    Dim P As Long
    If S<E Then
       Swap(Index[S],Index[(S+E)\2])
       P=S
       For i=S+1 To E
           If lstrcmp(KeyTable[Index],KeyTable[Index[S]])<0 Then
              P=P+1
              Swap(Index[P],Index)
           EndIf
       Next i
       Swap(Index[S],Index[P])
       Sort(P+1,E)
       Sort(S,P-1)
    EndIf
End Sub

しかし、最悪のデータの並びの存在、スタックオーバーフロー対策等、
　何も考えていないため、今後の課題としたいと思います。

マティ

ネットで検索するとomasuさんが投稿したようなコードが上位でヒットします。
このコードを使用した結果クイックソートって、動作が不安定だなって思っていました。
（だから不安定ソートって勘違いしたくらいです。）
このアルゴリズムでは、件数が多くなるとスタックオーバーを引き起こします。
また、元データが逆順の場合に性能が最悪になります。

初心者向けにも河川屋さんが投稿したロジックを元に移植する事を推奨します。
http://www.discoversoft.net/forum/viewt ... c&start=16

omasuさん、これからも頑張って下さい。

PS.ActiveBasicは、SubやFunctionを使用しない方が早いようです。

omasu

マティさんへ
　ありがとうございます。

　ごさっしのとおり(m!m)
ネットで探しまわり、直感で一番解りやすいロジックを参考にＡＢに模倣移植しました。
　参考文献はＣ言語が圧倒的に多く、ＶＢが続き、ＡＢでは皆無です。
　クイック＝難しい、ＡＢで私のような初心者には理解しやすいと感じ投稿しました。

追伸：ａｒさんのマージソートは実行比較環境に何とか移植できました、
　　　ａｒさんのクイックソートは、私の手には負えません。
　　　どなたか！・・・
追伸：今、ヒープを登頂中です。難しすぎます。

河川屋さんのコードのコメントを読み返してみましたが，結局辿り着くところは同じようで，
私が読んでいる本に書いてあることと同じことを実践されています。（改3まで）

それでもやる気をなくしたわけではありませんから，やるだけやりますよ。
（最近プログラミングに割ける時間が少なくて←言い訳）

マティ

omasuさん以下のロジックで動作するでしょうか？

QuickSortをomasuさん風に書くと [ここをクリックすると内容が表示されます]

コード: 全て選択


Sub QuickSort( S As Long, E As Long)
    Dim L As Long		'左から
    Dim R As Long		'右から
    Dim K As Long		'基準
    '
    If S<E Then
		L=S : R=E: K=Index[(S+E)\2]
		Do
			While lstrcmp(KeyTable[Index[L]],KeyTable[K])<0: L=L+1: Wend
			While lstrcmp(KeyTable[Index[R]],KeyTable[K])>0: R=R-1: Wend
			If (L <= R) Then
				Swap(Index[L],Index[R])
				L=L+1 : R=R-1
			End If
		Loop Until (L > R)
		QuickSort(S, R)	'左側を再処理
		QuickSort(L, E)	'右側を再処理
	End If
End Sub

初心者向けに、分かりやすくしたつもりです。

omasu

お世話になります。

　イグトランスさんへ
　　ありがとうございます。
　　　今、大変心強さを感じております。

　マティさんへ
　　たったこれだけの時間でこのようなロジックを組める？？？
　　　不思議としか言いようがないです。

実行できました。 [ここをクリックすると内容が表示されます]

実行環境　　　　　　　　　　（ＡｃｔｉｖｅＢａｓｉｃ　Ｖｅｒ．４．１０～４．１１．０３）
　　　　　　　　　　　　　　（Ｃｐｕ　Ｐｅｎｔｉｕｍ４　周波数２．６６ＧＨｚ　メモリ２５６ＭＢyte）

テストｃｓｖファイル　　　　５桁のランダム数字も５桁のランダム文字もソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

ａｒさん　　　　　　ラディックス　　　　　　　　　　　　０．０１０　　　０．０３０　　　　０．０６０　　　　０．２５０　　　　０．５５１　　ラディックス最速
ａｒさん　　　　　　マージ　　　　　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．４１１　　　　０．８９２　　マージ最速
ａｒさん　　　　　　クイック　　　　　　　　　　　　　　０．０１０　　　０．０５０　　　　０．１１０　　　　０．４１０　　　　０．９５２　　クイック最速
ｏｍａｓｕ　　　　　マージ（ａｒさん版）　　　　　　　　０．０３０　　　０．１６０　　　　０．３８０　　　　２．１２３　　　　４．５２７　　
ｏｍａｓｕ　　　　　クイック（入門編）　　　　　　　　　０．０４０　　　０．２１０　　　　０．４５０　　　　２．８３４　　　　６．６３９　　
マティさん　　　　　クイック改４（８００万件）　　　　　０．０５０　　　０．０８０　　　　０．１２０　　　　０．８２１　　　　６．６４９　　
〃　　　　　　　　　〃　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　８００万件　２０８０．６３１秒　最大件数ソート可能
イグトランスさん　　クイック　　　　　　　　　　　　　　０．０４０　　　０．２４１　　　　０．５２１　　　　３．２３５　　　　６．７０９　　
マティさん　　　　　クイック（初級編）　　　　　　　　　０．０４０　　　０．２５０　　　　０．５１０　　　　３．２７５　　　　７．２００　　
ｏｍａｓｕ　　　　　シェル４（０．８９７５＋０．４５）　０．０６０　　　０．２６１　　　　０．５８１　　　　３．６１６　　　　７．８６１　　シェル最速
ｏｍａｓｕ　　　　　シェル３（０．８９７５＋￥３）　　　０．０６０　　　０．２９０　　　　０．６８１　　　　４．６２７　　　　９．２２３　　
ｏｍａｓｕ　　　　　コーム２（挿入法１．４）　　　　　　０．０９１　　　０．３９１　　　　０．８２２　　　　４．７６７　　　１０．７０５　　コ－ム最速
ｏｍａｓｕ　　　　　シェル２（クヌース大大先生）　　　　０．０５０　　　０．３１１　　　　０．７２１　　　　４．９０７　　　１１．６７７　　
河川屋さん　　　　　コム（挿入法）　　　　　　　　　　　０．０７０　　　０．４１１　　　　０．９０１　　　　５．９５８　　　１２．３０８　　
河川屋さん　　　　　改シェル法（クヌース大先生）　　　　０．０６０　　　０．３６１　　　　０．７２１　　　　５．０５７　　　１２．５２８　　
ｏｍａｓｕ　　　　　コーム２（バブル１．４）　　　　　　０．１３０　　　０．４００　　　　０．９２２　　　　５．５７８　　　１２．８９９　　
ｏｍａｓｕ　　　　　シェル（ノーマル）　　　　　　　　　０．０７０　　　０．３５１　　　　０．８５１　　　　５．７４８　　　１３．１４９　　
ｏｍａｓｕ　　　　　コーム（ノーマル）　　　　　　　　　０．１２１　　　０．４５０　　　　１．０３２　　　　６．３５９　　　１３．６２０　　
ｏｍａｓｕ　　　　　単純挿入法（バイナリサーチ）　　　　０．０８０　　　０．８１１　　　　２．８９５　　　６５．５９５　　２６１．５７６　　単純挿入法最速
ｏｍａｓｕ　　　　　マージ（非再帰・非ワーク）　　　　　０．０６０　　　０．５３１　　　　１．８５３　　　３９．１７６　　１５５．７８４　　
ｏｍａｓｕ　　　　　シェル（選択法）　　　　　　　　　　０．３８１　　　４．７４７　　　１３．７７０　　１７７．３０５　　―――――――　　
ｏｍａｓｕ　　　　　シェル（ノーマル・再帰）　　　　　　０．６６１　　１４．８０１　　　６０．００６　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　単純挿入法　　　　　　　　　　　　　０．８６２　　１８．７７８　　　７７．０３１　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　シェーカー（バブル）　　　　　　　　１．１９１　　２７．８８０　　１１６．２３７　　―――――――　　―――――――　　シェーカー最速
ｏｍａｓｕ　　　　　単純選択法　　　　　　　　　　　　　１．４３２　　３６．６０３　　１４３．６３２　　―――――――　　―――――――　　単純選択法最速
ｏｍａｓｕ　　　　　バブル　　　　　　　　　　　　　　　１．４８２　　３８．２１５　　１５０．５６７　　―――――――　　―――――――　　バブル最速
　　　　　　　　　　トーナメント法　　　　　　　　　　　ただいま勉強中です。
　　　　　　　　　　ヒープ　　　　　　　　　　　　　　　ただいま勉強中です。

テストｃｓｖファイル　　　　５桁のランダム数字をソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

河川屋さん　　　　　（ＰＪ）クイック（改２）　　　　　　０．０８０　　　０．１４０　　　　０．２７１　　　　０．８０１　　　　１．１４２　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（改１）　　　　　　０．０２０　　　０．１３０　　　　０．１７０　　　　０．７３２　　　　１．１５１　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（ノーマル版）　　　０．１３０　　　０．１６０　　　　０．２１０　　　　０．８３１　　　　１．１９２　　クイック最速
マティさん　　　　　（ＰＪ）コーム　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．５８１　　　　１．６４３　　コーム最速

両方から攻める方法は少し難しいです。

　とりあえず形になったので投稿します。
単に数値化するだけでも随分と早くなるだろうと企んだわけですが，
思惑は外れ大して早くなりませんでした。

[ここをクリックすると内容が表示されます]

　ちなみにDWordPtr2は現在のAB 4.11.03でポインタへのポインタ型が扱えないことに対する苦肉の策です。

コード: 全て選択

#strict
#prompt

Declare Function timeGetTime Lib "winmm.dll" () As DWord
Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As DWord) As Long
Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As DWord) As Long

Declare Function StrChr Lib "shlwapi" Alias "StrChrA" (psz As *Char, ch As Char) As *Char
Declare Function StrToInt Lib "shlwapi" Alias "StrToIntA" (psz As *Char) As Long

Const Width = 26
Const Key = 1

Dim Path As String, Temp As String, InFile As String, OutFile As String

#define MAINPC

#ifdef MAINPC
Path = "h:\"
#else
Path = "c:\temp\"
#endif

Function ReadFromFile(pszFileName As *Char) As *DWord
	ReadFromFile = 0
	Dim hFile As HANDLE, hMap As HANDLE
	hFile = CreateFile(pszFileName, GENERIC_READ, FILE_SHARE_READ, ByVal 0, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0) As HANDLE
	If hFile = INVALID_HANDLE_VALUE Then
		Exit Function
	End If
	Dim pBuffer As *Char
	Dim Size As DWord, ReadSize As DWord
	Size = GetFileSize(hFile, 0)
	pBuffer = calloc(Size + 1)
	ReadFile(hFile, pBuffer, Size, VarPtr(ReadSize), ByVal 0)
	CloseHandle(hFile)
	ReadFromFile = LoadData(pBuffer)
	free(pBuffer)
End Function

Function LoadData(pBuffer As *Char) As *DWord
	Dim pData As *DWord
	pData = malloc(NumOfRecord * Width * SizeOf (DWord))
	Dim i As Long
	For i = 0 To ELM(NumOfRecord)
		If GetByte(pBuffer) = 0 Then
			Exit For
		End If
		Dim j As Long
		For j = 0 To ELM(Width)
			pData[i * Width + j] = StrToInt(pBuffer)
			Dim p As *Char
			p = StrChr(pBuffer, &h2c) 'Asc(",")
			If p = 0 Then
				Exit For
			End If
			pBuffer = p + 1
		Next
		Dim pNextLine As *Char
		pNextLine = StrChr(pBuffer, Asc(Ex"\n"))
		If pNextLine = 0 Then
			Exit For
		End If
		pBuffer = pNextLine + 1
	Next
	LoadData = pData
End Function

Sub WriteToFile(DataIndex As *DWordPtr2, FileName As *Char)
	Dim hOut As HANDLE
	hOut = CreateFile(FileName, GENERIC_WRITE, 0, ByVal 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
	If hOut = INVALID_HANDLE_VALUE Then
		Dim strMsg As String
		strMsg = MakeStr(FileName) + "を開けませんでした。"
		MessageBox(0, strMsg, 0, MB_ICONERROR)
		End'Exit Sub
	End If
	Dim i As Long
	For i = 0 To ELM(NumOfRecord)
		Dim p As *DWord
		p = DataIndex As *DWord
		Dim str As String
		str = ""
		Dim j As Long
		For j = 0 To ELM(Width)
			str = str + Str$(p[j]) + ","
		Next
		str = str + Ex"\r\n"
		Dim WrittenBytes As DWord
		WriteFile(hOut, StrPtr(str), Len(str), VarPtr(WrittenBytes), ByVal 0)
	Next
	CloseHandle(hOut)
End Sub

Const Period = 1

Sub Sort(Index As *DWordPtr2, Num As DWord)
	timeBeginPeriod(Period)
	Dim Time As DWord
	Time = timeGetTime()
	QuickSort5(Index, Num)
	Time = timeGetTime() - Time
	timeEndPeriod(Period)
	Print "ソート所要時間", Time As Double / 1000, "秒"
End Sub


TypeDef DWordPtr2 = DWord

' ↓ ここからプログラムが実行されます
Dim NumOfRecord As DWord
#ifdef _DEBUG
NumOfRecord = 2000
#else
Print "件数を指定してください。"
Input NumOfRecord
If NumOfRecord = 0 Then
	End
End If
#endif

Temp = Str$(NumOfRecord) + ".csv"
InFile = Path + "infile" + Temp
OutFile = Path + "outfile" + Temp


Dim pRecord As *DWord
pRecord = ReadFromFile(InFile)
If pRecord = 0 Then
	End
End If
Const RowsNum = 3
Dim KeyRows[RowsNum] = [1, 2, 3, 4] As DWord


Dim Index As *DWordPtr2
Index = malloc(NumOfRecord * SizeOf (DWordPtr2))
Dim i As DWord
For i = 0 To ELM(NumOfRecord)
	Index = VarPtr(pRecord[i * Width]) As DWordPtr2
Next

Sort(Index, ELM(NumOfRecord))

WriteToFile(Index, StrPtr(OutFile))

free(pRecord)
free(Index)

コード: 全て選択

Const GetAt(a) = GetDWord(a + (Key << 2)) ' << 2はSizeOf (DWord)をかける代わり 
Const Limit = 8

Sub QuickSort5(pIndex As *DWordPtr2, Size As DWord)
	Dim Stack[ELM(64)] As DWord, pos As DWord
	Dim Left As Long, Right As Long
	Left = 0
	Right = Size
	Do
		While Right > Left + Limit
			' 左端，中央，右端から中央値を選び，それを分割の基準にする。
			Dim Center As DWord, Temp As DWordPtr2
			Center = (Left + Right) >> 1 ' >> 1は2で割る代わり
			If GetAt(pIndex[Left])  > GetAt(pIndex[Center]) Then
				Temp = pIndex[Left] : pIndex[Left] = pIndex[Center] : Index[Center] = Temp
			End If
			If GetAt(pIndex[Left])  >  GetAt(pIndex[Right]) Then
				Temp = pIndex[Left] : pIndex[Left] = pIndex[Right] : Index[Right] = Temp
			End If
			If GetAt(pIndex[Center]) > GetAt(pIndex[Right]) Then
				Temp = pIndex[Center] : pIndex[Center] = pIndex[Right] : Index[Right] = Temp
			End If
			' 分割
			Dim v As *DWord, i As DWord, j As DWord
			v = pIndex[Center] As *DWord
			Temp = v As DWordPtr2 : pIndex[Center] = pIndex[Right - 1] : Index[Right - 1] = Temp

			i = Left + 1
			j = Right - 2
			Do
				While GetAt(pIndex) < GetAt(v)
					i = i + 1
				Wend
				While GetAt(pIndex[j]) > GetAt(v)
					j = j - 1
				Wend
				If i > j Then Exit Do
				Temp = pIndex : pIndex = pIndex[j] : Index[j] = Temp
				i = i + 1
				j = j - 1
			Loop
/*
			If pos >= 63 Then
				Print "Stack Overflow"
				Exit Sub
			End If
'*/
			If i - Left > Right - i Then
				Stack[pos] = Left : pos = pos + 1
				Stack[pos] = j : pos = pos + 1
				Left = i + 1
			Else
				Stack[pos] = Left + 1 : pos = pos + 1
				Stack[pos] = Right : pos = pos + 1
				Right = j
			End If
		Wend
		If pos < 2 Then Exit Do
		pos = pos - 1 : Right = Stack[pos]
		pos = pos - 1 : Left = Stack[pos]
	Loop
	InsertionSort3(pIndex, Size)
End Sub

Sub InsertionSort3(pIndex As *DWordPtr2, Size As DWord)
	Dim i As Long
	For i = 1 To Size
		Dim v As DWordPtr2
		v = pIndex
		Dim j As DWord
		j = i
		While j > 0
			If Not GetAt(pIndex[j - 1]) > GetAt(v) Then
				Exit While
			End If
			pIndex[j] = pIndex[j - 1]
			j = j - 1
		Wend
		pIndex[j] = v
	Next
End Sub

omasu

イグトランスさんへ（皆さんへ）
　ありがとうございます。

　クイックソート５ !!!!!m(_ _)m!!!!!

　挿入ソート３ !!!m(_ _)m!!!

覚悟を決め、実行してみます。
　非常に高度なため、とりあえずでは動かせそうもないですが、
　コピー、ペースト、実行　※とりあえずではいきなり終了します。
　（ところどころで設定すべき箇所があると思われます。）

omasu

お世話になります。

　自己流のクイックソート（中級編？）を作成しました。

皆様のクイック速度安定施策を参考に作成しました。

　ご指導のほどよろしくお願いします。

ここをクリックすると実行速度比較が表示されます。 [ここをクリックすると内容が表示されます]

実行環境　　　　　　　　　　（ＡｃｔｉｖｅＢａｓｉｃ　Ｖｅｒ．４．１０～４．１１．０３）
　　　　　　　　　　　　　　（Ｃｐｕ　Ｐｅｎｔｉｕｍ４　周波数２．６６ＧＨｚ　メモリ２５６ＭＢyte）

テストｃｓｖファイル　　　　５桁のランダム数字も５桁のランダム文字もソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

ａｒさん　　　　　　ラディックス　　　　　　　　　　　　０．０１０　　　０．０３０　　　　０．０６０　　　　０．２５０　　　　０．５５１　　ラディックス最速
ａｒさん　　　　　　マージ　　　　　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．４１１　　　　０．８９２　　マージ最速
ａｒさん　　　　　　クイック　　　　　　　　　　　　　　０．０１０　　　０．０５０　　　　０．１１０　　　　０．４１０　　　　０．９５２　　クイック最速
ｏｍａｓｕ　　　　　マージ（ａｒさん版）　　　　　　　　０．０３０　　　０．１６０　　　　０．３８０　　　　２．１２３　　　　４．５２７　　
ｏｍａｓｕ　　　　　クイック（中級編？）　　　　　　　　０．０４０　　　０．２３０　　　　０．４６０　　　　２．６１４　　　　６．０２９　　
ｏｍａｓｕ　　　　　クイック（入門編）　　　　　　　　　０．０４０　　　０．２１０　　　　０．４５０　　　　２．８３４　　　　６．６３９　　
マティさん　　　　　クイック改４（８００万件）　　　　　０．０５０　　　０．０８０　　　　０．１２０　　　　０．８２１　　　　６．６４９　　
〃　　　　　　　　　〃　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　８００万件　２０８０．６３１秒　最大件数ソート可能
イグトランスさん　　クイック　　　　　　　　　　　　　　０．０４０　　　０．２４１　　　　０．５２１　　　　３．２３５　　　　６．７０９　　
マティさん　　　　　クイック（初級編）　　　　　　　　　０．０４０　　　０．２５０　　　　０．５１０　　　　３．２７５　　　　７．２００　　
ｏｍａｓｕ　　　　　シェル４（０．８９７５＋０．４５）　０．０６０　　　０．２６１　　　　０．５８１　　　　３．６１６　　　　７．８６１　　シェル最速
ｏｍａｓｕ　　　　　シェル３（０．８９７５＋￥３）　　　０．０６０　　　０．２９０　　　　０．６８１　　　　４．６２７　　　　９．２２３　　
ｏｍａｓｕ　　　　　コーム２（挿入法１．４）　　　　　　０．０９１　　　０．３９１　　　　０．８２２　　　　４．７６７　　　１０．７０５　　コ－ム最速
ｏｍａｓｕ　　　　　シェル２（クヌース大大先生）　　　　０．０５０　　　０．３１１　　　　０．７２１　　　　４．９０７　　　１１．６７７　　
河川屋さん　　　　　コム（挿入法）　　　　　　　　　　　０．０７０　　　０．４１１　　　　０．９０１　　　　５．９５８　　　１２．３０８　　
河川屋さん　　　　　改シェル法（クヌース大先生）　　　　０．０６０　　　０．３６１　　　　０．７２１　　　　５．０５７　　　１２．５２８　　
ｏｍａｓｕ　　　　　コーム２（バブル１．４）　　　　　　０．１３０　　　０．４００　　　　０．９２２　　　　５．５７８　　　１２．８９９　　
ｏｍａｓｕ　　　　　シェル（ノーマル）　　　　　　　　　０．０７０　　　０．３５１　　　　０．８５１　　　　５．７４８　　　１３．１４９　　
ｏｍａｓｕ　　　　　コーム（ノーマル）　　　　　　　　　０．１２１　　　０．４５０　　　　１．０３２　　　　６．３５９　　　１３．６２０　　
ｏｍａｓｕ　　　　　単純挿入法（バイナリサーチ）　　　　０．０８０　　　０．８１１　　　　２．８９５　　　６５．５９５　　２６１．５７６　　単純挿入法最速
ｏｍａｓｕ　　　　　マージ（非再帰・非ワーク）　　　　　０．０６０　　　０．５３１　　　　１．８５３　　　３９．１７６　　１５５．７８４　　
ｏｍａｓｕ　　　　　シェル（選択法）　　　　　　　　　　０．３８１　　　４．７４７　　　１３．７７０　　１７７．３０５　　―――――――　　
ｏｍａｓｕ　　　　　シェル（ノーマル・再帰）　　　　　　０．６６１　　１４．８０１　　　６０．００６　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　単純挿入法　　　　　　　　　　　　　０．８６２　　１８．７７８　　　７７．０３１　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　シェーカー（バブル）　　　　　　　　１．１９１　　２７．８８０　　１１６．２３７　　―――――――　　―――――――　　シェーカー最速
ｏｍａｓｕ　　　　　単純選択法　　　　　　　　　　　　　１．４３２　　３６．６０３　　１４３．６３２　　―――――――　　―――――――　　単純選択法最速
ｏｍａｓｕ　　　　　バブル　　　　　　　　　　　　　　　１．４８２　　３８．２１５　　１５０．５６７　　―――――――　　―――――――　　バブル最速
　　　　　　　　　　トーナメント法　　　　　　　　　　　ただいま勉強中です。
　　　　　　　　　　ヒープ　　　　　　　　　　　　　　　ただいま勉強中です。

テストｃｓｖファイル　　　　５桁のランダム数字をソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

河川屋さん　　　　　（ＰＪ）クイック（改２）　　　　　　０．０８０　　　０．１４０　　　　０．２７１　　　　０．８０１　　　　１．１４２　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（改１）　　　　　　０．０２０　　　０．１３０　　　　０．１７０　　　　０．７３２　　　　１．１５１　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（ノーマル版）　　　０．１３０　　　０．１６０　　　　０．２１０　　　　０．８３１　　　　１．１９２　　クイック最速
マティさん　　　　　（ＰＪ）コーム　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．５８１　　　　１．６４３　　コーム最速

自己流クイック（中級編？） [ここをクリックすると内容が表示されます]

コード: 全て選択

Sub Sort(ByVal S As Long,ByVal E As Long)
    If E-S>9 Then                                               '　１０（９）件まで砕いたら挿入ソートへ移行
       Dim P As Long
       P=(S+E)\2
       If lstrcmp(KeyTable[Index[P]],KeyTable[Index[E]])>0 Then '　最悪のパターンを減らすため
          Swap(Index[P],Index[E])                               '　先頭と中央と最後をソート
       EndIf
       If lstrcmp(KeyTable[Index[S]],KeyTable[Index[P]])>0 Then
          Swap(Index[S],Index[P])
       EndIf
       Swap(Index[S],Index[P])                                  '　ソートした中央値を基準値とする
       P=S
       For i=S+1 To E
           If lstrcmp(KeyTable[Index],KeyTable[Index[S]])<0 Then
              P=P+1
              Swap(Index[P],Index)
           EndIf
       Next i
       Swap(Index[S],Index[P])
       If (E-(P+1))<((P-1)-S) Then                              '　件数が小さい方から再帰処理
          Sort(P+1,E)
          Sort(S,P-1)
       Else
          Sort(S,P-1)
          Sort(P+1,E)
       EndIf
    Else
       InsertionSort(S,E)                                       '　単純挿入ソート
    EndIf
End Sub
Sub InsertionSort(ByVal S As Long,ByVal E As Long)
    For i=S+1 To E
        j=i
        While j>=S+1 And _
              lstrcmp(KeyTable[Index[j]],KeyTable[Index[j-1]])<0
              Swap(Index[j],Index[j-1])
              j=j-1
        Wend
    Next i
End Sub

①最悪のデータ配列に対応
　先頭と中央と最後のデータの３件の内、中央値を基準値とする
②スタックオーバーフローに対応
　再帰処理は件数の小さい方から実行する
③速度向上に対応
　ある程度細かくなったら単純挿入ソートに移行する
　※１０（９）件は３件～３０件までのテストにより最高値を採用
追伸：投稿後にバグに気づきバグつぶしをしてしまいました。
　　　冷や汗が出ました。

すみませんでした。
以下の部分を消して，infileXXX.csvのあるフォルダへのパスを変数Pathへ代入してください。

コード: 全て選択

#define MAINPC

#ifdef MAINPC
Path = "h:\"
#else
Path = "c:\temp\"
#endif

ところで今回のはデータを全て数値(DWord)へ変換しています。
なので数字しか扱えないので「５桁のランダム数字」に分類してください。
しかし申し訳ありません，2列目だけをキーとして扱っていました。
1列目と2列目をキーとしなければならないのですよね。
今度修正してきます。

マティ

omasuさん先頭と中央と最後をソートし中央値を基準値とする処理ですが、Sが最大となる場合に、Sが基準値となっています。確認してください。

omasuさんのコード

コード: 全て選択


       P=(S+E)\2
       If lstrcmp(KeyTable[Index[P]],KeyTable[Index[E]])>0 Then '　最悪のパターンを減らすため
          Swap(Index[P],Index[E])                               '　先頭と中央と最後をソート
       EndIf
       If lstrcmp(KeyTable[Index[S]],KeyTable[Index[P]])>0 Then
          Swap(Index[S],Index[P])
       EndIf
       Swap(Index[S],Index[P])                                  '　ソートした中央値を基準値とする
       P=S

これだとちゃんと基準を取れると思います。置き換えてみて下さい。

コード: 全て選択


    P=(S+E)\2
    ' 最悪のパターンを減らすため、先頭と中央と最後をソート
    If lstrcmp(KeyTable[Index[S]],KeyTable[Index[P]])>0 Then
        Swap(Index[S],Index[P])
    EndIf
    If lstrcmp(KeyTable[Index[P]],KeyTable[Index[E]])>0 Then
        Swap(Index[P],Index[E])
        If lstrcmp(KeyTable[Index[S]],KeyTable[Index[P]])>0 Then
            Swap(Index[S],Index[P])
        EndIf
    EndIf
    ' Ｐに中央値が入っています。

omasu

お世話になります。

　マティさんの言われるとおりでした。
　　バグのほかにコーディングミスまでしてしまいました。
　　　［いろは］の［い］にまで、お気遣いありがとうございます。

　実行時間はネストが一段深くなったため、遅くなると思いきや
　　速度が速くなりました。

ここをクリックすると実行速度比較が表示されます。 [ここをクリックすると内容が表示されます]

実行環境　　　　　　　　　　（ＡｃｔｉｖｅＢａｓｉｃ　Ｖｅｒ．４．１０～４．１１．０３）
　　　　　　　　　　　　　　（Ｃｐｕ　Ｐｅｎｔｉｕｍ４　周波数２．６６ＧＨｚ　メモリ２５６ＭＢyte）

テストｃｓｖファイル　　　　５桁のランダム数字も５桁のランダム文字もソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

ａｒさん　　　　　　ラディックス　　　　　　　　　　　　０．０１０　　　０．０３０　　　　０．０６０　　　　０．２５０　　　　０．５５１　　ラディックス最速
ａｒさん　　　　　　マージ　　　　　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．４１１　　　　０．８９２　　マージ最速
ａｒさん　　　　　　クイック　　　　　　　　　　　　　　０．０１０　　　０．０５０　　　　０．１１０　　　　０．４１０　　　　０．９５２　　クイック最速
ｏｍａｓｕ　　　　　マージ（ａｒさん版）　　　　　　　　０．０３０　　　０．１６０　　　　０．３８０　　　　２．１２３　　　　４．５２７　　
ｏｍａｓｕ　　　　　クイック（中級編）　　　　　　　　　０．０５０　　　０．１９０　　　　０．４２１　　　　２．４９３　　　　５．３９８　　
ｏｍａｓｕ　　　　　クイック（入門編）　　　　　　　　　０．０４０　　　０．２１０　　　　０．４５０　　　　２．８３４　　　　６．６３９　　
マティさん　　　　　クイック改４（８００万件）　　　　　０．０５０　　　０．０８０　　　　０．１２０　　　　０．８２１　　　　６．６４９　　
〃　　　　　　　　　〃　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　８００万件　２０８０．６３１秒　最大件数ソート可能
イグトランスさん　　クイック　　　　　　　　　　　　　　０．０４０　　　０．２４１　　　　０．５２１　　　　３．２３５　　　　６．７０９　　
マティさん　　　　　クイック（初級編）　　　　　　　　　０．０４０　　　０．２５０　　　　０．５１０　　　　３．２７５　　　　７．２００　　
ｏｍａｓｕ　　　　　シェル４（０．８９７５＋０．４５）　０．０６０　　　０．２６１　　　　０．５８１　　　　３．６１６　　　　７．８６１　　シェル最速
ｏｍａｓｕ　　　　　シェル３（０．８９７５＋￥３）　　　０．０６０　　　０．２９０　　　　０．６８１　　　　４．６２７　　　　９．２２３　　
ｏｍａｓｕ　　　　　コーム２（挿入法１．４）　　　　　　０．０９１　　　０．３９１　　　　０．８２２　　　　４．７６７　　　１０．７０５　　コ－ム最速
ｏｍａｓｕ　　　　　シェル２（クヌース大大先生）　　　　０．０５０　　　０．３１１　　　　０．７２１　　　　４．９０７　　　１１．６７７　　
河川屋さん　　　　　コム（挿入法）　　　　　　　　　　　０．０７０　　　０．４１１　　　　０．９０１　　　　５．９５８　　　１２．３０８　　
河川屋さん　　　　　改シェル法（クヌース大先生）　　　　０．０６０　　　０．３６１　　　　０．７２１　　　　５．０５７　　　１２．５２８　　
ｏｍａｓｕ　　　　　コーム２（バブル１．４）　　　　　　０．１３０　　　０．４００　　　　０．９２２　　　　５．５７８　　　１２．８９９　　
ｏｍａｓｕ　　　　　シェル（ノーマル）　　　　　　　　　０．０７０　　　０．３５１　　　　０．８５１　　　　５．７４８　　　１３．１４９　　
ｏｍａｓｕ　　　　　コーム（ノーマル）　　　　　　　　　０．１２１　　　０．４５０　　　　１．０３２　　　　６．３５９　　　１３．６２０　　
ｏｍａｓｕ　　　　　単純挿入法（バイナリサーチ）　　　　０．０８０　　　０．８１１　　　　２．８９５　　　６５．５９５　　２６１．５７６　　単純挿入法最速
ｏｍａｓｕ　　　　　マージ（非再帰・非ワーク）　　　　　０．０６０　　　０．５３１　　　　１．８５３　　　３９．１７６　　１５５．７８４　　
ｏｍａｓｕ　　　　　シェル（選択法）　　　　　　　　　　０．３８１　　　４．７４７　　　１３．７７０　　１７７．３０５　　―――――――　　
ｏｍａｓｕ　　　　　シェル（ノーマル・再帰）　　　　　　０．６６１　　１４．８０１　　　６０．００６　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　単純挿入法　　　　　　　　　　　　　０．８６２　　１８．７７８　　　７７．０３１　　―――――――　　―――――――　　
ｏｍａｓｕ　　　　　シェーカー（バブル）　　　　　　　　１．１９１　　２７．８８０　　１１６．２３７　　―――――――　　―――――――　　シェーカー最速
ｏｍａｓｕ　　　　　単純選択法　　　　　　　　　　　　　１．４３２　　３６．６０３　　１４３．６３２　　―――――――　　―――――――　　単純選択法最速
ｏｍａｓｕ　　　　　バブル　　　　　　　　　　　　　　　１．４８２　　３８．２１５　　１５０．５６７　　―――――――　　―――――――　　バブル最速
　　　　　　　　　　トーナメント法　　　　　　　　　　　ただいま勉強中です。
　　　　　　　　　　ヒープ　　　　　　　　　　　　　　　ただいま勉強中です。

テストｃｓｖファイル　　　　５桁のランダム数字をソート可能なロジック　キー列（１列目と２列目を連結）　データ列数（２６列）

作成者　　　　　　　ソート名称　　　　　　　　　　　　　１，０００　　　５，０００　　　１０，０００　　　５０，０００　　１００，０００　　記事

河川屋さん　　　　　（ＰＪ）クイック（改２）　　　　　　０．０８０　　　０．１４０　　　　０．２７１　　　　０．８０１　　　　１．１４２　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（改１）　　　　　　０．０２０　　　０．１３０　　　　０．１７０　　　　０．７３２　　　　１．１５１　　クイック最速
河川屋さん　　　　　（ＰＪ）クイック（ノーマル版）　　　０．１３０　　　０．１６０　　　　０．２１０　　　　０．８３１　　　　１．１９２　　クイック最速
マティさん　　　　　（ＰＪ）コーム　　　　　　　　　　　０．０１０　　　０．０６０　　　　０．１２０　　　　０．５８１　　　　１．６４３　　コーム最速

クイックソート（中級編） [ここをクリックすると内容が表示されます]

コード: 全て選択

Sub Sort(ByVal S As Long,ByVal E As Long)
    If E-S>9 Then                                               '　１０（９）件まで砕いたら挿入ソートへ移行
       Dim P As Long
       P=(S+E)\2
       If lstrcmp(KeyTable[Index[S]],KeyTable[Index[P]])>0 Then '　最悪のパターンを減らすため、先頭と中央と最後をソート
          Swap(Index[S],Index[P])
       EndIf
       If lstrcmp(KeyTable[Index[P]],KeyTable[Index[E]])>0 Then
          Swap(Index[P],Index[E])
          If lstrcmp(KeyTable[Index[S]],KeyTable[Index[P]])>0 Then
             Swap(Index[S],Index[P])
          EndIf
       EndIf                                                    '　Ｐに中央値が入っています。
       Swap(Index[S],Index[P])                                  '　ソートした中央値を基準値とする
       P=S
       For i=S+1 To E
           If lstrcmp(KeyTable[Index],KeyTable[Index[S]])<0 Then
              P=P+1
              Swap(Index[P],Index)
           EndIf
       Next i
       Swap(Index[S],Index[P])
       If (E-(P+1))<((P-1)-S) Then                              '　件数が小さい方から再帰処理
          Sort(P+1,E)
          Sort(S,P-1)
       Else
          Sort(S,P-1)
          Sort(P+1,E)
       EndIf
    Else
       InsertionSort(S,E)                                       '　単純挿入ソート
    EndIf
End Sub

Sub InsertionSort(ByVal S As Long,ByVal E As Long)
    For i=S+1 To E
        j=i
        While j>=S+1 And _
              lstrcmp(KeyTable[Index[j]],KeyTable[Index[j-1]])<0
              Swap(Index[j],Index[j-1])
              j=j-1
        Wend
    Next i
End Sub

追伸：皆様の上級編に近づけるようがんばります。

omasu

お世話になります。

　イグトランスさんのクイックソートが動きました。

　しかし、私の動かし方が悪いのか、

　入力ファイル　千件の出力件数は　８６４件・・・ソートはされています。
　〃　　　　　一万件　〃　　　　１７９４件・・・ソートはされています。
　〃　　　　　十万件　〃　　　　４３６９件・・・ソートはされています。

また、例の私の環境のメモリ２５６ＭＢの影響かもしれません。
　　　ちなみの　千件のソートは０秒
　　　　　　　十万件　　　　　６．５７８秒です？？？？？

スタック数とかメモリ制限とか、いろいろ調べる必要があるやもしれません。

それは単に私のバグに違いありません。
＃クイックソート1つ書けないでどうするんだ，俺。

omasu

お世話になります。

　ちょっと休憩します。

私の年はいくつだと思いますか？

ab.com コミュニティ

ソートロジック大会

クイックソート（入門編）について

アニバーサリー

アニバーサリーⅡ

クイックソート

クイックソート５、挿入ソート３について

自己流クイック（中級編？）

コーディングミスについて

クイックソート５、挿入ソート３について

コーヒーブレイク