Find all keywords within a string

[D.J.Peters]

"Find on keywords within a string"

should be "find keywords in a 2D grid" :-)

Joshy

[badidea]

Made the searchtext about a million characters by doubling up.
Number of occurrencies of the three keywords shown, press a key to see the positions (they are all there if you look)

Your version has some problem:
Aborting due to runtime error 6 (out of bounds array access) at line 42 of test.bas::TALLY()

[badidea]

"Find on keywords within a string" should be "find keywords in a 2D grid" :-)

Code: Select all

dim as string keyword(...) => {"Abs","Abstract","Access","Acos","Add","Alias","Allocate","Alpha","And","AndAlso","Append","As","Assert","AssertWarn","Asc","Asin","Asm","Atn","Base","Beep","Bin","Binary","Bit","BitReset","BitSet","BLoad","BSave","ByRef","ByVal","Call","CAllocate","Case","Cast","CByte","CDbl","cdecl","Chain","ChDir","Chr","CInt","Circle","Class","Clear","CLng","CLngInt","Close","Cls","Color","Command","Common","CondBroadcast","CondCreate","CondDestroy","CondSignal","CondWait","Const","Constructor","Continue","Cos","CPtr","CShort","CSign","CSng","CsrLin","CUByte","CUInt","CULng","CULngInt","CUnsg","CurDir","CUShort","Custom","CVD","CVI","CVL","CVLongInt","CVS","CVShort","Data","Date","DateAdd","DateDiff","DatePart","DateSerial","DateValue","Day","Deallocate","Declare","DefByte","DefDbl","defined","DefInt","DefLng","DefLongInt","DefShort","DefSng","DefStr","DefUByte","DefUInt","DefULongInt","DefUShort","Delete","Destructor","Dim","Dir","Do","Draw","DyLibFree","DyLibLoad","DyLibSymbol","Else","ElseIf","Encoding","End","EndIf","Enum","Environ","EOF","Eqv","Erase","Erfn","Erl","Ermn","Err","Error","Event","Exec","ExePath","Exit","Exp","Export","Extends","Extern","False","Field","FileAttr","FileCopy","FileDateTime","FileExists","FileLen","Fix","Flip","For","Format","Frac","Fre","FreeFile","Function","Get","GetJoystick","GetKey","GetMouse","GoSub","Goto","Hex","HiByte","HiWord","Hour","If","IIf","ImageConvertRow","ImageCreate","ImageDestroy","ImageInfo","Imp","Implements","Import","Inkey","Inp","Input","InStr","InStrRev","Int","Is","IsDate","IsRedirected","Kill","LBound","LCase","Left","Len","Let","Lib","Line","LoByte","Loc","Local","Locate","Lock","LOF","Log","Loop","LoWord","LPOS","LPrint","LSet","LTrim","Mid","Minute","MKD","MkDir","MKI","MKL","MKLongInt","Mks","MkShort","Mod","Month","MonthName","MultiKey","MutexCreate","MutexDestroy","MutexLock","MutexUnlock","Naked","Name","Namespace","Next","New","Not","Now","Oct","OffsetOf","On","Once","Open","Operator","Option","Or","OrElse","Out","Output","Overload","Override","Paint","Palette","pascal","PCopy","Peek","PMap","Point","PointCoord","Poke","Pos","Preserve","PReset","Print","Private","ProcPtr","Property","Protected","PSet","Public","Put","Random","Randomize","Read","Reallocate","ReDim","Rem","Reset","Restore","Resume","Return","RGB","RGBA","Right","RmDir","Rnd","RSet","RTrim","Run","SAdd","Scope","Screen","ScreenCopy","ScreenControl","ScreenEvent","ScreenInfo","ScreenGLProc","ScreenList","ScreenLock","ScreenPtr","ScreenRes","ScreenSet","ScreenSync","ScreenUnlock","Second","Seek","Select","SetDate","SetEnviron","SetMouse","SetTime","Sgn","Shared","Shell","Shl","Shr","Sin","SizeOf","Sleep","Space","Spc","Sqr","Static","stdcall","Step","Stick","Stop","Str","Strig","StrPtr","Sub","Swap","System","Tab","Tan","Then","This","ThreadCall","ThreadCreate","ThreadDetach","ThreadWait","Time","TimeSerial","TimeValue","Timer","To","Trans","Trim","Type","Typeof","UBound","UCase","Union","Unlock","Until","Using","Val","ValLng","ValInt","ValUInt","ValULng","Var","VarPtr","View","Virtual","Wait","WBin","WChr","WeekDay","WeekDayName","Wend","While","WHex","Width","Window","WindowTitle","WInput","With","WOct","Write","WSpace","WStr","Xor","Year"}
dim as string allKeywords
dim as integer numKeywords = ubound(keyword) + 1

print "numKeywords: " & str(numKeywords)

for iKeyword as integer = 0 to ubound(keyword)
	'convert keywords to upper case
	keyword(iKeyword) = ucase(keyword(iKeyword))
	'make one long string
	allKeywords &= keyword(iKeyword)
next

function randomCharFrom(text as string) as uinteger
	return text[rnd * len(text)]
end function

'random character grid
const as integer GRID_X = 40, GRID_Y = 20 
dim as uinteger charGrid(GRID_X, GRID_Y)
dim as uinteger markGrid(GRID_X, GRID_Y)

'fill grid
for y as integer = 0 to GRID_Y-1
	for x as integer = 0 to GRID_X-1
		if rnd > 0.1 then
			charGrid(x, y) = randomCharFrom(allKeywords)
		else
			charGrid(x, y) = asc(" ")
		end if
	next
next

dim as double t = timer
dim as integer searchPos
dim as string searchText
'search the grid in x-direction
for y as integer = 0 to GRID_Y-1
	'grid to string
	searchText = string(GRID_X, ".")
	for x as integer = 0 to GRID_X-1
		searchText[x] = charGrid(x, y)
	next
	'find all occurrences of all keywords in a string
	for iKeyword as integer = 0 to ubound(keyword)
		searchPos = 0
		while 1
			searchPos = instr(searchPos + 1, searchText, keyword(iKeyword))
			if searchPos = 0 then exit while
			'print keyword(iKeyword) & " @ " & str(searchPos)
			'mark
			for i as integer = 0 to len(keyword(iKeyword))-1
				markGrid(searchPos + i - 1, y) = 1
			next
		wend
	next
next
'search the grid in y-direction
for x as integer = 0 to GRID_X-1
	'grid to string
	searchText = string(GRID_Y, ".")
	for y as integer = 0 to GRID_Y-1
		searchText[y] = charGrid(x, y)
	next
	'find all occurrences of all keywords in a string
	for iKeyword as integer = 0 to ubound(keyword)
		searchPos = 0
		while 1
			searchPos = instr(searchPos + 1, searchText, keyword(iKeyword))
			if searchPos = 0 then exit while
			'print keyword(iKeyword) & " @ " & str(searchPos)
			'mark
			for i as integer = 0 to len(keyword(iKeyword))-1
				markGrid(x, searchPos + i - 1) = 1
			next
		wend
	next
next
print "time [ms]: "; (timer - t) * 1000

'display grid
print
for y as integer = 0 to GRID_Y-1
	print " ";
	for x as integer = 0 to GRID_X-1
		if markGrid(x, y) = 1 then color 12, 8 else color 7, 8
		print chr(charGrid(x, y));
		color 7, 0
	next
	print
next
print

I better don't call this too often, about 4 ms here.

[dodicat]

Looks good badidea.
I have fixed the bug in my tally function.
Thanks for testing.