Boyer-Moore string search: Difference between revisions
Added Yabasic
(New post.) |
(Added Yabasic) |
||
| (2 intermediate revisions by 2 users not shown) | |||
Line 428:
</syntaxhighlight>
</pre>
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vb">#define max(a, b) iif((a) > (b), (a), (b))
Dim Shared As Integer suff(), bmBc(), bmGs()
Sub preBmBc(pat As String)
Dim As Integer m = Len(pat), i
Redim bmBc(m)
For i = 1 To m-1
bmBc(Cint(pat[i])) = m - i
Next
End Sub
Sub suffixes(pat As String)
Dim As Integer m = Len(pat), g = m, i, f
Redim suff(m)
suff(m) = m
For i = m-1 To 1 Step -1
If i > g And suff(i + m - f) < i - g Then
suff(i) = suff(i + m - f)
Else
If i < g Then g = i
f = i
While g >= 1 And pat[g] = pat[g + m - f]
g -= 1
Wend
suff(i) = f - g
End If
Next
End Sub
Sub preBmGs(pat As String)
Dim As Integer m = Len(pat), j = 1, i
Redim suff(m)
Redim bmGs(m)
For i = m To 1 Step -1
If suff(i) = i Then
While j < m - i
If bmGs(j) = m Then bmGs(j) = m - i
j += 1
Wend
End If
Next
For i = 1 To m-1
bmGs(m - suff(i)) = m - i
Next
End Sub
Sub BM(pat As String, s As String, case_insensitive As Boolean = False)
Dim As String pins = "'" & pat & "' in " & "'" & s & "'"
If case_insensitive Then
pat = Lcase(pat)
s = Lcase(s)
End If
' Preprocessing
preBmGs(pat)
preBmBc(pat)
' Searching
Dim As Integer j = 0, n = Len(s), m = Len(pat), i = m
While j <= n - m
i -= 1
If pat[i] <> s[i+j] Then Exit While
j += Iif(i < 1, bmGs(0), max(bmGs(i), bmBc(Len(s[i+j]) - m + i)))
Wend
Dim As Integer many = Instr(s, pat)
Dim As String tmp = ""
If Not many > 0 Then
Print "No "; pins
Else
Do While many > 0 'if not found loop will be skipped
tmp &= Str(many) & ","
many = Instr(many + 1, s, pat)
Loop
Print Using "Found & at indices [&]"; pins; tmp & Chr(8)
End If
End Sub
BM("GCAGAGAG","GCATCGCAGAGAGTATACAGTACG")
BM("TCTA","GCTAGCTCTACGAGTCTA")
BM("TAATAAA","GGCTATAATGCGTA")
BM("word","there would have been a time for such a word")
BM("needle","needle need noodle needle")
Const book = "InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesley" + _
"DKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeand" + _
"assemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented"
BM("put",book)
BM("and",book)
Const farm = "Nearby farms grew a half acre of alfalfa on the dairy's behalf, with " + _
"bales of all that alfalfa exchanged for milk."
BM("alfalfa",farm)
Sleep</syntaxhighlight>
{{out}}
<pre>Found 'GCAGAGAG' in 'GCATCGCAGAGAGTATACAGTACG' at indices [6]
Found 'TCTA' in 'GCTAGCTCTACGAGTCTA' at indices [7,15]
No 'TAATAAA' in 'GGCTATAATGCGTA'
Found 'word' in 'there would have been a time for such a word' at indices [41]
Found 'needle' in 'needle need noodle needle' at indices [1,20]
Found 'put' in 'InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesleyDKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented' at indices [27,91]
Found 'and' in InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesleyDKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented' at indices [102,129,172]
Found 'alfalfa' in 'Nearby farms grew a half acre of alfalfa on the dairy's behalf, with bales of all that alfalfa exchanged for milk.' at indices [34,88]</pre>
=={{header|J}}==
Line 1,869 ⟶ 1,976:
The same examples have been used as in the Julia entry above.
<syntaxhighlight lang="
/**
* Returns the index within this string of the first occurrence of the
Line 2,015 ⟶ 2,122:
Found 'alfalfa' in 'text6' at indices [33, 87]
</pre>
=={{header|Yabasic}}==
{{trans|FreeBASIC}}
<syntaxhighlight lang="vb">case_insensitive = false
sub preBmBc(pat$)
local m, i
m = len(pat$)
redim bmBc(m)
for i = 1 to m-1
bmBc(val(mid$(pat$, i, 1))) = m - i
next
end sub
sub suffixes(pat$)
local m, g, i, f
m = len(pat$)
g = m
redim suff(m)
suff(m) = m
for i = m-1 to 1 step -1
if i > g and suff(i + m - f) < i - g then
suff(i) = suff(i + m - f)
else
if i < g g = i
f = i
while g >= 1 and mid$(pat$, g, 1) = mid$(pat$, g + m - f, 1)
g = q - 1
wend
suff(i) = f - g
fi
next
end sub
sub preBmGs(pat$)
local m, j, i
m = len(pat$)
j = 1
redim suff(m)
redim bmGs(m)
for i = m to 1 step -1
if suff(i) = i then
while j < m - i
if bmGs(j) = m bmGs(j) = m - i
j = j + 1
wend
fi
next
for i = 1 to m-1
bmGs(m - suff(i)) = m - i
next
end sub
sub BM(pat$, s$, case_insensitive)
local pins
pins$ = "'" + pat$ + "' in " + "'" + s$ + "'"
if case_insensitive then
pat$ = lower$(pat$)
s$ = lower$(s$)
fi
//* Preprocessing *//
preBmGs(pat$)
preBmBc(pat$)
//* Searching *//
j = 0
n = len(s$)
m = len(pat$)
i = m
while j <= n - m
i = i - 1
if mid$(pat$,i,1) <> mid$(s$,i+j,1) break
if i < 1 then j = j + bmGs(0) else j = j + max(bmGs(i), bmBc(len(mid$(s$,i+j,1)) - m + i)) : fi
wend
many = instr(s$, pat$)
tmp$ = ""
if not many > 0 then
print "No ", pins$
else
while many > 0 //if not found loop will be skipped
tmp$ = tmp$ + str$(many) + ","
many = instr(s$, pat$, many + 1)
wend
print "Found ", pins$, " at indices [", tmp$, chr$(8), "]"
fi
end sub
BM("GCAGAGAG","GCATCGCAGAGAGTATACAGTACG")
BM("TCTA","GCTAGCTCTACGAGTCTA")
BM("TAATAAA","GGCTATAATGCGTA")
BM("word","there would have been a time for such a word")
BM("needle","needle need noodle needle")
book$ = "InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesleyDKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented"
BM("put",book$)
BM("and",book$)
farm$ = "Nearby farms grew a half acre of alfalfa on the dairy's behalf, with bales of all that alfalfa exchanged for milk."
BM("alfalfa",farm$)</syntaxhighlight>
{{out}}
<pre>Same as QBasic entry.</pre>
| |||