ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2018年11月21日(水) 08:21

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 2 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年9月20日(火) 08:06 
文字列照合においては最速であるらしいBoyer-Moore法の簡略版。
コード:
Function _instr( start As Long, buf1 As BytePtr, buf2 As BytePtr) As Long
	Dim i As Long, j As Long
	
	Dim buf1_len As Long, buf2_len As Long
	buf1_len = lstrlen(buf1)
	buf2_len = lstrlen(buf2)
	
	Dim table[255] As Long
	For i=0 To 255
		table[i] = buf2_len
	Next
	For i=0 To buf2_len-2
		table[buf2[i]] = buf2_len-i-1
	Next
	
	i = start-1
	While i<=buf1_len-buf2_len
		
		j = buf2_len-1
		While ((j>-1) And (buf2[j]=buf1[i+j]))
			j = j-1
		Wend
		
		If j=-1 Then
			_instr = i+1
			Exit Function
		End If
		
		i = i+table[buf1[i+buf2_len-1]]
	Wend
	
	_instr = 0
End Function
まぁ、数十メガのファイルでも検索しない限り
AB標準のInStrとほとんど変わりありません。


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年10月10日(月) 01:08 
文字列検索事態の速度はそう変わらないのでしょうが、String型からBytePtr型になっただけでもずいぶんと早くなっているみたい。
また、
コード:
Function InStr( start As Long, buf1 As String, buf2 As String) As Long
	InStr = _instr(start, StrPtr(buf1), StrPtr(buf2)) As Long
End Function
とするだけでも10000回の繰り返しをした時に優位性が出るようですが。

下のは個人的にやってみた逆順検索を付け加えてみました。
コード:
'========================================
'文字列検索(簡易Boyer-Moore法)
'========================================
'引数	offset		被検索文字列の検索開始位置(1~)
'		text		被検索文字列
'		pattern		検索文字列
'		order		検索順路(正順:1、逆順:-1、省略時正順)
'
'戻り値	-1			エラー
'		0			未ヒット
'		>=1			検索文字列の1文字目の位置(1~)
Function _instr(startpos As Long, text As *Byte, pattern As *Byte)(order As Long) As Long
	Const UCHAR_MAX = 255
	Dim i As Long								'
	Dim j As Long								'
	Dim k As Long								'
	Dim len_text As Long						'被検索文字列(text)の文字数(byte単位)
	Dim len_pattern As Long						'検索文字列(pattern)の文字数(byte単位)
	Dim headpos As Long							'patternの先頭位置
	Dim tailpos As Long							'patternの終端位置
	Dim tail As Byte							'patternの終端文字
	Dim c As Byte								'text中のの一文字
	Dim skip[UCHAR_MAX] As Long					'各文字に対するスキップ表

	_instr = -1
	If order >= 0 Then
		order = 1
	Else
		order = -1
	End If
	len_text = lstrlen(text)
	len_pattern = lstrlen(pattern)
	startpos = startpos - 1 + order * (len_pattern - 1)

	'初期エラー判定
	If text = 0 Or len_text <= 0 Or len_text > 2147483647 Then Exit Function
	If pattern = 0 Or len_pattern <= 0 Or len_pattern > len_text Then Exit Function
	If startpos < 0 Or startpos >= len_text Then Exit Function

	Select Case len_pattern
		Case 1									'patternが1文字
			tail = pattern[0]
			i = startpos
			Do
				If text[i] = tail Then
					_instr = i + 1
					Exit Function
				End If
				i = i + order
			Loop While i >= 0 And i < len_text
		Case Else								'patternが2文字以上
			'表の作成
			i = 0
			Do
				skip[i] = len_pattern
				i = i + 1
			Loop Until i > UCHAR_MAX
			If order = 1 Then					'正順の場合
				i = 0
				Do
					skip[pattern[i]] = len_pattern - 1 - i
					i = i + 1
				Loop While i < len_pattern - 1
				headpos = 0
				tailpos = len_pattern - 1
			Else								'逆順の場合
				i = len_pattern - 1
				Do
					skip[pattern[i]] = i
					i = i - 1
				Loop While i > 0
				headpos = len_pattern - 1
				tailpos = 0
			End If
			tail = pattern[tailpos]
			'照合
			i = startpos
			While i >= 0 And i < len_text
				c = text[i]
				If c = tail Then
					j = tailpos
					k = i
					Do
						j = j - order
						k = k - order
						If j = headpos Then
							_instr = i - order * tailpos + 1
							Exit Function
						End If
					Loop While pattern[j] = text[k]
				End If
				i = i + order * skip[c]
			Wend
	End Select
	_instr = 0
End Function


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 2 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[23人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke