cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
JATothrim
Tech Developer
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by JATothrim »

JATothrim, (me) tiputus & nosto @ Esimerkit & tutot: :) Muutaman viikon ajan olen kyhäillyt CB:lle hajautustaulukkoa ja se on nyt jotakuinkin valmis.
Hajautustaulukon ideana on, että sinulla on "avainarvo", jonka perusteella voit kaivaa hajautustaulukosta toisen avainarvoon liitetyn arvon. Hajautustaulukko ei ole lineaarinen tietosäiliö, kuten CB Kokoelmat. Hajautustaulukko näin nopea: sinun ei koskaan tarvitse käydä kaikkia 10000 enityäsi läpi, jotta saisit tavaran "miekka" ominaisuudet. (esim. power, defence, tyypi jne.) Yksi kutsu cbHashTbl_Access() funktioon riittää. Sen aika vaativuus on pyöreästi vakio. Hajautustaulukolla on yksi rajoite: taulukon koko pitäisi tuntea etukäteen ja sen uudelleen venyttäminen on erittäin raskasta. Tarkempi selostus löytyy wikipediasta.

Kirjastosta puuttuu oikeastaan enää yksi kriittinen ominaisuus ja se on hajautustaulukon uudelleen venyttäminen - mutta koska se on mahdollista tehdä jo kirjaston nykyisillä funktioilla, jukaisen kirjaston jo nyt. Selvittäkää bugeja, mahdollisia koodausvirheitä, parannuksia ja - kommentoikaa. ;)
Ominaisuuksia:
-Kirjasto käyttää pelkästään muistipaloja, jonka ansiosta voit luoda hajautustaulukkoja loputtomasti ja tunkea sellaisen vaikka typeen tai välittää funktiolle.
-cbHashTbl omistaa sisältämänsä datan, joten sinun ei tarvitse pitää käyttämiäsi muistipaloja tallessa.
-cbHashTbl tukee vakio mittaisia merkkijonoavaimia ja dataa.
-Hautustaulukon sisältö voidaan läpikäydä tarvittaessa avain ja elementti kerrallaan.
-Hajautustaulukko sallii useat identtiset avaimet, mikäli g_MultiElementMode on asetettu todeksi.

Tässä Include "cbHashTable.cb" :

Code: Select all

// cbHashTable - nopea hajautustaulukko CoolBasic:lle. (C) JATothrim 2010.

SCREEN 800,600
Dim cbHashTbl_PrimeTbl(28)	// prime table For hash Function(s)
cbHashTbl_PrimeTbl(0) = 5
cbHashTbl_PrimeTbl(1) = 13
cbHashTbl_PrimeTbl(2) = 23
cbHashTbl_PrimeTbl(3) = 47
cbHashTbl_PrimeTbl(4) = 97
cbHashTbl_PrimeTbl(5) = 193
cbHashTbl_PrimeTbl(6) = 389
cbHashTbl_PrimeTbl(7) = 769
cbHashTbl_PrimeTbl(8) = 1543
cbHashTbl_PrimeTbl(9) = 3079
cbHashTbl_PrimeTbl(10) = 6151
cbHashTbl_PrimeTbl(11) = 12289
cbHashTbl_PrimeTbl(12) = 24593
cbHashTbl_PrimeTbl(13) = 49157
cbHashTbl_PrimeTbl(14) = 98317
cbHashTbl_PrimeTbl(15) = 196613
cbHashTbl_PrimeTbl(16) = 393241
cbHashTbl_PrimeTbl(17) = 786433
cbHashTbl_PrimeTbl(18) = 1572869
cbHashTbl_PrimeTbl(19) = 3145739
cbHashTbl_PrimeTbl(20) = 6291469
cbHashTbl_PrimeTbl(21) = 12582917
cbHashTbl_PrimeTbl(22) = 25165843
cbHashTbl_PrimeTbl(23) = 50331653
cbHashTbl_PrimeTbl(24) = 100663319
cbHashTbl_PrimeTbl(25) = 201326611
cbHashTbl_PrimeTbl(26) = 402653189
cbHashTbl_PrimeTbl(27) = 805306457
cbHashTbl_PrimeTbl(28) = 1610612741

Global g_HashTblMem As integer		//Memblock
Global g_MultiElementMode As Byte	//True/False
Global g_HashTblBucketExists As Byte//Flag. If false after cbHashTbl_Insert(), new bucket were created. 
g_HashTblMem = 0
g_MultiElementMode = False			//use cbHashTbl As HashSet(unique keys) Or HashMultiSet(non-unique keys)

// Public utility functions

// Modified CRC32 hash.
Function DoCRC32_Hash(memblock, prime)
	Dim a
	a = Crc32(memblock)
	If a < 0 Then a = a - (1 Shl 31)
	Return a Mod prime
EndFunction

Function FindNearestPrime(size As integer)
	Dim i
	For i = 0 To 28
		If cbHashTbl_PrimeTbl(i) > size Then Return cbHashTbl_PrimeTbl(i)
	Next i
EndFunction

// Creates new "key" memblock for hashtable with text.
Function NewStringKey(hstbl, txt$, empty$ = " ")
	Dim keymem, i, sz
	sz = PeekInt(hstbl, SCTbl_KeySize)
	keymem = MakeMEMBlock(sz)
	StringValue(keymem, txt, empty)
	Return keymem
EndFunction

// Creates new "element" memblock for hashtable with text.
Function NewStringElement(hstbl, txt$, empty$ = " ")
	Dim elementmem, i, sz
	sz = PeekInt(hstbl, SCTbl_ElementSize)
	elementmem = MakeMEMBlock(sz)
	StringValue(elementmem, txt, empty)
	Return elementmem
EndFunction

// Writes string to memblock
Function StringValue(keymem, txt$, empty$ = " ")
	Dim i, sz
	sz = MEMBlockSize(keymem)
	For i = 0 To sz-1
		If i < Len(txt)
			PokeByte keymem, i, Asc(Mid(txt, i+1, 1))
		Else
			PokeByte keymem, i, Asc(empty)
		EndIf
	Next i
	Return keymem
EndFunction

// Reads string from memblock
Function GetStringValue(memblock)
	Dim i, sz, txt As String
	sz = MEMBlockSize(memblock)
	For i = 0 To sz-1
		txt = txt + Chr(PeekByte(memblock, i))
	Next i
	Return txt
EndFunction

// Read string-element from offset. Use only if g_HashTblMem is non-zero.
Function GetStringElement$(hstbl, offset)
	Dim i, sz
	Dim txt As String
	sz = PeekInt(hstbl, SCTbl_ElementSize)
	For i = 0 To sz-1
		txt = txt + Chr(PeekByte(g_HashTblMem, offset + i))
	Next i
	Return txt
EndFunction

// Read string-key from offset. Use only if g_HashTblMem is non-zero.
Function GetStringKey$(hstbl, offset)
	Dim i, sz
	Dim txt As String
	sz = PeekInt(hstbl, SCTbl_KeySize)
	For i = 0 To sz-1
		txt = txt + Chr(PeekByte(g_HashTblMem, offset + i))
	Next i
	Return txt
EndFunction

// SeekConst(s) for
Const SCTbl_Elements = 0		'Elements in hashtable
Const SCTbl_TableSize = 4		'Allocated table size
Const SCTbl_KeySize		= 8		'size of key
Const SCTbl_ElementSize = 12	'size of Element
Const SCTbl_UsedBuckets = 16	'Amount of buckets in use
Const SCTbl_BucketAlloc = 20	'count of slots in bucket, when allocated Or resized.
Const SCTbl_FirstBucket = 24	

// Create new hash table.
// Param: [buckets_init] - max buckets in hashtable
// Param: [key_size] - size of the key, in bytes.
// Param: [element_size] - size of invidual element to store, in bytes.
// Param: [initial_bucketsz] - see [SCTbl_BucketAlloc] const.
// Returns: New initialized memblock for cbHashTable.
Function CreateHashTable(buckets_init, key_size, element_size, initial_bucketsz = 5)
	Dim hstbl
	buckets_init = FindNearestPrime(buckets_init)
	hstbl = MakeMEMBlock(SCTbl_FirstBucket + buckets_init*4)
	PokeInt hstbl, SCTbl_TableSize, buckets_init
	PokeInt hstbl, SCTbl_ElementSize, element_size
	PokeInt hstbl, SCTbl_KeySize, key_size
	PokeInt hstbl, SCTbl_BucketAlloc, initial_bucketsz
	Return  hstbl
EndFunction

// Checks if bucket allredy contains the key.
// [For library internal use]
Function cbHashTbl_CheckDuplicate(bucket, keymem, keysz, elementsz, sz = -1, startindex = 0)
	Dim i, check, checkmem
	If sz = -1 Then sz = PeekInt(bucket, 0)
	check = Crc32(keymem)
	checkmem = MakeMEMBlock(keysz)
	For i = startindex To sz-1
		MemCopy bucket, i*(keysz+elementsz) + 4, checkmem, 0, keysz
		If Crc32(checkmem) = check
			If cbHashTbl_KeyCMP(bucket, keymem, i, keysz, elementsz)
				DeleteMEMBlock checkmem
				Return i
			EndIf
		EndIf
	Next i
	DeleteMEMBlock checkmem
	Return -1
EndFunction

//Byte-to-byte key compare.
// [For library internal use]
Function cbHashTbl_KeyCMP(bucket, keymem, index, keysz, elementsz)
	Dim i
	For i = 0 To keysz-1
		If PeekByte(keymem, i) <> PeekByte(bucket, 4 + index * (keysz+elementsz) + i) Then Return False
	Next i
	Return True
EndFunction

//Insert element to hashtable.
// Gets: [g_MultiElementMode] - allow collisions?
// Param: [hstbl] - hashtable
// Param: [keymem] - memblock to key value (data is copied into hashtable.)
// Param: [elementmem] - memblock to element (data is copied into hashtable.)
// Sets: [g_HashTblBucketExists] - true if inserting to old bucket.
// Returns: True on success.
Function cbHashTbl_Insert(hstbl, keymem, elementmem)
	Dim index, bucket, sz, elementsz, keysz, i, check, checkmem
	index = DoCRC32_Hash(keymem, PeekInt(hstbl, SCTbl_TableSize)) * 4 + SCTbl_FirstBucket
	bucket = PeekInt(hstbl, index)
	elementsz = PeekInt(hstbl, SCTbl_ElementSize)
	keysz = PeekInt(hstbl, SCTbl_KeySize)
	If bucket <> 0
		g_HashTblBucketExists = True
		sz = PeekInt(bucket, 0)
		If g_MultiElementMode = False And sz > 0
			If cbHashTbl_CheckDuplicate(bucket, keymem, keysz, elementsz, sz) > -1 Then Return False
		EndIf
		
		If (keysz+elementsz) * (sz+1) + 4 > MEMBlockSize(bucket)
			ResizeMEMBlock bucket, (sz + PeekInt(hstbl, SCTbl_BucketAlloc)) * (keysz + elementsz) + 4
		EndIf
	Else
		g_HashTblBucketExists = False
		bucket = MakeMEMBlock(4+(elementsz+keysz) * PeekInt(hstbl, SCTbl_BucketAlloc))
		PokeInt hstbl, SCTbl_UsedBuckets, PeekInt(hstbl, SCTbl_UsedBuckets) + 1
		PokeInt hstbl, index, bucket
	EndIf
	
	MemCopy keymem, 0, bucket, 4 + sz * (keysz + elementsz), keysz
	MemCopy elementmem, 0, bucket, 4 + sz * (keysz + elementsz) + keysz, elementsz
	PokeInt bucket, SCTbl_Elements, sz + 1
	
	Return True
EndFunction

//Read single element from hashtable.
// Param:	[hstbl] - hashtable
// Param:	[keymem] - memblock to key value
// Sets:	[g_HashTblMem] - Memblock to where element is currently stored.
//			If hashtable can't find the element mapped to [keymem],  g_HashTblMem is set to zero.
// Returns:	Offset to first element in g_HashTblMem. If [g_MultiElementMode] mode is enabled
//			returned value is 0 eg. DOES NOT point to any element: Use
//			cbHashTbl_NextBckElement() To get the elements. Return value is undefined
//			if Sets:[g_HashTblMem] does not contain memblock.
Function cbHashTbl_Access(hstbl, keymem)
	Dim vbucket, sz, keysz, elementsz, index
	vbucket = DoCRC32_Hash(keymem, PeekInt(hstbl, SCTbl_TableSize)) * 4 + SCTbl_FirstBucket
	g_HashTblMem = PeekInt(hstbl, vbucket)
	If g_HashTblMem <> 0
		sz = PeekInt(g_HashTblMem, 0)
		If sz > 0
			keysz = PeekInt(hstbl, SCTbl_KeySize)
			elementsz = PeekInt(hstbl, SCTbl_ElementSize)
			index = cbHashTbl_CheckDuplicate(g_HashTblMem, keymem, keysz, elementsz, sz)
			If index <> -1
				If g_MultiElementMode = True Then Return 0
				Return  index * (keysz+elementsz) + keysz + 4
			Else
				g_HashTblMem = 0
			EndIf
		Else
			g_HashTblMem = 0
		EndIf
	EndIf
	If g_MultiElementMode = True Then Return 0
EndFunction

// Iterate throught single bucket of elements, [g_MultiElementMode] only operation.
// Param: [hstbl] - hashtable.
// Param: [offset] - Zero: get first element. Variable: get next element.
// Returns: Offset for [g_HashTblMem] or Zero if there is no more elements mapped to key.
Function cbHashTbl_NextBck(hstbl, keymem, offset)
	Dim keysz, elementsz
	keysz = PeekInt(hstbl, SCTbl_KeySize)
	elementsz = PeekInt(hstbl, SCTbl_ElementSize)
	If offset = 0
		offset = cbHashTbl_CheckDuplicate(g_HashTblMem, keymem, keysz, elementsz, -1, 0)
		If offset = -1 Then Return 0 Else Return offset * (keysz + elementsz) + keysz + 4
	Else
		offset = (offset-4) / (keysz + elementsz)
		offset = cbHashTbl_CheckDuplicate(g_HashTblMem, keymem, keysz, elementsz, -1, offset+1)
		If offset = -1 Then Return 0
		Return offset * (keysz + elementsz) + keysz + 4
	EndIf
EndFunction


// Start to iterate thought the Hashtable. Iterated keys are read only, so if you overwrite
// a key throught the iterator the cbHashTbl may break completly.
// Param: [hstbl] - hashtable.
// Param: [itermem] - (optional) old iterator memblock to initate.
// Param: [mode] - (optional) iterate keys:0 or elements:1?
// Returns:	iterator memblock or zero if hashtable is empty.
Function cbHashTbl_IterateBegin(hstbl, itermem = 0, mode = 1)
	Dim i, keysz
	If itermem = 0 Then itermem = MakeMEMBlock(16)
	keysz = PeekInt(hstbl, SCTbl_KeySize)
	PokeInt itermem, 0, hstbl
	PokeInt itermem, 4, -1
	PokeInt itermem, 8, 0
	PokeInt itermem, 12, keysz*(mode = 1)
	Return itermem
EndFunction

// Get next element/key in the Hashtable. Note: to read both key and mapped element iterate first
// to key and then to element.
// Param:	[itermem] - iterator memblock.
// Param:	[mode] - (default is elements) iterate keys:0 or elements:1
// Returns:	true if got valid element and false if all elements have been
//			iterated. 
Function cbHashTbl_Next(itermem, mode = 1)
	Dim i, hstbl, bucket, readpos, sz, keysz, index, bckind, tblsz
	hstbl = PeekInt(itermem, 0)		//get iterated hashtbl
	bckind = PeekInt(itermem, 4)
	index = PeekInt(itermem, 8)	//get current element
	readpos = PeekInt(itermem, 12)	//get offset setting (was Last Read element Or key?)
	If bckind > -1
		bucket = PeekInt(hstbl, SCTbl_FirstBucket + bckind * 4) //get current bucket
		sz = PeekInt(bucket, 0)		//get bucket size
	EndIf
	
	keysz = PeekInt(hstbl, SCTbl_KeySize)
	If readpos = 0 And mode = 1 And bckind <> -1 
		PokeInt itermem, 12, keysz
		
	ElseIf sz <= index+1 Or bckind = -1 
		// move To Next bucket.
		tblsz = PeekInt(hstbl, SCTbl_TableSize)
		For i = bckind+1 To tblsz
			bucket = PeekInt(hstbl, SCTbl_FirstBucket + i * 4)
			If bucket <> 0
				If PeekInt(bucket, 0) > 0
					PokeInt itermem, 4, i
					PokeInt itermem, 8, 0
					PokeInt itermem, 12, keysz*(mode = 1)
					Return True
				EndIf
			EndIf
		Next i
		Return False
	Else
		PokeInt itermem, 8, index + 1
		PokeInt itermem, 12, keysz*(mode = 1)
		Return True
	EndIf
EndFunction

// Get Memblock of the Iterator
// Param:	[itermem] - iterator memblock.
// Returns: Memblock.
Function cbHashTbl_IterMem(itermem)
	Dim hstbl
	hstbl = PeekInt(itermem, 0)
	Return PeekInt(hstbl, SCTbl_FirstBucket + PeekInt(itermem, 4) * 4)
EndFunction

// Get offset in current iterator memblock for eg. PeekInt.
// Param:	[itermem] - iterator memblock.
// Param:	[userpadd] - add userpadd to base offset.
// Returns:	calculated offset for cbHashTbl_IterMem() returned memblock.
Function cbHashTbl_Offset(itermem, userpadd = 0)
	Dim hstbl, keysz, elementsz, index, padd
	hstbl = PeekInt(itermem, 0)
	keysz = PeekInt(hstbl, SCTbl_KeySize)
	elementsz = PeekInt(hstbl, SCTbl_ElementSize)
	index = PeekInt(itermem, 8)
	padd = PeekInt(itermem, 12) + userpadd
	Return  4 + padd + (keysz+elementsz)*index
EndFunction

// Read data at iterator location.
// Param:	[itermem] - iterator memblock.
// Param:	[usermem] - memblock to where write data. If zero, data
//						is read as one int:0, float:1, short:2 or byte:4.
//						Memblock must be big enough to store pointed key nor element.
// Param:	[valuetype] - type of data to read, ignored if usermem is non-zero.
Function cbHashTbl_Read(itermem, usermem, valuetype = -1)
EndFunction

//Delete element from hashtable. Note: this function may free the bucket memblock
// if bucket elements are reduced to zero.
// Param: [hstbl] - hashtable
// Param: [keymem] - memblock to key value
// Param: [delmode] - (0): remove first matching element.
//					- (1): remove all elements mapped to key.
//					- (2): delete the [bucket] where the keymem maps
// Returns: number of element deleted.
Function cbHashTbl_Delete(hstbl, keymem, delmode = 0)
	Dim index, bucket, sz, elementsz, keysz, i, pos, removed
	index = DoCRC32_Hash(keymem, PeekInt(hstbl, SCTbl_TableSize)) * 4 + SCTbl_FirstBucket
	bucket = PeekInt(hstbl, index)
	If bucket <> 0
		sz = PeekInt(bucket, 0)
		elementsz = PeekInt(hstbl, SCTbl_ElementSize)
		keysz = PeekInt(hstbl, SCTbl_KeySize)
		If delmode = 2 Or sz = 1
			DeleteMEMBlock bucket
			PokeInt hstbl, index, 0
			PokeInt hstbl, SCTbl_UsedBuckets, PeekInt(hstbl, SCTbl_UsedBuckets)-1
			removed = sz
		ElseIf delmode = 0
			i = cbHashTbl_CheckDuplicate(bucket, keymem, keysz, elementsz, sz)
			If i <> -1
				// perform Delete
				If i < sz-1 And sz > 0
					pos = i*(elementsz+keysz) + 4
					MemCopy bucket, pos + (elementsz+keysz), bucket, pos, (sz-i) * (elementsz+keysz) 
				EndIf
				PokeInt bucket, 0, sz-1
				removed = 1
			EndIf
		ElseIf delmode = 1
			Repeat
				i = cbHashTbl_CheckDuplicate(bucket, keymem, keysz, elementsz, sz)
				If i <> -1
					g_HashTblMem = bucket
					// perform Delete
					If i < sz-1 And sz > 0
						pos = i*(elementsz+keysz) + 4
						MemCopy bucket, pos + (elementsz+keysz), bucket, pos, (sz-i) * (elementsz+keysz) 
					EndIf
					sz = sz - 1
					removed = removed + 1
				Else
					Exit
				EndIf
			Forever
			PokeInt bucket, 0, sz
		EndIf
	EndIf
	PokeInt hstbl, SCTbl_Elements, PeekInt(hstbl, SCTbl_Elements)-removed
	Return removed		
EndFunction

// Resizes hashtable.
// Param: [hstbl] - hashtable
// Param: [newsize] - new size of the hashtable
// Returns: Resized hashtable, old is destroyed.
Function cbHashTbl_Resize(hstbl, newsize)
EndFunction


// Copies hashtable A contents into HashTable B. 
// Param: [hstblA] - source hashtable
// Param: [hstblB] - destination hashtable
// Param: [keymem] - (optional) if provided, moves only one element.
// Param: [rpl] - replace hstblB contents if key is not unique in hstblB.
Function cbHashTbl_Copy(hstblA, hstblB, keymem = 0, rpl = 1)
EndFunction

// Removes all hashtable elements
// Param: [hstbl] - hashtable
// Param: [freebuckets] - if true, free allocated memory, don't recycle.
Function cbHashTbl_Flush(hstbl, freebuckets = 1)
EndFunction
Tässä sekalainen testi koodi:

Code: Select all

//(C) JATothrim 2010.
Const keylen = 10
Dim hstbl, key, element, i, j, z, x, y, fbck, ticks, vkey

Dim msgresult(1) As String
msgresult(1) = "Ok."
msgresult(0) = "Fail."

hstbl = CreateHashTable(50, keylen, 20)

key = NewStringKey(hstbl, "xyzq")
element = NewStringElement(hstbl, "test_element","-")

'g_MultiElementMode = True

//###########################################################
//#					cbHashTbl_Insert() testing.				#
//###########################################################
For i = 0 To 100
	StringValue(key, Str(vkey),"_")
	StringValue(element, "test_element "+Str(vkey),"-")
	vkey = vkey + Rand(4) '1/4 of insertions will fail.
	
	z = cbHashTbl_Insert(hstbl, key, element)
	
	Print "Insert: "+msgresult(z)
Next i
WaitKey:Cls:Locate 0,0


StringValue(key, "xyz1")
StringValue(element, "one")
Print "Insert "+Chr(34)+"xyz1"+Chr(34)+" "+msgresult(cbHashTbl_Insert(hstbl, key, element))
StringValue(key, "xyz2")
StringValue(element, "two two")
Print "Insert "+Chr(34)+"xyz2"+Chr(34)+" "+msgresult(cbHashTbl_Insert(hstbl, key, element))
StringValue(key, "xyz3")
StringValue(element, "three three three")
Print "Insert "+Chr(34)+"xyz3"+Chr(34)+" "+msgresult(cbHashTbl_Insert(hstbl, key, element))

// "a1sellers" and "advertees" have same crc32 hash. (so later will pass 2/3 of the unique insertion checks)
StringValue(key, "a1sellers")
StringValue(element, "this ok")
z = cbHashTbl_Insert(hstbl, key, element)
Print "Insert "+Chr(34)+"a1sellers"+Chr(34)+" "+msgresult(z)
StringValue(key, "advertees")
StringValue(element, "this not so ok")
z = cbHashTbl_Insert(hstbl, key, element)
Print "Insert "+Chr(34)+"advertees"+Chr(34)+" "+msgresult(z)

//###########################################################
//#					cbHashTbl_Access() testing.				#
//###########################################################
Dim offset
If g_MultiElementMode
	// Insert multiple elements To cbHashtbl And iterate them all. (but Not the Crc32 collied ones!)
	StringValue(key, "advertees")
	StringValue(element, "jeba!")
	cbHashTbl_Insert(hstbl, key, element):Print " "
	StringValue(element, "moar!")
	cbHashTbl_Insert(hstbl, key, element):Print " "
	StringValue(element, "partyy!")
	cbHashTbl_Insert(hstbl, key, element):Print " "
	Write "[g_MultiElementMode] Access: "
	cbHashTbl_Access(hstbl, key)					//Select bucket.
	If g_HashTblMem
		offset = cbHashTbl_NextBck(hstbl, key, 0)	//Get start offset.
		While offset
			Print GetStringElement(hstbl, offset)
			offset = cbHashTbl_NextBck(hstbl, key, offset) // Iterate all elements mapped To [key]
		Wend
	EndIf
Else
	Write "Access: "
	offset = cbHashTbl_Access(hstbl, StringValue(key, "xyz2"))
	If g_HashTblMem
		Print "Element mapped to "+Chr(34)+"xyz2"+Chr(34)+" found:"+Chr(34)+GetStringElement(hstbl, offset)+Chr(34)
	EndIf
	Write "Access: "
	offset = cbHashTbl_Access(hstbl, StringValue(key, "advertees"))
	If g_HashTblMem
		Print "Element mapped to "+Chr(34)+"advertees"+Chr(34)+" found:"+Chr(34)+GetStringElement(hstbl, offset)+Chr(34)
	EndIf
EndIf
WaitKey:Cls:Locate 0,0

//###########################################################
//#					cbHashTbl_Next() testing.				#
//###########################################################
Dim itr
itr = cbHashTbl_IterateBegin(hstbl, itr)
While cbHashTbl_Next(itr, 0)
	g_HashTblMem = cbHashTbl_IterMem(itr)
	offset = cbHashTbl_Offset(itr)
	Write GetStringKey(hstbl, offset)+" --> "
	cbHashTbl_Next(itr, 1)
	g_HashTblMem = cbHashTbl_IterMem(itr)
	offset = cbHashTbl_Offset(itr)
	Print GetStringElement(hstbl, offset)
Wend
DeleteMEMBlock itr
WaitKey:Cls:Locate 0,0

//###########################################################
//#					cbHashTbl_Delete() testing.				#
//###########################################################
Write "deleting key xyz1.. "
z = cbHashTbl_Delete(hstbl, StringValue(key, "xyz1"))
offset = cbHashTbl_Access(hstbl, key)
If g_HashTblMem = 0 Then Print "Ok. ("+z+" deleted)" Else Print "Failed."

Print "deleting key advertees.. "
z = cbHashTbl_Delete(hstbl, StringValue(key, "advertees"), 1)
cbHashTbl_Access(hstbl, key)
If g_HashTblMem
	Print "Failed To delete elements:"
	offset = cbHashTbl_NextBck(hstbl, key, 0)	//Get start offset.
	While offset
		Print GetStringElement(hstbl, offset)
		offset = cbHashTbl_NextBck(hstbl, key, offset) // Iterate all elements mapped To [key]
	Wend
Else
	Print "Ok. ("+z+" deleted)"
EndIf


Write "deleting bucket xyz2.. "
z = cbHashTbl_Delete(hstbl, StringValue(key, "xyz2"),2)
offset = cbHashTbl_Access(hstbl, key)
If g_HashTblMem = 0 Then Print "Ok. ("+z+" deleted)" Else Print "Failed."	
WaitKey
Last edited by JATothrim on Tue Jun 15, 2010 2:15 am, edited 1 time in total.
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.
User avatar
valscion
Moderator
Moderator
Posts: 1599
Joined: Thu Dec 06, 2007 7:46 pm
Location: Espoo
Contact:

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by valscion »

Vaikuttaa aikas loistavalta :). Itse en nyt pääse testaamaan koodia, mutta haluaisin nähdä jonkinmoisen vertailun tämän HashTablen ja normaalien tyyppien välisistä nopeuseroista. Joku 10000 kertaa iteroiva koodi, jossa verrattaisiin tyyppien ja tämän hashtablen nopeuseroa, olisi aika killeri lisäys tuohon aloitusviestiin. Sais ainakin heti selville, onko tästä kirjastosta hyötyä esim. RPG-peliä tehtäessä.
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com
JATothrim
Tech Developer
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by JATothrim »

VesQ wrote:Vaikuttaa aikas loistavalta :). Itse en nyt pääse testaamaan koodia, mutta haluaisin nähdä jonkinmoisen vertailun tämän HashTablen ja normaalien tyyppien välisistä nopeuseroista. Joku 10000 kertaa iteroiva koodi, jossa verrattaisiin tyyppien ja tämän hashtablen nopeuseroa, olisi aika killeri lisäys tuohon aloitusviestiin. Sais ainakin heti selville, onko tästä kirjastosta hyötyä esim. RPG-peliä tehtäessä.
cbHashTbl:n luulisi voittavan tuon kisan, mikäli taulukko on vain tarpeeksi "väljä". cbHashTbl käyttää nyt ainoastaan "Separate chaining with dynamic array" tekniikkaa estämään törmäykset.
Parempi tapa olisi yksinkertaisesti yrittää uudelleen elementin sijoitusta: lasketaan uusi hash, koetetaan onko uudessa paikassa elementti ja toistenaan niin kauan kunnes uudelle elementille löytyy vapaa paikka hajautus taulukosta. CRC32() toimii nyt primääri hash funktiona ja sekundäärisestä hajautusfunktiosta ei ole hajuakaan. kehitelen asiaa. :)
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.
User avatar
Dibalo
Advanced Member
Posts: 298
Joined: Mon Aug 27, 2007 8:12 pm
Location: Espoo, Finland
Contact:

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by Dibalo »

Tuo toteutus on hieman oudohko, eikä mielestäni ole kunnon hajautustaulu, vaan eräänlainen hajautustaulun ja linkitetyn listan välimuoto, jonka aikakompleksisuus ei suinkaan ole O(1) (tai O(1 + k/n) taitaa olla tarkka), johtuen siitä että törmäykset näyttäisivät menevät jonkinlaisen listan tapaiseen (mikäli luin nopsasti koodia oikein).

Päätinpä siis istahtaa CB-editorin ääreen kahden vuoden jälkeen ja koettaa pyöräyttää jotain. Tuloksena oma yritelmäni hajautustaulun toteutuksesta:

Code: Select all

//// hajautustaulu CoolBasic:lle
//// (c) Matti Lankinen

//// Hajautustaulun tiedot.
//// Tämä tyyppi ei ole tarkoitettu käyttäjän suoraan 
//// käytettäväksi.
Type HashTable
    Field _data As Integer
    Field _sz As Integer
    Field _used As Integer
EndType

//// Yhden hajautustaulun "entryn" eli avain-arvo-parin
//// tiedot. Tämä tyyppi ei ole tarkoitettu käyttäjän
//// suoraan käytettäväksi
Type HashEntry
    Field _key As Integer
    Field _value As Integer
EndType

//// Satunnaislukutaulukon koko (tarvitaan hash-funktioon)
Const gRandomHashSize = 25

//// Kerroin, joka määrittää hajautustaulun koon suhteessa käyttöasteeseen.
Const gHashLoadFactor = 1.8
//// Yhden hajautustaulun entryn koko. Käytännössä 32-bittinen kokonaisluku.
Const gHashEntrySize = 4
//// Tunnistetieto, jolla merkkijonoavain voidaan identifioida
Const gHashKeyTypeString = 99887766

//// Hautakivi-entry eli merkki entrystä, joka on poistettu
//// Tätä arvoa ei saa muuttaa ajon aikana, tai hajautustaulun toiminta
//// vaarantuu täysin.
Global gDeletedEntry
gDeletedEntry = ConvertToInteger(New(HashEntry))

//// Avainmuistipalan otsikko-osan koko.
Const gKeyHeaderSize = 12
//// Avainmuistipalan avaimen hash-arvon offset muistipalassa.
Const gHashOffset = 0
//// Avainmuistipalan avaimen datan koon (tavuina) offset muistipalassa.
Const gKeySizeOffset = 4
//// Avainmuistipalan avaimen datan ensimmäisen tavun offset muistipalassa.
Const gKeyDataOffset = 12
//// Avainmuistipalan avaimen tyypin  offset muistipalassa.
Const gKeyTypeOffset = 8

//// Taulukko satunnaisluvuista, joiden avulla voidaan generoida tarpeeksi
//// hyvä hajautusarvo hash-funktiolla. Näitä arvoja EI SAA MUUTTAA AJON
//// AIKANA, tai muuten hajautustaulun toiminta vaarantuu pahoin.
Dim gRandomHash(30)
gRandomHash(0) = 36272
gRandomHash(1) = 16
gRandomHash(2) = 60957
gRandomHash(3) = 2748421
gRandomHash(4) = 6579478
gRandomHash(5) = 8521
gRandomHash(6) = 929362
gRandomHash(7) = 12
gRandomHash(8) = 3627
gRandomHash(9) = 6
gRandomHash(10) = 963
gRandomHash(11) = 27
gRandomHash(12) = 4378112
gRandomHash(13) = 35478321
gRandomHash(14) = 4583
gRandomHash(15) = 632287
gRandomHash(16) = 172727
gRandomHash(17) = 3463
gRandomHash(18) = 5097659
gRandomHash(19) = 7347267
gRandomHash(20) = 3578654
gRandomHash(21) = 49
gRandomHash(22) = 213852
gRandomHash(23) = 689459
gRandomHash(24) = 12125





//Function __dbg(val)
//    Print val
//    WaitKey 
//EndFunction


//// Hajautusfunktio, joka ottaa parametrikseen muistipalan, josta hash-arvo
//// tulee laskea. Oletustoteutus käyttää CB:n omaa CRC32-tarkistusta sen
//// nopeuden (???) takia. Paluuarvo on positiivinen kokonaisluku. Käyttäjän
//// ei tarvitse huolehtia tästä arvosta.
//// @param mem 
////        Muistipala, josta hash tulee laskea. Tämä muistipala noudattaa
////        samaa muistijärjestystä kuin yllä on määritely (koko vähintään
////        gKeyHeaderSize koko).
Function __hash(mem%)
    Return Abs(Crc32(mem))
EndFunction

//// Apuhajautusfunktio, jolla saadaan (toivon mukaan) sekundaarinen
//// kertymä mahdollisimman pieneksi ja näin hajautustaulu mahdollisimman
//// tasaisesti kuormitetuksi. Käyttäjän ei tarvitse käyttää tätä
//// @param hash __hash-funktion palauttama arvo (1. hash)
//// @param i Yrityskerta, tätä tulee kasvattaa jokaisella hajautusyrityksellä.
//// @retval Uusi hash-arvo vanhan ja uuden yhdistelmänä.
Function __hash2(hash%, i%)
    If i = 0 Then Return hash
    hash = (hash Shl i) + hash + 1
    For j = 0 To 10
        hash = gRandomHash(Int(Abs(j * i * hash)) Mod gRandomHashSize)
    Next j
    Return Int(Abs(hash))
EndFunction

//// Vertailee kahta muistipalana annettua avainta ja palauttaa tiedon
//// siitä, ovatko avaimet varmasti täysin samat. Tämä ei ota kuitenkaan
//// huomioon sitä, ovatko avaimet samaa tyyppiä. Kutsuja tulee huolehtia
//// siitä, ovatko avaimet samaa tyyppiä vai eivät. Eri tyyppisissä tapauksissa
//// paluuarvon oikeellisuus ei ole luotettavaa.
Function __key_compare(key1%, key2%)
    _type1% = PeekInt(key1, gKeyTypeOffset)
    _type2% = PeekInt(key2, gKeyTypeOffset)
    If _type1 <> _type2 Then Return False
    If _type1 = gHashKeyTypeString Then
        // merkkijonotarkastus
        If PeekInt(key1, gKeySizeOffset) <> PeekInt(key2, gKeySizeOffset) Then Return False
        // pituus
        l% = PeekInt(key1, gKeySizeOffset) - 1
        For i = 0 To l
            If PeekByte(key1, gKeyDataOffset + i) <> PeekByte(key2, gKeyDataOffset + i) Then Return False
        Next i
        Return True
    Else
        // muut vaihtoedhot kokonaislukuja ->
        // voidaan suoraan verrata bittikuvioita
        If PeekInt(key1, gKeyDataOffset + 4) <> PeekInt(key2, gKeyDataOffset + 4) Then Return False
        Return True 
    EndIf
EndFunction

//// Vapauttaa yhden avaimen muistin.
Function __del_key(key%)
    DeleteMEMBlock key
EndFunction

//// Vapauttaa yhden hajautustauluun tallennetun arvon muistin.
Function __del_value(val%)
    DeleteMEMBlock val
EndFunction 


//// Luo uuden hajautustaulun ja palauttaa käyttäjälle osoittimen siihen.
//// palautettu osoitinta tulee käyttää hajautustaulun operaatioiden avulla.
//// @param sz 
////        Uuden hajautustaulun koko (ei tarvitse ottaa "ennakkoa" koossa,
////        se on laskettu mukaan.
//// @retval Osoitin uuteen luotuun hajautustauluun.
Function CreateHashTable(sz%)
    sz = Int(sz * gHashLoadFactor)
    t.HashTable = New(HashTable)
    t\_used = 0
    t\_sz = sz
    t\_data = MakeMEMBlock(sz * gHashEntrySize)
    Return ConvertToInteger(t)
EndFunction


//// Tuhoaa annetun hajautustaulun ja kaikki siihen asetetut arvot.
//// @param t Hajautustaulu, joka halutaan tuhota.
//// @retval 1, mikäli poisto onnistui, muutoin 0.
Function DeleteHashTable(t%)
    If t = 0 Then Return 0
    table.HashTable = ConvertToType(t)
    mem = table\_data
    sz% = table\_sz - 1
    // tuhotaan entryt
    For i = 0 To sz
        entry = PeekInt(mem, i * gHashEntrySize)
        If entry <> 0 And entry <> gDeletedEntry Then
            e.HashEntry = ConvertToType(entry)
            __del_key(e\_key)
            __del_value(e\_value)
            Delete e
        EndIf 
    Next i
    // tuhotaan taulu
    Delete table
    Return 1
EndFunction


//// Venyttää taulukon kokoa ja kopioi uudet elementit
//// tilalle. Tämä on HYVIN RASKAS O(n) operaatio, joten
//// tätä tulee välttää. Tämän funktion kutsuminen on automatisoitu,
//// joten käyttäjän ei tarvitse huolehtia tästä.
//// @param table Muutettava taulu.
//// @param loadFactor Kuormitusaste, käytä oletuksena gHashLoadFactor arvoa.
Function ResizeHashTable(table%, loadFactor#)
    // TODO.. toteutus..
    Print "IMPLEMENT HASH RESIZE!!"
EndFunction


//// Lisää uuden itemin hajautustauluun. Mikäli itemi sijaitsee
//// jo täsmälleen samalla, entinen ylikirjoitetaan. Tämä on keskimäärin
//// O(1) operaatio, joten sen kutsuminen on nopeaa. Mikäli taulu tulee
//// täyteen ja se pitää uudelleenhajauttaa, nousee suoritusaika kertaluokkaan
//// O(n).
//// @param table Taulu, johon halutaan lisästä.
//// @param key 
////        Avain, jonka taakse halutaan arvo asettaa. Tämä avain tulee olla
////        luotu String-/Int-/FloatKey-funktiolla! Tämä avain tuhotaan heti
////        kun hajautustaulu ei sitä tarvitse. Niinpä käyttäjä ei saa käyttää
////        tätä funktiokutsua varten luomaansa avainta jälkeenpäin.
////
Function PutHashItem(table%, key%, value%)
    hTable.HashTable = ConvertToType(table)
    sz% = hTable\_sz
    dat% = hTable\_data
    hash% = PeekInt(key, gHashOffset)
    i% = 0
    While(1)
        hash = Abs(hash + __hash2(hash, i))
        //__dbg(hash)
        index% = hash Mod sz
        //__dbg(index)
        entry% = PeekInt(dat, index * gHashEntrySize)
        If entry = 0 Or entry = gDeletedEntry Then
            // onnistuttiin laittamaan itemi tauluun
            nEntry.HashEntry = New(HashEntry)
            nEntry\_key = key
            nEntry\_value = value
            //Print index
            PokeInt dat, index * gHashEntrySize, ConvertToInteger(nEntry)
            hTable\_used = hTable\_used + 1
            If Float(hTable\_sz / hTable\_used) < gHashLoadFactor Then
                ResizeHashTable(table, gHashLoadFactor)
            EndIf
            Return 0
        Else
            // mikäli avaimet täsmää, korvataan edellinen
            nEntry.HashEntry = ConvertToType(entry)
            existingKey% = nEntry\_key
            If __key_compare(key, existingKey) Then
                // korvataan edellinen
                __del_key(key)
                __del_value(nEntry\_value)
                nEntry\_value = value
                Return 0
            EndIf
        EndIf
        i+1
    Wend
EndFunction


//// Hakee yhden hash-entryn indeksin taulusta. Mikäli
//// entryä ei löydy annetulla avaimella, palautetaan -1.
//// Tämä funktio ei ole tarkoitettu käyttäjälle.
//// @param table Hajautustaulu, josta etsitään.
//// @param key 
////        Avain, jonka taakse halutaan arvo asettaa. Tämä avain tulee olla
////        luotu String-/Int-/FloatKey-funktiolla! Tämä avain tuhotaan heti
////        kun hajautustaulu ei sitä tarvitse. Niinpä käyttäjä ei saa käyttää
////        tätä funktiokutsua varten luomaansa avainta jälkeenpäin.
//// @retval Entryn indeksi.
Function __SearchHashItemIndex(table%, key%)
    hTable.HashTable = ConvertToType(table)
    sz% = hTable\_sz
    dat% = hTable\_data
    hash% = PeekInt(key, gHashOffset)
    i% = 0
    While(1)
        hash = Abs(hash + __hash2(hash, i))
        index% = hash Mod sz
        entry% = PeekInt(dat, index * gHashEntrySize)
        If entry = 0 Or entry = gDeletedEntry Then
            // ei löydy
            If entry = 0 Then Return -1
        Else
            // löydettiin sama hash.. pitäisi olla
            // vielä sama avain
            nEntry.HashEntry = ConvertToType(entry)
            existingKey% = nEntry\_key
            If __key_compare(key, existingKey) Then
                // löytyi!
                Return index
            EndIf
        EndIf
        i+1
    Wend
EndFunction


//// Hakee halutulla avaimella tallennetun arvon hajautustaulusta.
//// Haettu arvo on osoitin dataan, joten se pitää avata tämän kirjaston
//// Get-metodeilla oikeaksi tyypiksi. Mikäli arvoa ei löydy, palautetaan
//// 0 merkiksi epäonnistumisesta.
//// @param table Hajautustaulu, josta etsitään.
//// @param key 
////        Avain, jonka taakse halutaan arvo asettaa. Tämä avain tulee olla
////        luotu String-/Int-/FloatKey-funktiolla! Tämä avain tuhotaan heti
////        kun hajautustaulu ei sitä tarvitse. Niinpä käyttäjä ei saa käyttää
////        tätä funktiokutsua varten luomaansa avainta jälkeenpäin.
//// @retval Osoitin arvon dataan.
Function GetHashItem(table%, key%)
    index% = __SearchHashItemIndex(table, key)
    If index = -1 Then __del_key(key) : Return 0
    hTable.HashTable = ConvertToType(table)
    __del_key(key)
    entry.HashEntry = ConvertToType(PeekInt(hTable\_data, index * gHashEntrySize))
    Return entry\_value
EndFunction


//// Poistaa halutun avaimen takana olevan arvon hajautustaulusta.
//// Mikäli avainta ei löydy taulusta, ei tehdä mitään.
//// @param table Hajautustaulu, josta etsitään.
//// @param key 
////        Avain, jonka taakse halutaan arvo asettaa. Tämä avain tulee olla
////        luotu String-/Int-/FloatKey-funktiolla! Tämä avain tuhotaan heti
////        kun hajautustaulu ei sitä tarvitse. Niinpä käyttäjä ei saa käyttää
////        tätä funktiokutsua varten luomaansa avainta jälkeenpäin.
//// @retval
////        1, mikäli poisto onnistui. Mikäli arvoa ei voitu poistaa
////        taulusta, palautetaan 0.
Function DeleteHashItem(table%, key%)
    index% = __SearchHashItemIndex(table, key)
    If index = -1 Then __del_key(key) : Return 0
    hTable.HashTable = ConvertToType(table)
    e.HashEntry = ConvertToType(PeekInt(hTable\_data, index * gHashEntrySize))
    __del_key(e\_key)
    __del_value(e\_value)
    Delete e
    PokeInt hTable\_data, index * gHashEntrySize, gDeletedEntry
    hTable\_used = hTable\_used - 1
    __del_key(key)
    Return 1
EndFunction


//// Luo uuden hajautustauluun sopivan merkkijonoavaimen.
//// Tämä avain on voimassa vain hajautustaulufunktion kutsun
//// ajan, joten sitä ei voi käyttää jälkeenpäin eikä pidä säilöä
//// missään.
//// @param key Avaimen haluttu arvo.
//// @retval Hajautustaululle sopiva avain (muistipala).
Function StringKey(key$)
    mem% = MakeMEMBlock(gKeyHeaderSize + Len(key))
    PokeInt mem, gKeySizeOffset, Len(key)
    PokeInt mem, gKeyTypeOffset, gHashKeyTypeString
    For i = 1 To Len(key)
        PokeByte mem, gKeyDataOffset + (i-1), Asc(Mid(key, i, 1))
    Next i
    hash% = __hash(mem)
    PokeInt mem, gHashOffset, hash
    Return mem
EndFunction


//// Luo uuden hajautustauluun sopivan kokonaislukuavaimen.
//// Tämä avain on voimassa vain hajautustaulufunktion kutsun
//// ajan, joten sitä ei voi käyttää jälkeenpäin eikä pidä säilöä
//// missään.
//// @param key Avaimen haluttu arvo.
//// @retval Hajautustaululle sopiva avain (muistipala).
Function IntKey(key)
    mem% = MakeMEMBlock(gKeyHeaderSize + 8)
    PokeInt mem, gKeySizeOffset, 8
    PokeInt mem, gKeyTypeOffset, 0
    PokeInt mem, gKeyDataOffset, 111222333
    // CRC-tarkistusta varten
    PokeInt mem, gKeyDataOffset + 4, key
    hash% = __hash(mem)
    PokeInt mem, gHashOffset, hash
    Return mem
EndFunction 


//// Luo uuden hajautustauluun sopivan likulukuavaimen.
//// Tämä avain on voimassa vain hajautustaulufunktion kutsun
//// ajan, joten sitä ei voi käyttää jälkeenpäin eikä pidä säilöä
//// missään.
//// @param key Avaimen haluttu arvo.
//// @retval Hajautustaululle sopiva avain (muistipala).
Function FloatKey(key#)
    mem% = MakeMEMBlock(gKeyHeaderSize + 8)
    PokeInt mem, gKeySizeOffset, 8
    PokeInt mem, gKeyTypeOffset, 0
    // CRC-tarkistusta varten..
    PokeInt mem, gKeyDataOffset, 222333444
    PokeFloat mem, gKeyDataOffset + 4, key
    hash% = __hash(mem)
    PokeInt mem, gHashOffset, hash
    Return mem
EndFunction 


//// Luo uuden hajautustauluun sopivan merkkijonoarvon.
//// Tämä arvo on pakattu muistipalaan, joten sen avaamiseksi
//// tulee käyttää GetString()-funktiota. Kun tämä arvo liitetään
//// hajautustauluun, tulee siitä osa taulun muistinhallintaa, joten
//// hajautustaulu vapauttaa arvon resurssit heti, kun arvo poistetaan
//// hajautustaulusta.
//// @param val Tallennettava arvo.
//// @retval Hajautustaululle sopivaksi pakattu arvo (muistipala).
Function StringValue(val$)
    mem% = MakeMEMBlock(4 + Len(val))
    PokeInt mem, 0, Len(val)
    For i = 1 To Len(val)
        PokeByte mem, 4 + (i-1), Asc(Mid(val, i, 1))
    Next i
    Return mem
EndFunction


//// Luo uuden hajautustauluun sopivan kokonaislukuarvon.
//// Tämä arvo on pakattu muistipalaan, joten sen avaamiseksi
//// tulee käyttää GetInt()-funktiota. Kun tämä arvo liitetään
//// hajautustauluun, tulee siitä osa taulun muistinhallintaa, joten
//// hajautustaulu vapauttaa arvon resurssit heti, kun arvo poistetaan
//// hajautustaulusta.
//// @param val Tallennettava arvo.
//// @retval Hajautustaululle sopivaksi pakattu arvo (muistipala).
Function IntValue(val)
    mem% = MakeMEMBlock(4)
    PokeInt mem, 0, val
    Return mem
EndFunction


//// Luo uuden hajautustauluun sopivan likulukuarvon.
//// Tämä arvo on pakattu muistipalaan, joten sen avaamiseksi
//// tulee käyttää GetFloat()-funktiota. Kun tämä arvo liitetään
//// hajautustauluun, tulee siitä osa taulun muistinhallintaa, joten
//// hajautustaulu vapauttaa arvon resurssit heti, kun arvo poistetaan
//// hajautustaulusta.
//// @param val Tallennettava arvo.
//// @retval Hajautustaululle sopivaksi pakattu arvo (muistipala).
Function FloatValue(val$)
    mem% = MakeMEMBlock(4)
    PokeFloat mem, 0, val
    Return mem
EndFunction


//// Lukee hajautustaulu-yhteensopivasta StringValue()-funktiolla luodusta
//// arvosta merkkijonon.
//// @param val Luettava hajautustaulu-yhteensopiva arvo (muistipala).
//// @retval Pakattu merkkijonoarvo.
Function GetString$(val)
    If val = 0 Then Return ""
    s$ = ""
    l% = PeekInt(val, 0)
    //__dbg(l)
    For i = 1 To l
        s = s + Chr(PeekByte(val, 4 + (i-1)))
    Next i
    Return s
EndFunction


//// Lukee hajautustaulu-yhteensopivasta IntValue()-funktiolla luodusta
//// arvosta kokonaisluvun.
//// @param val Luettava hajautustaulu-yhteensopiva arvo (muistipala).
//// @retval Pakattu kokonaislukuarvo.
Function GetInt(val)
    If val = 0 Then Return 0
    Return PeekInt(val, 0)
EndFunction


//// Lukee hajautustaulu-yhteensopivasta FloatValue()-funktiolla luodusta
//// arvosta liukuluvun.
//// @param val Luettava hajautustaulu-yhteensopiva arvo (muistipala).
//// @retval Pakattu liukuluku.
Function GetFloat#(val)
    If val = 0 Then Return 0.0
    Return PeekFloat(val, 0)
EndFunction
Hajautustaulu siis tukee merkkijono-, liukuluku ja kokonaislukuavaimia. Näiden taakse voidaan asettaa merkkijono-, liukuluku- ja kokonaislukuarvoja. Merkkijonoavaimet ja -arvot voivat olla niin pitkiä kuin käyttäjä haluaa. Nopeuden puolesta en kuitenkaan suosittele kovin pitkiä merkkijonoavaimia. 8-)

Käyttö on varsin simppeliä, tulee muistaa neljä päämetodia:
  • CreateHashTable(size) - luo uuden hajautustaulun halutulle koolle
  • DeleteHashTable(table) - tuhoaa luodun hajautustaulun
  • PutHashItem(table, key, value) - lisää tauluun uuden arvon avaimen taakse, mikäli avaimella on jo arvo, korvataan edellinen arvo uudella
  • DeleteHashItem(table, key) - poistaa taulussa olevan arvon avaimen takanta, mikäli sellainen löytyy
  • GetHashItem(table, key) - hakee halutulla avaimella arvon hajautustaulusta, mikäli avainta ei ole, palautetaan 0
Funktioille välitettävät arvot ja avaimet saadaan tehtyä seuraavilla funktiolla:
  • StringValue(val) - luo merkkijonoarvon
  • FloatValue(val) - luo liukulukuarvon
  • IntValue(val) - luo kokonaislukujonoarvon
  • StringKey(key) - luo merkkijonoavaimen
  • FloatKey(key) - luo liukulukuavaimen
  • IntKey(key) - luo kokonaislukuavaimen
GetHashItem-metodin palauttama arvo saadaan purettua GetInt(val), GetFloat(val) ja GetString(val) -funktiolla.

Esimerkki käytöstä:

Code: Select all

hTable = CreateHashTable(10)
PutHashItem(hTable, IntKey(2651), StringValue("moi"))
PutHashItem(hTable, StringKey("..."), StringValue("maailma"))

Print GetString( GetHashItem(hTable, IntKey(2651)) )
Print GetString( GetHashItem(hTable, StringKey("...")) )
WaitKey

DeleteHashTable(hTable)
EDIT:

15.6.2010

Korjattu pikku bugi liittyen arvojen etsintään taulusta. Edellisessä versiossa etsintä tyssäsi siihen, kun tavattiin tyhjä tai poistetuksi merkitty alkio. Oikean toiminnan kannalta on elintärkeää, että etsintä lopetetaan vasta, kun törmätään tyhjä alkio.

The darkest spells can be found from
http://tunkkaus.blogspot.fi
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by esa94 »

JATothrim wrote:CRC32() toimii nyt primääri hash funktiona
Uhoh. Kehitä joku järkevämpi, kai jollain on se CBKK:n md5-koodi tallella?
User avatar
Dibalo
Advanced Member
Posts: 298
Joined: Mon Aug 27, 2007 8:12 pm
Location: Espoo, Finland
Contact:

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by Dibalo »

md5 ei ole tarkoituksenmukainen, sillä hajautusfunktiosta tulee saada ulos positiivinen kokonaislukuarvo.
The darkest spells can be found from
http://tunkkaus.blogspot.fi
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by esa94 »

Dibalo wrote:md5 ei ole tarkoituksenmukainen, sillä hajautusfunktiosta tulee saada ulos positiivinen kokonaislukuarvo.
MD5 tuottaa positiivisen kokonaislukuarvon. Se vain yleensä muutetaan heksadesimaalimerkkijonoksi.
User avatar
Dibalo
Advanced Member
Posts: 298
Joined: Mon Aug 27, 2007 8:12 pm
Location: Espoo, Finland
Contact:

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by Dibalo »

Totta totta, mutta eikä md5 tuota nimenomaan 128-bittisiä hash-arvoja? Jos se on tarkoitettu myös 32-bittisille arvoille (en tiedä itse) niin sittenhän se voisi olla yksi ratkaisu. Tosin CB:n huomioiden sisäänrakennettu CRC32-tarkistesumma on paljon parempi ratkaisu, sillä se on (ainakin uskoisin) huomattavasti nopeampi kuin "kotitekoinen" md5.
The darkest spells can be found from
http://tunkkaus.blogspot.fi
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by esa94 »

Dibalo wrote:Totta totta, mutta eikä md5 tuota nimenomaan 128-bittisiä hash-arvoja? Jos se on tarkoitettu myös 32-bittisille arvoille (en tiedä itse) niin sittenhän se voisi olla yksi ratkaisu. Tosin CB:n huomioiden sisäänrakennettu CRC32-tarkistesumma on paljon parempi ratkaisu, sillä se on (ainakin uskoisin) huomattavasti nopeampi kuin "kotitekoinen" md5.
Ohups. Ei tuo hashin koko tullutkaan mieleeni >.< CRC vain tässä on huono mielestäni siksi, että siinä on paljon törmäyksiä. Sitä ei ole suunniteltu tällaiseen.
JATothrim
Tech Developer
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by JATothrim »

Dibalon selityksen/esimerkki koodin jälkeen tein *algo-facepalmin*. Tuo nykyinen toimii, siinä ei ole mitään vikaa, jne. mutta ehh. se kasaa CRC32() törmäykset samaan paikkaan. :lol:
Seuraavaksi on tarkoituksena kehittää hash-insertointi tapaa, niin että primääri crc32() hash ajetaan sekundäärisen hash funktion läpi max. Z kertaa. Z riippuu hashtablen täyttö-asteesta. Jos ei löydetä tyhjää paikkaa Z:hen mennessä, käytetään tyhjintä löytynyttä bukettia.
Jokaiselle key:lle on esilaskettu edellisten Insert():en yhteydessä paljas crc32() arvo, joka on tallennettu raa'an avaimen yhteyteen. Tämä mahdollistaa (parhaimmilaan) O(n+k) (huonoimmillaan O(n+n*k)) törmäystarkistukset O(n*k) sijaan. (k on avaimen pituus tavuina)
Z:n funktio pitää valita niin, että hashtablen ollessa täysi yritysten määrä on hyvin pieni, puolitäynnä suuri ja tyhjänä jälleen pienehkö, ettei hashata turhaan. (noudattaa lähes gaussinkäyrää)
Tällä tavoin toteutettuna hashtable sallii ylitäytön ja on erittäin nopea tiettyyn rajaan asti. (jonka jälkeen kompeksisuus nousee O(1):stä kohti O(n):aa)
Hashtablen uudelleen venyttäminen voidaan tehdä kahdella eri tavalla: Rakentaa koko hashtable kerralla uudestaan tai alkaa kopioimaan "taustalla" elementtejä uuteen hashtableen.
Lopuksi hömpää algo soppaa: 8-) Erikoinen taktiikka hashtablen uudelleen venyttämiseen olisi, että hashtable sisältäisikin useita pienempiä hashtableja, joiden taakka olisi tasapainotettu keskenään. Kun hashtable täyttyy tarpeeksi, lisätään uusi sub-hashtable ja aletaan "valuttamaan" dataa edellisistä sub-hashtableista uudempaan. Koska jo täysien sub-hashtable osien Z on pieni, usean pienen hashtablen tarkistus on nopeaa. nut god natten ja nuqq.
Last edited by JATothrim on Fri Jun 18, 2010 3:31 am, edited 1 time in total.
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.
User avatar
Dibalo
Advanced Member
Posts: 298
Joined: Mon Aug 27, 2007 8:12 pm
Location: Espoo, Finland
Contact:

Re: cbHashTable - Yleinen hajautustaulukko CoolBasicille.

Post by Dibalo »

Käyttöasteen mukaan muuttuva hash-funktio (tai edes "hakusyvyys") ei ole toimiva ratkaisu, vaan rikkoon hajautustaulun toiminnan täysin. Suosittelen unohtamaan moisen idean heti alkuunsa. Lisäksi suosittelen oikeasti luopumaan ajatuksesta kerätä noita törmääviä hash-arvoja samaan paikkaan. Okei, pienillä määrillä homma voi vielä toimia ja taulua voidaan "ylikuormittaa", mutta asymptoottisessa tarkastelussa taulun nopeus lähestyy aikakompleksisuutta O(n) n:n lähestyessä ääretöntä - ei hyvä. Mikäli nyt väen vänkään haluat tunkea saman avaimen taakse useita arvoja, tulee samassa slotissa(/buketissa) olevien avainten olla identtisesti samanlaisia (duplikaatit, esim. "avain" ja "avain", kun taas "avain1251" ja "avain26167" eivät käy, vaikka niillä olisikin sama hash-arvo). Hajautustaulu on suunniteltu niin, että haku-, lisäys- ja poisto-operaatiot voidaan suorittaa vakioajassa perustuen nimenomaan siihen, että lasketut hash-arvot hajoavat ympäri taulua sen verran tasaisesti, että oikea avain / tyhjä paikka löydetään muutamalla yrittämällä. Tilan loppuessa joudutaan tekemään O(n) luokan uudelleenhajautus, mutta sille ei voi mitään - ohjelmoijan tulee suunnitella ohjelmansa niin, että tälläiset tilanteet minimoituvat.
The darkest spells can be found from
http://tunkkaus.blogspot.fi
Post Reply