ab.com コミュニティ https://www.activebasic.com/forum/ |
|
簡略Boyer-Moore法による文字列照合 https://www.activebasic.com/forum/viewtopic.php?t=343 |
ページ 1 / 1 |
作成者: | mr [ 2005年9月20日(火) 08:06 ] |
記事の件名: | 簡略Boyer-Moore法による文字列照合 |
文字列照合においては最速であるらしい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 = buf2_len Next For i=0 To buf2_len-2 table[buf2] = 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とほとんど変わりありません。 |
作成者: | ゲスト [ 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 = 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 = len_pattern i = i + 1 Loop Until i > UCHAR_MAX If order = 1 Then '正順の場合 i = 0 Do skip[pattern] = 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 - 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 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 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |