ソートロジック大会

ActiveBasicでのプログラミングでわからないこと、困ったことなどがあったら、ここで質問してみましょう(質問を行う場合は、過去ログやWeb上であらかじめ問題を整理するようにしましょう☆)。
メッセージ
作成者
河川屋

#46 投稿記事 by 河川屋 »

>このソートのアルゴリズム名は?
度数ソートの変形。
というか、08月27日(土) に私が書いたQuicksort改4と方針は同じ。


>前提条件
>ホストコンピュータ又はCOBOLで作成したデータをソートする用途向きの簡略版です。?
「ホストコンピュータでFORTRANで作成したデータ」というのは、
・ホストコンピュータ又はCOBOLで作成したデータ
という条件を満たしていますが、ソートできませんよ。
理由:FORTRANでは数値の最高位より左の桁はゼロでなくスペースとなる。コレに対応していない。
   また、E変換やG変換で書き出したデータは、左から判断していく方法ではそもそも整列できない。
   COBOLで作成した数値データでも、マイナスがあった場合には対応していない。



N88BasicやQuickBasicでは、基本命令の動きの違いで、このプログラムは動きません。

Function GigaSort(xNo As Integer, xFileName As String)As Integer
  :
   FN=Wk + Str$(j)

まず、コレがアウト。
jは0~9のいずれかというのがプログラムの要請ですが、
Str$(0)=" 0"
となるから、ファイル名にスペースが割り込んでしまうのでDOSではダメ。
ここは、
FN=Wk + Hex$(j)

Sub SortOut(xFileName As String)
  Open xFileName For Input As #1
  Field #1, LineLength    'バイト数
  While (Eof(1)=0)
   Get #1, -1, StrBuf
   Put #2, -1, StrBuf


ファイル操作については、全くのMicrosoftBasic非互換といってもよいでしょう。
Open xFileName For Input(OUTPUT/APPEND)
というふうにシーケンシャルモード(テキストファイルモード)でファイルをOPENした場合、
FIELD文やGET(PUT)文は使えません。
また、ランダムファイルとしてOPENしたとしても、
  Open xFileName As #1 LEN=Linelength (または OPEN "R",#1,xFileName,Linelength)
  '  ↑この構文はN88Basic不可。N88はLEN=256に固定。
  Field #1, LineLength as StrBuf
  for rec=1 to LOF(1)/Linelength '( N88はfor rec=1 to LOF(1) )
   Get #1
   Lset StrBuf2=StrBuf2  '←  Field #2, LineLength as StrBuf2と宣言してあるとして。
   Put #2
と、こうなります。


あと、メモリー内に引き込めないほど多量のデータをソートするときは、
普通はマージソート(外部ソート)を使います。
「外部ソート」or「バランスウェイマージソート」or「ポリフェーズマージソート」
で検索してみてください。
大まかなやり方は以下のとおり。
1.メモリーに引き込めるだけのデータを読み込み、ソートしてからファイルに書き出す。
  (ソートアルゴリズムはクイックなりヒープなり、速いものならどれでも可)
2.まだデータが残っていれば、1.を繰り返す。
3.ファイル同士でマージソート。

こうすることで、データの特殊性に依存せずソートできますが、
・度数ソート、逆写像ソート、ラディックスソートはO(n)
・マージソート、クイックソート、ヒープソートはO(nlogn)
であるので、一般論としては、度数ソートでokなら度数ソートのほうが速いといういことになります。



omasuさん 09月24日
>①.一番遅いはずの、バブルの進化がクイックソート?。
そのとおり。

>②.シェルソートは、選択法で作ると遅い、挿入法だとなぜか早い。
選択法で作ったシェルソートというのは聞いたことないです。
また、私のコーディングは、挿入法ベースですけど。

選択法の進化系ですが、
最小(大)値選択法-トーナメント法-ヒープ。
 ※トーナメント法:
  勝ち抜き戦で1位を決めるにはn-1試合必要。では、2位を決めるには?
   改めて残りチームで勝ち抜き戦をやっているのが最小値選択法。
   でも、1位に負けたチームだけ、元のトーナメント表どおりに
   試合すれば2位は決まるから、logn回で2位は決まります。
   3位以下も同様。よって、NlogNでソートできることの証明終わり。

交換法(バブル)を元にしたシェルソートというのなら存在します。

共立出版 「プログラム書法、1976」 B.W.Kernighan and P.J.Plauger P191
から言語を変換(元はFORTRAN)し、コメントを追加したもの。
   SUB SHELL(X(),N)
   IGAP=N
   DO WHILE IGAP>1
    IGAP=IGAP/2   'shell
   ' IGAP=IGAP/1.3  'comb
    IMAX=N-IGAP
    DO
     IEX=0
     FOR I=1 TO IMAX
      IPULUSG=I+IGAP
      IF X(I)<=X(IPULUSG) THEN
       W=X(I) : X(I)=X(IPULUSG) : X(IPULUSG)=W
       IEX=1
       END IF
     NEXT
    LOOP WHILE IEX=1       'shell
   ' LOOP WHILE IGAP=1 AND IEX=1  'comb
   LOOP
   END SUB

※REM文2箇所を入れ替えるとコムソート。


>③.単純挿入法はバイナリサーチで挿入ポイントを決めると早い。
交換回数は単純挿入法と等しいから、手間をかけた割には速くならない
というのが通常の評価です。
また、シェカー法というのは輪をかけてとんでもない方法で、反面教師としてしか使えません。
シェル法以上に複雑なプログラムですが、単純挿入法にすら勝てないから。

>シェル法のギャップのとり方
1,4,13,....M,3M+1 の他に、
1,3,7,15...M,2M+1 とか、(これもクヌース大先生おすすめ)
IGAP=IGAP*0.45 ※最後はIGAP=1を実行するのをお忘れなく。
というのもおすすめ品。

>いろんなロジックを教えてください。
単純挿入法ベースのコムソート(コムソートの性格上、最後の仕上げがバブルでないだけ。)
   IGAP=N
   WHILE IGAP > 2
    IGAP = IGAP *10 \ 13
    FOR i = IGAP + 1 TO N
     J = i - IGAP
     IF Key(i) < Key(j) THEN
      W=Key(i) : Key(i) = Key(j) :Key(j)= W
      End If
    NEXT
   WEND
   For i=2 to N
    X=Key(i) : Key(0)=X
    j=i-1
    While X<Key(j)
     Key(j+1)=Key(j): j=j-1
    Wend
    Key(j+1)=X
   Next


マティさん 09月24日
>クイック派に転向
そう単純に割りきれないところがあります。だからヒープ派というのが厳然として存在。
(私はシェル派なんだけどね。)
クイックソートには欠点があり、
 X=Key((L+R)\2)
とした場合、元データがたとえばこういう場合にボロボロになります。

<1 3 5 7 9 10 8 6 4 2 > (両端に小さい数、真ん中に大きい数。)

最悪時にはスタックオーバーで自爆。自爆しないためには、08月27日の私の記述の改1。
ただし、これだけでは、n^2の時間がかかってしまうので、解除(厳密な解除ではない)には改3が必要。


>バブルソートの進化系はコムソート
バブルソートの最終進化系はクイックで間違いありません。
コムソートは、単純挿入法改もアリ。そして、バブルソート改より速い筈。(キーの長さが短かいならば。)


なお、個人の趣味(=美意識)になってしまうけど、

omasuさんのように、
  '単純挿入法
  For i=1 To E
    For j=i To 1 Step -1
      If KeyTable(j)<KeyTable(j-1) Then
        Swap KeyTable(j),KeyTable(j-1)
      Else
        Exit For
      EndIf
    Next j
  Next i
というのは組む気ナシです。
単純挿入法は、あくまで、
   For i=2 to N
    X=Key(i) : Key(0)=X
    j=i-1
    While X<Key(j)
     Key(j+1)=Key(j): j=j-1
    Wend
    Key(j+1)=X
   Next
であって、Exit Forのようなムナくそ悪い「例外処理命令」は使いたくないです。



Zgockさん 09月29日

>2回に分割する場合、バケツソート(注:度数ソート)に比べて速度は2倍、ワークは100分の1
速度は1/2です。

>クイックソートは速いアルゴリズムで非常に美しいですが、
>安定じゃないのだけが欠点ですね。
>そういう理由からヒープソートをよく使います。
これって、「ヒープソートは安定である」という意味にしか解釈できないのですが。
でも、ヒープソートって安定なんか?
平成15年度ソフトウェア開発技術者試験午前問13では、「ヒープソートは安定ではない」
が正解なんですけど。
http://sinzo.web.infoseek.co.jp/joho/so ... 03_01.html
クイックソートは、「n^2の時間がかかる数列が存在する」
というのが最大の欠点でしょ?
マティ
記事: 161
登録日時: 2005年8月23日(火) 00:15
お住まい: 沖縄県
連絡する:

#47 投稿記事 by マティ »

omasuさん
①テストデータは、貴殿作成のプログラムで作成しました。
②AB4.1で実行して下さい。
③AB4.1(.abpにコピー)で大丈夫だとおもいます。エラーが出たらご報告ください。
PS.現状の仕様でよければ10倍は早いロジックを作成中です。

会社の都合で、ここ3年程ホスト系のプログラム作成とメンテナンスをしていました。
一番プログラムを作成したのはMASMだったりします。

酒は死ぬほど大好きですが、この間は久しぶりに飲んだので暴走してしまいました。皆さんごめんなさい

河川屋さん
Quicksort改4ですね!たしかに提案を受けていました。ありがとうございます
言い訳
一文字単位でグループ化して行けば、ソートが完成するな・・・って考えていたら度数ソート?が出来たのですが、あまりにも遅いので途中から普通のソートと組み合わせる方法にして作成しました。
そしたら河川屋さんの提案通りの組み合わせになっていました。

前提条件
たしかに間違えています。申し訳ありません。
COBOLで作成したデータを固定長ファイルのテキストデータ形式でコンバートした場合かつ数値項目(正の数)、のみとさせて頂きます。
また、今回のテストデータ用に作成したので、他の条件は一切考慮していませんでした。

他ベーシック対応
最近は、ExcelのVBAやVB6しかベーシック系の言語は使用していないのですが・・・
移植系の話をするなら、私がABで作成しているプログラムは基本的にポインターを使用しています。
ポインターが無かったらABはやっていません。
VBで巨大はバイト型の配列を作成すると同様な処理ができるので問題ないと言えばそれまでですが・・・
(実際自分もABを使用するまでは、バイト型の配列を使用していました)

①ファイル名については(カタカナソート対応の為に)Chr$で対応済みです。
②ファイル操作について、AB4.1で Line Input が使用できれば、こんなロジックにする必要も無かったのですが・・・(可変長対応になるし・・・)
③巨大ファイルを操作する場合はマージソートを使用するのは分かっていますが・・・そのうち投稿します。

河川屋さん質問
名指しで申し訳ありませんが、お教えください。
極論すると全てのソートは、バブルソートの進化系ってなりませんか?
バブルとコムとシェルは、ほぼ同じロジック。クイックも同系列
度数ソートは先頭文字で振り分けるから、クイックの進化系?
バブルソートの進化系じゃないソートってどのようなソートがあるのですか?
(論理的な教育を受けていないので、よく分からないのです)

文字列について
最後にABは文字列処理や異常に遅いので、なるべく文字列処理を無くしています。
マティ
記事: 161
登録日時: 2005年8月23日(火) 00:15
お住まい: 沖縄県
連絡する:

クイックソート改4

#48 投稿記事 by マティ »

指摘を受けた部分は大体修正しましたので、お試しください。
最後に編集したユーザー マティ [ 2005年12月15日(木) 23:28 ], 累計 1 回
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

アクティブベーシックのバージョンの違いについて

#49 投稿記事 by omasu »

 いつも大変お世話になっております。

 皆様のアルゴリズムの豊富さと高度なロジック、ありがたいご指導に感謝しております。

 ただいま、悪戦苦闘の毎日です。

 当初、アクティブベーシックAB2.62で作成していたロジックも、AB最新版で実行可能となりました、
 これも、皆様のおかげです。

標題について

 当初のAB2.62での文字列交換法から数値交換法に変更しても、劇的な変化が見られなかったこと、
 4.XXにしたとたん、かなりのスピードアップが実現したこと、
 これらにずっと疑問を抱いておりました。

 バージョンの違いにより、数値交換、文字列交換がどれだけ違うのか、ベンチマークテストを実施しました。
 (書籍に載っているような数々の試験はしていません、あくまでも数値と、文字の交換が対象です) 以上のことから
 AB2.62とAB4.10との速度比は
  ・数値交換は  約1700倍
  ・文字列交換は 約   8倍

 同一バージョン内の数値交換と文字列交換の速度比は
  ・AB2.62は 約1.4倍
  ・AB4.10は 約300倍

数値交換については、かなりのスピードアップがされていることが測定できました。

記事:
 当然のことながら、当初のAB2.62(文字列交換法)32秒をバージョンアップすると8倍の4秒
          それを、数値交換法にすると13msにはなりませんが
 今回プロジェクトの速度比較はしておりません。
 プロジェクトで作成した速度にも違いがあるように思えますが、また悩んでしまいました。
追伸:
 それでも、AB2.62は手放せないですよね!(AB2.62ユーザより)(AB2.7?、AVB、AC)
最後に編集したユーザー omasu [ 2005年11月13日(日) 20:00 ], 累計 1 回
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

シェル(ギャップ初期値の発見)

#50 投稿記事 by omasu »

お世話になります。

 シェルソートについて、
河川屋さんのありがたいご指導のなかに
>シェル法のギャップのとり方
1,4,13,....M,3M+1 の他に、
1,3,7,15...M,2M+1 とか、(これもクヌース大先生おすすめ)
IGAP=IGAP*0.45 ※最後はIGAP=1を実行するのをお忘れなく。
というのもおすすめ品。
という一文がありました。
いろいろ思考錯誤と試行を繰り返しましたが、
 ①.ギャップのとり方で速度がかなり変わる
 ②.ギャップの初期値のとり方でも速度が違う
そのため。ギャップの初期値について研究した結果、発見がありました。

調査方法:一万件のソートを一万回実施(推定実行時間一回1秒の場合一万秒≒2.77時間かかります)(2秒だと、3秒だと・・・)
     一万回のギャップ初期値を1万から1ずつ減らし1になるまで実行(睡眠中に愛機が実行してくれた)(^o^)
     ※本来はデータ件数の外側にも最適数値が存在する可能性があります。
      今回はギャップを3で割っているため、3倍の3万回を実施する必要があります。(今回は内側のみの調査です)

その結果、一番早かった初期値が「件数×0.8975」でした。。(この初期値もクヌース大大先生のおすすめかも知れませんが)
実行については       「2005年9月25日(日)」の「マティさんに返信」のソート部を入替えてください。
テストデータ作成方法は   「2005年9月25日(日)10」の「テストデータの掲示についてⅡ」参照

今まで、実行できたロジックの速度も掲示します。
しかし、50万件のソートは愛機の環境が不安定になり測定時間も不安定になることから計測を断念しました。 追伸1:マティさんのクイック改4(800万件)ですが、1万件まではすばらしい速度で実行しますが、
    5万件からかなり待っても終了しません、実行終了時間が不明のため、断念しています。(推定時間を教えてください)
追伸2:シェルとコムの違いに今悩んでいます。
追伸3:申し訳ありません、イグトランスさんのソートキー指定が実力不足でいまだに、コンパイルエラーとなっております。
    前回のコードの部分提示を、コード全体提示に修正していただけませんでしょうか。
追伸4:今回の調査はたった1万件を1万回実施したのに過ぎず精度はいいかげんです、
    スーパーコンピューター等で大量件数を大量回実行すればどんな件数でも対応する初期値が出ると思います。
追伸5:ギャップの減らし方についても調査が必要と思われます。
最後に編集したユーザー omasu [ 2005年11月06日(日) 14:57 ], 累計 3 回
マティ
記事: 161
登録日時: 2005年8月23日(火) 00:15
お住まい: 沖縄県
連絡する:

#51 投稿記事 by マティ »

2005年09月28日(水)に投稿を行ったロジックではなく!
2005年09月29日(木)に再投稿を行ったロジックをご使用下さい。
また
C:ドライブのルートにtmpフォルダーを作成して下さい。
c:\tmp\
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

シェル法記録の更新について

#52 投稿記事 by omasu »

お世話になります。

シェル法についてⅡ
 河川屋さんのギャップの減らし方「ギャップ×0.45」(クヌース大大大先生おすすめ)を実施、最速値を記録しました。
>>>IGAP=IGAP*0.45 ※最後はIGAP=1を実行するのをお忘れなく。というのもおすすめ品。
(ほんとにギャップの減らし方にも最速値があることを実感しました。)
最後に編集したユーザー omasu [ 2005年11月06日(日) 15:01 ], 累計 2 回
ar

マージソート

#53 投稿記事 by ar »

ソートアルゴリズムごとの実際の評価は大変興味深く拝見させてもらっています。
ただマージソートに関してはまだ評価されていないようなので下記ソースを投稿させて貰います(C言語アルゴリズム辞典からの写しですけど・・・)。
とりあえずパフォーマンス評価の一つにしていただけたらと思います。

コード: 全て選択

Const N = 100000		'データ個数
Type MERGESORT
	key As *Byte		'キーデーター
	info As *Byte		'csvファイルの行データ
End Type
Dim a[N - 1] As MERGESORT
Dim work[(N - 1)/ 2 + 1] As MERGESORT

'マージソート
'	first : 整列範囲の最小配列添え字
'	last  : 整列範囲の最大配列添え字
Sub mergesort(first As Long, last As Long)
	Dim middle As Long
	Dim i As Long
	Dim j As Long
	Dim k As Long
	Dim p As Long

	If first < last Then
		middle = (first + last) \ 2
		'再起呼び出し
		mergesort(first, middle)
		mergesort(middle + 1, last)
		'
		p = 0
		i = first
		Do
			work[p] = a		'同じ構造体であれば等号でOK
			p = p + 1
			i = i + 1
		Loop Until i > middle
		i = middle + 1
		j = 0
		k = first
		While i <= last And j < p
			If lstrcmp(work[j].key, a.key) <= 0 Then	'数値比較の場合は work[j].key <= a.key
				a[k] = work[j]
				k = k + 1
				j = j + 1
			Else
				a[k] = a
				k = k + 1
				i = i + 1
			End If
		Wend
		While j < p
			a[k] = work[j]
			k = k + 1
			j = j + 1
		Wend
	End If
End Sub
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

ついに登場マージ

#54 投稿記事 by omasu »

お世話になります。
 ついに登場、マージソート!!
 ついに登場、久々の新メンバーに感動しております。(自動的にメンバー登録されます)(~o~)

何度もチャレンジ
申し訳ありません。
 どうやって使えばいいか面食らっています???????。

 CSVを読み込み、そのデータからキー列を抜いて、そのキーを、
 a[]に放り込んでから、Work[]を使って・・
 0から?、1から?・Nは実データ数?・・、 .Key?・・・・

 もうしばらくか、だいぶ、時間をいただくか、実行可能な環境までお教えくだされば幸いです。

追伸:マティさんのプライベートメッセージの補助で800万件のソートが
   ついに動きました。(私の愛機の記憶力の限界値と設定を適正化)
   次回、実行時間を乞うご期待!
ar

マージソートの実際の動作

#55 投稿記事 by ar »

失礼、説明が無かったですね。
マージソートは名前の通りデーターを順にマージ(併合)することで整列を行います。ただし、そのためには一旦データを展開する作業スペースが必要で、それがwork配列です。実際のデータはa配列に格納します。今回の場合、列の情報(info)と比較用のキー(key)を構造体として持たせています。
ですので、順序としては、
 1)ファイルの読み込み
 2)a[].infoにデータを格納
 3)a[].infoの先頭2列分のデータを連結してa[].keyに格納
 4)mergesort(0、N-1)で全域を整列
 5)結果の出力
となります。
下のコードは私が動作検証のために使ったものです。ソースコードと同じフォルダ内の"testcsv.csv"を読み込み、"result.csv"として出力するものです。前回投稿したマージソートの下にコピペすれば使えるはずです。処理数を定数Nでふるのと、pathを変えれば評価くらいには使えますかね。

コード: 全て選択

Dim i As Long
Dim j As Long
Dim time As SYSTEMTIME
Dim offset As Long
Dim path[MAX_PATH] As Byte
Dim hFile As HANDLE
Dim flen As DWord
Dim file As *Byte

'ファイルの読み込み
Print "read";
GetCurrentDirectory(MAX_PATH, path)
lstrcat(path, "\testdata.csv")
hFile = CreateFile(path, GENERIC_READ, 0, ByVal NULL, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0)
flen = GetFileSize(hFile, 0)
file = calloc(SizeOf(Byte) * flen + 1)
Print ReadFile(hFile, file, flen, VarPtr(flen), ByVal NULL)
CloseHandle(hFile)

'行ごとに分解
Print "sepalate"
a[0].info = VarPtr(file[0])
i = 1
j = 0
Do
	Select Case file[j]
		Case 13, 10				'CR or LF
			file[j] = 0
			If file[j + 1] = 10 Then
				file[j + 1] = 0
				j = j + 1
			End If
			a.info = VarPtr(file[j + 1])
			i = i + 1
	End Select
	j = j + 1 
Loop While j < flen Or i < N

'キーの作成
i = 0
Do
	a.key = calloc(SizeOf(Byte) * 10 + 1)
	memcpy(VarPtr(a.key[0]), VarPtr(a.info[0]), 5)
	memcpy(VarPtr(a.key[5]), VarPtr(a.info[6]), 5)
	i = i + 1
Loop While i < N

'整列
Print "marge-sort",
GetLocalTime(time)
Print time.wMinute; ":"; time.wSecond; ":"; time.wMilliseconds; " -> ";
mergesort(0, N - 1)
GetLocalTime(time)
Print time.wMinute; ":"; time.wSecond; ":"; time.wMilliseconds

'結果の出力
Print "write",
GetCurrentDirectory(MAX_PATH, path)
lstrcat(path, "\result.csv")
Open path For Output As #1
i = 0
Do
	Print #1, MakeStr(a.info)
	i = i + 1
Loop While i < N
Close #1
free(file)

このままだと、動的な配列の確保がしにくいなぁ・・・ということで、Publicなデータを持つクラスをNewで生成するのがいいのだろうか?
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

動きました!!

#56 投稿記事 by omasu »

お世話になります。

マティさんの800万件のソートについて

 ついに最大ソート件数800万件のソートが実証できました。
 ※マティさんのプライベートメッセージのサポートのおかげです。
  ・私の愛機の環境では「Const xReSort=51200'まとめてソートする行数」が追いつかず、
   迷宮の世界に入っていました。
  ・「xReSortの値は2048の倍数で設定して下さい」
   メモリ256MBでは、「20480」で実行が可能となりました。

arさんのマージソートについて

 ついに10万件ソートが1秒をきりました。
 すばらしい速度に感動しております。

 ※arさんの「動的な配列の確保がしにくい」というメッセージに同感しています。
  ぜひ「N」の値を自動化していただきたいと要望をいたします。


さて、実行時間の件ですが、どうも、私のテストデータの作りと前提条件の記述の悪さが災いしたようで、
「5桁のランダム数字文字列として扱い」と書いております。申し訳ありません。
 速度比較を「5桁のランダム数字も5桁のランダム文字もソート可能」と「5桁のランダム数字がソート可能」に分けて表示をいたします。
最後に編集したユーザー omasu [ 2005年11月06日(日) 15:03 ], 累計 2 回
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

テストデータの掲示についてⅢ

#57 投稿記事 by omasu »

大変申し訳なく思っています。

 今回のテストデータの提示と前提条件の提示について、

 紛らわしい表現があったことを深くお詫び申し上げます。

テストデータとして英数カナ混在データ作成のプログラムを掲示します。
最後に編集したユーザー omasu [ 2005年11月04日(金) 22:06 ], 累計 3 回
マティ
記事: 161
登録日時: 2005年8月23日(火) 00:15
お住まい: 沖縄県
連絡する:

#58 投稿記事 by マティ »

omasuさんマティです!!!
クイック改4は、ソートの対象を制限していません。!!!
文字コード順なら大体のソートは可能です(半角カナが混じると保証できませんが・・・)

そういう訳で、分類の変更をお願いします。
omasu
記事: 96
登録日時: 2005年9月02日(金) 22:15
連絡する:

訂正とお詫び

#59 投稿記事 by omasu »

> クイック改4は、ソートの対象を制限していません。!!!
> 文字コード順なら大体のソートは可能です(半角カナが混じると保証できませんが・・・)

申し訳ありません。

 全ての出力ファイルを確認したはずが見落としていました。
  クイック改4の出力ファイルはOutput.csvでした。
   前回の実行時間一覧の分類を訂正します。
ar

マージソート その2

#60 投稿記事 by ar »

前回最後にコメントした動的な確保は下記のようなのでどうですか?
omasuさん提供のテストデータ作成プログラムで作ったデータを使って、n列分のソートを行うようになっています。ついでに、ソート関数にデータを渡すようにしたので関数内外でのデータのネーミングを意識しないですむので、再利用しやすいのではと。
一応、100万件までの動作はしました。100万件動作時でメモリの消費量は約23MB。800万件は相当な覚悟が必要かも・・・
ここまでくると、キーの作成と書き出し時間が相当長くなっている。

コード: 全て選択

#N88BASIC

Class CSVSORT
Public
	keystr As *Byte						'文字列比較用キーデータ
	info As *Byte						'列位置
End Class
Dim data As *CSVSORT					'データ配列
Dim work As *CSVSORT					'展開用配列
Dim rcd_len As Long						'レコード長(改行含まず)
Dim rcd_max As Long						'データ(レコード)の最大数

Dim n As Long							'読み込みデータ数
Dim i As Long
Dim time As SYSTEMTIME
Dim path[MAX_PATH] As Byte
Dim hFile As HANDLE
Dim flen As DWord
Dim file As *Byte

'初期化
rcd_len = (5 + 1) * 26					'(文字列5文字 + カンマ) * 26列

'ファイルの読み込み
Print "read"
GetCurrentDirectory(MAX_PATH, path)
lstrcat(path, "\infile1000000.csv")
hFile = CreateFile(path, GENERIC_READ, 0, ByVal NULL, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0)
flen = GetFileSize(hFile, NULL)
rcd_max = (flen + 1) / (rcd_len + 2)

'データ個数の決定と確保
Input "record number =?", n
If n < 1 Or n > rcd_max Then n = rcd_max
data = New [ELM(n)] CSVSORT
work = New [ELM(n) \ 2 + 1] CSVSORT

'行ごとに分解(ファイルポインタの位置のみ)とキーの作成
Print "input data & make keys"
file = calloc(SizeOf(Byte) * 5 + 1)
i = 0
Do
	data.info = i * (rcd_len + 2)
	data.keystr = calloc(SizeOf(Byte) * 10 + 1)
	SetFilePointer(hFile, data.info, NULL, FILE_BEGIN)
	ReadFile(hFile, file, 5, VarPtr(flen), ByVal NULL)
		lstrcpy(data.keystr, file)
	SetFilePointer(hFile, 1, NULL, FILE_CURRENT)
	ReadFile(hFile, file, 5, VarPtr(flen), ByVal NULL)
		lstrcat(data.keystr, file)
	i = i + 1
Loop While i < n
free(file)

'整列
Print "marge-sort",
GetLocalTime(time)
Print time.wMinute; ":"; time.wSecond; ":"; time.wMilliseconds; " -> ";

mergesort_str(0, n - 1, data)					'文字列として比較

GetLocalTime(time)
Print time.wMinute; ":"; time.wSecond; ":"; time.wMilliseconds

'結果の出力
Print "write",
GetCurrentDirectory(MAX_PATH, path)
lstrcat(path, "\result.csv")
Open path For Output As #1
file = calloc(SizeOf(Byte) * rcd_len + 1)
i = 0
Do
	SetFilePointer(hFile, data.info, NULL, FILE_BEGIN)
	ReadFile(hFile, file, rcd_len, VarPtr(flen), ByVal NULL)
	Print #1, MakeStr(file)
	i = i + 1
Loop While i < n
Close #1
free(file)
CloseHandle(hFile)

Delete data
Delete work
Print "end"

'マージソート
'	first	: 整列範囲の最小配列添え字
'	last	: 整列範囲の最大配列添え字
'	a		: データ
Sub mergesort_str(first As Long, last As Long, a As *CSVSORT)
	Dim middle As Long
	Dim i As Long
	Dim j As Long
	Dim k As Long
	Dim p As Long

	If first < last Then
		middle = (first + last) \ 2
		'再起呼び出し
		mergesort_str(first, middle, a)
		mergesort_str(middle + 1, last, a)
		'
		p = 0
		i = first
		Do
			work[p].keystr = a.keystr
			work[p].info = a.info
			p = p + 1
			i = i + 1
		Loop Until i > middle
		i = middle + 1
		j = 0
		k = first
		While i <= last And j < p
			If lstrcmp(work[j].keystr, a.keystr) <= 0 Then
				a[k].keystr = work[j].keystr
				a[k].info = work[j].info
				k = k + 1
				j = j + 1
			Else
				a[k].keystr = a.keystr
				a[k].info = a[i].info
				k = k + 1
				i = i + 1
			End If
		Wend
		While j < p
			a[k].keystr = work[j].keystr
			a[k].info = work[j].info
			k = k + 1
			j = j + 1
		Wend
	End If
End Sub
返信する