Hey Xyle, I made some major changes to your code (it was a better start than what I had prieviously), thought you might want them...
there is a problem with the colored spheres, sometimes they pop an error, just get rid of them will solve this and it will also speed up the pathfind by about 10 times as well :)
main.bb
pathfinding2.bb
this uses Ocothorpe's container hash tables, they are very useful.
I'm still not sure whether using the quicksort algorithm is faster than a binary heap, but I use the quicksort anyways.
Edit: binary heap made much faster, updated above. note: took away the spheres, just uncomment them to put them back in.
there is a problem with the colored spheres, sometimes they pop an error, just get rid of them will solve this and it will also speed up the pathfind by about 10 times as well :)
main.bb
Graphics3D 800,600,32,2 SetBuffer BackBuffer() Include "Pathfinding2.bb" ;Global Entities Global Ground Global Player Global Cam Global CamPiv Global Lite Dim Trees(50) Global House1 Global House2 ;Collision Type Global Type_Ground = 1 Global Type_Char = 2 Global Type_Scenery = 3 Global Type_Structure = 4 Global SelEnt Global SelName$ Global Move$ Global BegX# Global BegZ# Global DestX# Global DestZ# Global Cursor Global EntX Global EntY Global EntZ Global FPS Global frame_count Global fps_timeout Global TarX Global TarZ ;temp Global ttime Global path.array ;-------------FPS Stuff-------------------- SeedRnd MilliSecs() fps_timer = CreateTimer(80) ; Lock to 60FPS. ;--------------end FPS Stuff---------------- CreateCursor() CreateObjects() Collisions Type_Char,Type_Ground,2,2 Collisions Type_Char,Type_Scenery,2,2 Collisions Type_Char,Type_Structure,2,2 ttime = MilliSecs() CreateGrid(200,200) ttime = MilliSecs()-ttime While Not KeyHit(1) If KeyDown(13) ;+ MoveEntity Cam,0,0,1 EndIf If KeyDown(12) ;- MoveEntity Cam,0,0,-1 EndIf If KeyDown(203) TurnEntity CamPiv,0,-3,0 EndIf If KeyDown(205) TurnEntity CamPiv,0,3,0 EndIf PositionEntity CamPiv,EntityX(Player,True),EntityY(Player,True),EntityZ(Player,True) If MouseHit(1)=True SelEnt = CameraPick(Cam,MouseX(),MouseY()) If SelEnt > 0 SelName$ = EntityName(PickedEntity()) EntX = PickedX() EntY = PickedY() EntZ = PickedZ() If SelName$ = "Ground" BegX = EntityX(Player,True) BegZ = EntityZ(Player,True) DestX = PickedX#() DestZ = PickedZ#() ttime = MilliSecs() path = FindPath(BegX,BegZ,DestX,DestZ) ttime = MilliSecs()-ttime Move$ = "True" MoveCell = 1 ElseIf Instr(SelName$,"Tree") > 0 Move$ = "False" ElseIf Instr(SelName$, "House") > 0 Move$ = "False" EndIf EndIf End If If Move$ = "True" BegX = EntityX(Player,True) BegZ = EntityZ(Player,True) If BegX < TarX + 1 And BegX > TarX - 1 And BegZ < TarZ + 1 And BegZ > TarZ -1 MoveCell = MoveCell+1 If moveCell <= path\s Then TarX = path\a[MoveCell]\X TarZ = path\a[moveCell]\Z Else Move = "False" EndIf EndIf Point_Entity(Player,TarX,EntityY(Player,True),TarZ) MoveEntity Player,0,0,.05 EndIf MoveEntity Player,0,-0.035,0 ; gravity UpdateWorld RenderWorld Color 255,0,0 frame_time = MilliSecs() - frame_start Show_FPS() Color 255,255,0 Text 10,15,"Press esc to exit, Arrow keys turn cam, - and = zoom camera" Text 10,30,"Click an object to select it, click the ground to move" Text 10,45,"red = path, blue = closed(fully checked), green = open(half checked) Color 255,255,255 Text 10,90,"TotNodes = "+TotCells Text 10,105,"Sel Entity: "+SelName$+"("+EntX+","+EntY+","+EntZ+")" Text 10,120,"Ground Dims: "+MeshWidth(Ground) +", "+MeshHeight(Ground)+", "+MeshDepth(Ground) Text 10,135,"Ground Pos: "+EntityX(Ground,True)+", "+EntityZ(Ground,True) Text 10,150,"Tris: "+TrisRendered() Text 10,165,"Cam Coords: " +EntityX(Cam,True)+", "+EntityY(Cam,True)+", "+EntityZ(Cam,True) Text 10,180,"Player Coords: "+EntityX(Player,True)+", "+EntityY(Player,True)+", "+EntityZ(Player,True) Text 10,195,"find path speed: "+ttime Text 10,215,"MoveCell: "+MoveCell DrawImage Cursor,MouseX(),MouseY() WaitTimer(fps_timer) Flip False Wend End ;------------------------------------------------------------------------CreateGround Function Function CreateGround() Ground = CreateMesh() GSurf = CreateSurface(Ground) v0 = AddVertex(GSurf,-100,0,100) v1 = AddVertex(GSurf,100,0,-100) v2 = AddVertex(GSurf,-100,0,-100) v3 = AddVertex(GSurf,100,0,100) t0 = AddTriangle(GSurf,v0,v1,v2) t1 = AddTriangle(GSurf,v0,v3,v1) End Function ;--------------------------------------------------------------------End CreateGround Function ;------------------------------------------------------------------------CreateObjects Function Function CreateObjects() ;CreateGround() Ground = CreateMesh() GSurf = CreateSurface(Ground) v0 = AddVertex(GSurf,-100,0,100) v1 = AddVertex(GSurf,100,0,-100) v2 = AddVertex(GSurf,-100,0,-100) v3 = AddVertex(GSurf,100,0,100) t0 = AddTriangle(GSurf,v0,v1,v2) t1 = AddTriangle(GSurf,v0,v3,v1) EntityColor Ground,130,95,0 EntityPickMode Ground,2 EntityType Ground,Type_Ground NameEntity Ground,"Ground" Player = CreateSphere() PositionEntity Player,0,5,0 ScaleEntity Player,.5,1,.5 EntityColor Player,255,255,0 EntityRadius Player,.5 EntityPickMode Player,2 EntityType Player,Type_Char NameEntity Player,"Player" House1 = CreateCube() PositionEntity House1,30,4,30 ScaleEntity House1,5,3,10 EntityColor House1,99,65,7 EntityPickMode House1,2 EntityType House1, Type_Structure NameEntity House1, "House1" House2 = CreateCube() PositionEntity House2,-30,4,-30 ScaleEntity House2,5,3,10 EntityColor House2,99,65,7 EntityPickMode House2,2 EntityType House2, Type_Structure NameEntity House2, "House2" A = 0 While A <> 50 Trees(A) = CreateCone() While True Tx = Rand(-100,100) Tz = Rand(-100,100) SelEnt = LinePick(Tx,50,Tz,0,-50,0) SelName$ = EntityName(PickedEntity()) If SelName$ = "Ground" PositionEntity Trees(A),Tx,3,Tz Exit EndIf Wend ScaleEntity Trees(A),2,2,2 EntityColor Trees(A),0,128,0 EntityPickMode Trees(A),2 EntityType Trees(A), Type_Scenery NameEntity Trees(A), "Tree"+A A = A + 1 Wend Cam = CreateCamera() PositionEntity Cam,-20,60,-20 PointEntity Cam,Player CamPiv = CreatePivot() PositionEntity CamPiv,0,0,0 EntityParent Cam,CamPiv Lite = CreateLight() PositionEntity Lite,0,50,0 PointEntity Lite, Ground End Function ;---------------------------------------------------------------------End CreateObjects Function ;------------------------------------------------------------------------Show_FPS Function Function Show_FPS() If fps_timeout frame_count = frame_count + 1 If MilliSecs() > fps_timeout Then fps_timeout = MilliSecs() + 1000 FPS = frame_count frame_count = 0 If FPS < slowest_fps Or slowest_fps = 0 Then slowest_fps = FPS EndIf If frame_time > slowest_frame Then slowest_frame = frame_time Else ; First call initialization. fps_timeout = MilliSecs() + 1000 EndIf Text 10,0,"FPS: " + FPS End Function ;------------------------------------------------------------------------End Show_FPS Func ;-------------------------------------------------------------CreateCursor Func Function CreateCursor() ;Make a quick mouse cursor Color 255,255,0 Cursor = CreateImage(15,15) Rect(0,0,10,10) Color 0,0,0 Rect(3,3,10,10) Color 255,255,0 Line(0,3,15,15) Line(0,2,15,15) Line(0,1,15,15) Line(0,0,15,15) Line(1,0,15,15) Line(2,0,15,15) Line(3,0,15,15) GrabImage Cursor,0,0 End Function ;-------------------------------------------------------------End CreateCursor Func ;-------------------------------------------------------------Point_Entity Func Function Point_Entity(entity,x#,y#,z#) xdiff# = EntityX(entity)-x# ydiff# = EntityY(entity)-y# zdiff# = EntityZ(entity)-z# PEdist#=Sqr#((xdiff#*xdiff#)+(zdiff#*zdiff#)) pitch# = ATan2(ydiff#,PEdist#) yaw# = ATan2(xdiff#,-zdiff#) RotateEntity entity,pitch#,yaw#,0 End Function ;-------------------------------------------------------------End Point_Entity
pathfinding2.bb
;Include "containers\hash table container.bb" Type Cell Field ID Field X Field Z Field FVal Field GVal Field HVal Field Walkable Field ListNum ;0 = Not listed, 1 = Open, 2 = Closed Field Parent.cell ;parent for pathfinding ;neighbering cells Field n_right.cell Field n_left.cell Field n_up.cell Field n_down.cell Field n_rightUp.cell Field n_rightDown.cell Field n_leftUp.cell Field n_leftDown.cell End Type Type array ;can be passed to and from functions :) Field a.cell[1000] ;the array Field s ;size End Type Global Grid.HashC = hash_new() Const nullnum = 999999 Dim Marker(1000) ;---------------------------------------------------------------------------------- Function CreateGrid(X,Z) ;X and Z are map dimensions passed in, It will create a 2d grid containing (X+1 * Z+1) number ;of cells. The +1 is for adding the 0 column and 0 row. I love MS Excel and VB, hehehe. For CellZ = (Z/2)*-1 To (Z/2) Step 1 For CellX = (X/2)*-1 To (X/2) Step 1 temp.cell = New Cell temp\ID = A temp\X = CellX temp\Z = CellZ temp\FVal = 0 temp\GVal = 0 temp\HVal = 0 temp\Parent = Null SelEnt = LinePick(CellX, 200, CellZ, 0, -1000, 0) If SelEnt > 0 SelName$ = EntityName(PickedEntity()) If SelName$ = "Ground" temp\Walkable = 1 Else temp\Walkable = 0 EndIf EndIf hash_set(Grid, Str(CellX)+","+Str(CellZ), Handle(temp)) A = A + 1 Next Next ;find neighbors For CellZ = (Z/2)*-1 To (Z/2) Step 1 For CellX = (X/2)*-1 To (X/2) Step 1 ;find cell Center.cell = Object.cell(hash_get(Grid,Str(CellX)+","+Str(CellZ))) ;find neighbors Center\n_left = Object.cell(hash_get(Grid,Str(CellX-1)+","+Str(CellZ))) center\n_right = Object.cell(hash_get(Grid,Str(CellX+1)+","+Str(CellZ))) center\n_up = Object.cell(hash_get(Grid,Str(CellX)+","+Str(CellZ+1))) center\n_down = Object.cell(hash_get(Grid,Str(CellX)+","+Str(CellZ-1))) center\n_rightup = Object.cell(hash_get(Grid,Str(CellX+1)+","+Str(CellZ+1))) center\n_rightdown = Object.cell(hash_get(Grid,Str(CellX+1)+","+Str(CellZ-1))) center\n_leftUp = Object.cell(hash_get(Grid,Str(CellX-1)+","+Str(CellZ+1))) center\n_leftDown = Object.cell(hash_get(Grid,Str(CellX-1)+","+Str(CellZ-1))) Next Next End Function ;---------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------- Function FindPath.array(StartX,StartZ,EndX,EndZ) ;Clears any previously drawn path ClearPath() ;Dim these variables to clear them temp_OpenList.array = New array ;used to store cells that need to be checked temp_OpenList\s = 0 temp_ClosedList.array = New array temp_ClosedList\s = 0 Final_Path.array = New array Final_Path\s = 0 Local StartCell.cell ;1 - Move Char to nearest cell coords, if not there already StartCell = Object.cell(hash_get(Grid,Str(StartX)+","+Str(StartZ))) StartCell\Parent = StartCell ;Add Starting Square to OpenList add_binaryHeap(temp_OpenList,StartCell) StartCell\ListNum = 1 ;0 = Not listed, 1 = Open, 2 = Closed F = 0 Repeat ;2 Put Starting Cell in closed list, this is where the player is at before the movement begins ;If the Target cell is added to the closed list then the path is complete ;Find the Cell with the lowest FCost in the Open list And Make it the New Start Cell ;if there are no longer any cells on open list, then there is no path StartCell = subtract_binaryHeap(temp_Openlist) ;add current cell to closed list temp_closedList\s = temp_closedList\s+1 Temp_closedList\a[temp_closedList\s] = StartCell StartCell\ListNum = 2 If StartCell\X = EndX And StartCell\Z = EndZ ;The Target cell has been found ;Leave the loop Exit EndIf ;3 - Check each adjacent cell, Fill in each adjacent cells Fcost, Gcost, Hcost values ;and parent values ;Later, I may change the walkable to just check the adjacent cells instead of checking ;the whole map at startup, I will try it and see what kind of slow down happens at runtime ;Fill in GVal, HVal and FVal values and Create AdjCell() array and assign parents ;left If StartCell\n_left <> Null And StartCell\n_left\ListNum = 0 Then StartCell\n_left\Parent = StartCell updateAdjacent(StartCell\n_left,EndX,EndZ,temp_OpenList) EndIf ;right If StartCell\n_right <> Null And StartCell\n_right\ListNum = 0 Then StartCell\n_right\Parent = StartCell updateAdjacent(StartCell\n_right,EndX,EndZ,temp_OpenList) EndIf ;This is the Adjacent Cell Diagonal, up, Left of Start Cell If StartCell\n_leftup <> Null And StartCell\n_leftup\ListNum = 0 Then StartCell\n_leftup\Parent = StartCell updateAdjacent(StartCell\n_leftup,EndX,EndZ,temp_OpenList) EndIf ;This is the Adjacent cell above the Start Cell If StartCell\n_up <> Null And StartCell\n_up\ListNum = 0 Then StartCell\n_up\Parent = StartCell updateAdjacent(StartCell\n_up,EndX,EndZ,temp_OpenList) EndIf ;This is the adjacent cell to diagonal up right of Start Cell If StartCell\n_rightup <> Null And StartCell\n_rightup\ListNum = 0 Then StartCell\n_rightup\Parent = StartCell updateAdjacent(StartCell\n_rightup,EndX,EndZ,temp_OpenList) EndIf ;This is the adjacent cell to diagonal Down Left of Start Cell If StartCell\n_leftdown <> Null And StartCell\n_leftdown\ListNum = 0 Then StartCell\n_leftdown\Parent = StartCell updateAdjacent(StartCell\n_leftdown,EndX,EndZ,temp_OpenList) EndIf ;This is the Adjacent cell Below the Start Cell If StartCell\n_down <> Null And StartCell\n_down\ListNum = 0 Then StartCell\n_down\Parent = StartCell updateAdjacent(StartCell\n_down,EndX,EndZ,temp_OpenList) EndIf ;This is the Adjacent Cell Diagonal, down, right of Start Cell If StartCell\n_rightdown <> Null And StartCell\n_rightdown\ListNum = 0 Then StartCell\n_rightdown\Parent = StartCell updateAdjacent(StartCell\n_rightdown,EndX,EndZ,temp_OpenList) EndIf F = F + 1 Until F > 1000 ;find the length of the path start.cell = temp_ClosedList\a[temp_ClosedList\s] Repeat If start\parent = start Then Exit final_path\s = final_path\s + 1 start = start\parent Forever ;work from the ending square back to the front square, finding the actual path start.cell = temp_ClosedList\a[temp_ClosedList\s] a = final_path\s Repeat final_path\a[a] = start a = a -1 start = start\parent If a < 1 Then Exit Forever ;show the red dots! ;ShowPath(final_path,temp_OpenList,temp_ClosedList) ;Clear Openlist values, else it will interfere with a future pathfind For A = 1 To temp_OpenList\s temp_OpenList\a[A]\fVal = 0 temp_OpenList\a[A]\GVal = 0 temp_OpenList\a[A]\HVal = 0 temp_OpenList\a[A]\ListNum = 0 temp_OpenList\a[A]\Parent = Null Next Delete temp_OpenList ;Clear Closedlist values, else it will interfere with a future pathfind For A = 1 To temp_ClosedList\s temp_ClosedList\a[A]\fVal = 0 temp_ClosedList\a[A]\GVal = 0 temp_ClosedList\a[A]\HVal = 0 temp_ClosedList\a[A]\ListNum = 0 temp_ClosedList\a[A]\Parent = Null Next Delete temp_ClosedList Return final_path End Function ;---------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------- Function updateAdjacent(c.cell,endX,endZ,tOpenList.array) ;calculate costs If c\X <> c\Parent\X And c\Z <> c\Parent\X ;Its Diagonal c\GVal = 14 Else ;Its not Diagonal c\GVal = 10 EndIf c\HVal = 10*(Abs(c\X - EndX)) + 10*(Abs(c\Z - EndZ)) c\FVal = c\Gval + c\HVal ;add to open list if walkable If c\Walkable = 1 add_binaryHeap(tOpenList,c) c\ListNum = 1 EndIf End Function ;---------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------- Function ShowPath(ThePath.array,open.array,closed.array) ;draws the path onscreen For i = 1 To ThePath\s Marker(i) = CreateSphere() PositionEntity Marker(i),ThePath\a[i]\X,1,ThePath\a[i]\Z ScaleEntity Marker(i),.2,.2,.2 EntityColor Marker(i),255,0,0 Next For i = 1 To closed\s Marker(i+ThePath\s) = CreateSphere() PositionEntity Marker(i+ThePath\s),closed\a[i]\X,1,closed\a[i]\Z ScaleEntity Marker(i+ThePath\s),.1,.1,.1 EntityColor Marker(i+ThePath\s),0,0,255 Next For i = 1 To open\s Marker(i+closed\s+ThePath\s) = CreateSphere() PositionEntity Marker(i+closed\s+ThePath\s),open\a[i]\X,1,open\a[i]\Z ScaleEntity Marker(i+closed\s+ThePath\s),.08,.08,.08 EntityColor Marker(i+closed\s+ThePath\s),0,255,0 Next End Function ;---------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------- Function ClearPath() ;Clears a previously drawn path For p.array = Each array Delete p Next ; For i = 1 To 1000 ; If Marker(i) <> 0 Then ; FreeEntity Marker(i) ;Else ; Exit ; EndIf ;Next End Function ;---------------------------------------------------------------------------------- ;sorting arrays-sorts to fval Function QuickSort( L,R, TheArray.array, RandomPivot = True) Local A, B, SwapA.cell, Middle A = L B = R If RandomPivot Then Middle = TheArray\a[Rand(L,R)]\FVal Else Middle = TheArray\a[(L+R)/2]\FVal EndIf While True While TheArray\a[A]\FVal < Middle A = A + 1 If A > R Then Exit Wend While Middle < TheArray\a[B]\FVal B = B - 1 If B < 1 Then Exit Wend If A > B Then Exit SwapA = TheArray\a[A] TheArray\a[A] = TheArray\a[B] TheArray\a[B] = SwapA A = A + 1 B = B - 1 If B < 1 Then Exit If A > R Then Exit Wend If L < B Then QuickSort( L, B, TheArray ) If A < R Then QuickSort( A, R, TheArray ) ;get rid of null numbers B = R Repeat If TheArray\a[B]\FVal = nullnum Then TheArray\a[B]\FVal = 0 TheArray\s = TheArray\s - 1 Else Exit EndIf B = B - 1 If B <= 0 Then Exit Forever End Function ;binary heap functions-sorts to fval ;general algorithms by Patrick Lester Function add_binaryHeap(heap.array,c.cell) heap\s = heap\s+1 heap\a[heap\s] = c m = heap\s While m <> 1 ;While item hasn't bubbled to the top (m=1) ;Check if child is <= parent. If so, swap them. If c\FVal <= heap\a[m/2]\FVal Then temp.cell = heap\a[m/2] heap\a[m/2] = c heap\a[m] = temp m = m/2 Else Exit ;exit the while/wend loop End If Wend End Function Function subtract_binaryHeap.cell(heap.array) c.cell = heap\a[1] heap\a[1] = heap\a[heap\s] heap\a[heap\s] = Null heap\s = heap\s - 1 v = 1 ;Repeat the following until the item sinks to its proper spot in the binary heap. Repeat u = v If 2*u+1 <= heap\s ;if both children exist ;Select the lowest of the two children. If heap\a[u]\FVal >= heap\a[2*u]\FVal Then v = 2*u ;SEE NOTE BELOW If heap\a[v]\FVal >= heap\a[2*u+1]\FVal Then v = 2*u+1 ;SEE NOTE BELOW Else If 2*u <= heap\s ;if only child #1 exists ;Check if the F cost is greater than the child If heap\a[u]\FVal >= heap\a[2*u]\FVal Then v = 2*u End If If u <> v Then ; If parent's F > one or both of its children, swap them temp.cell = heap\a[u] heap\a[u] = heap\a[v] heap\a[v] = temp Else Exit ;if item <= both children, exit repeat/forever loop End If Forever ;Repeat forever Return c End Function ;*****************************************hash table container lib by octothorpe*********************************** Const HASH_MAX_BUCKETS = 100000 ;made this, really doesn't need to be higher than the totcells... ; more buckets will make lookups faster in crowded hashes, but will use more memory ; theoretically, overhead memory usage is (buckets * 16 bytes) ; ------------------------------------------------------------------------------ ;= TYPES ; ------------------------------------------------------------------------------ Type hashC Field bucket.listC[HASH_MAX_BUCKETS-1] ; a list of hashC_elems Field elements% End Type Type hashC_elem Field key$ Field value End Type Type hashC_iter Field hash.hashC Field current_bucket% Field current_node.listC_node Field next_node.listC_node ; keep track of this so we can safely delete the current_node End Type ; ------------------------------------------------------------------------------ ;= FUNDAMENTAL ; ------------------------------------------------------------------------------ ; ------------------------------------------------------------------------------ Function hash_new.hashC() ; create a new hash Return New hashC End Function ; ------------------------------------------------------------------------------ Function hash_destroy(our_hash.hashC) ; delete a hash and all of its elements If our_hash = Null Then RuntimeError("not a valid hashC: null") ; loop through each bucket For bucket_index% = 0 To HASH_MAX_BUCKETS-1 Local this_element_list.listC = our_hash\bucket[bucket_index] If this_element_list <> Null Then ; loop through each node in each bucket's list Local this_node.listC_node = this_element_list\first_node While this_node <> Null ; destroy the element Delete Object.hashC_elem(this_node\value) ; advance to next node in list this_node = this_node\next_node Wend ; destroy the bucket list_destroy(this_element_list) EndIf Next ; destroy the hash Delete our_hash End Function ; ------------------------------------------------------------------------------ Function hash_set(our_hash.hashC, key$, value) ; set a key-value pair in a hash If our_hash = Null Then RuntimeError("not a valid hashC: null") ; find the appropriate bucket Local our_element_list.listC = hash_choose_bucket(our_hash, key$) ; look for an element with a matching key Local this_node.listC_node = our_element_list\first_node While this_node <> Null Local this_element.hashC_elem = Object.hashC_elem(this_node\value) ; if the keys match, update the value and return from the function If (this_element\key$ = key$) Then this_element\value = value Return EndIf ; look at the next node this_node = this_node\next_node Wend ; if we didn't find an element to update, add a new element Local new_element.hashC_elem = New hashC_elem new_element\key$ = key$ new_element\value = value list_push(our_element_list, Handle(new_element)) ; update element count our_hash\elements = our_hash\elements + 1 End Function Function hash_delete(our_hash.hashC, key$) ; delete a key-value pair in a hash, returning the value If our_hash = Null Then RuntimeError("not a valid hashC: null") ; find the appropriate bucket Local our_element_list.listC = hash_choose_bucket(our_hash, key$) ; look for an element with a matching key Local this_node.listC_node = our_element_list\first_node While this_node <> Null Local this_element.hashC_elem = Object.hashC_elem(this_node\value) ; if the keys match, remove this element and return the value If (this_element\key$ = key$) Then Local value = this_element\value Delete this_element list_remove_node(this_node) ; update element count our_hash\elements = our_hash\elements - 1 Return value EndIf ; look at the next node this_node = this_node\next_node Wend ; if we didn't find an element to update, return 0 Return 0 End Function ; ------------------------------------------------------------------------------ Function hash_get(our_hash.hashC, key$) ; get a value from a hash by its key$ If our_hash = Null Then RuntimeError("not a valid hashC: null") ; find the appropriate bucket Local our_element_list.listC = hash_choose_bucket(our_hash, key$) ; look for an element with a matching key Local this_node.listC_node = our_element_list\first_node While this_node <> Null Local this_element.hashC_elem = Object.hashC_elem(this_node\value) ; if the keys match, update the value and return from the function If (this_element\key$ = key$) Then Return this_element\value EndIf ; look at the next node this_node = this_node\next_node Wend ; we didn't find the key, so return 0 Return 0 End Function ; ------------------------------------------------------------------------------ ;= INTERNAL ; ------------------------------------------------------------------------------ ; ------------------------------------------------------------------------------ Function hash_choose_bucket.listC(our_hash.hashC, key$) ; return the linked list which corresponds with the key$ ; find the appropriate bucket index Local bucket_index% = hash_key_to_bucket_index(key$, HASH_MAX_BUCKETS) ; make sure bucket has been initialized If (our_hash\bucket[bucket_index%] = Null) Then our_hash\bucket[bucket_index%] = list_new() EndIf Return our_hash\bucket[bucket_index%] End Function ; ------------------------------------------------------------------------------ Function hash_key_to_bucket_index%(key$, modulus%) ; come up with an index for any string, dependably coming up with the same index ; for the same string, and attempting to distribute strings evenly over the ; available indexes Local bucket_index% Local character_index For character_index = 1 To Len(key$) Local character$ = Mid$(key$, character_index, 1) bucket_index% = (bucket_index% * 123) + Asc(character) ; arbitrary math, whee! Next ; force the index to be valid (overflows might make the number negative) bucket_index% = Abs(bucket_index% Mod modulus) Return bucket_index% End Function ;********************************************************double linked list (also by octothorpe)****************** Type listC Field elements% ; number of elements in list Field first_node.listC_node Field last_node.listC_node End Type Type listC_node Field list.listC ; parent list Field prev_node.listC_node ; or null if this is the first node Field next_node.listC_node ; or null if this is the last node Field value End Type Type listC_iter Field list.listC Field forwards ; bool to keep track of which direction we're going Field current_node.listC_node Field next_node.listC_node ; keep track of this so we can safely delete the current_node End Type ; ------------------------------------------------------------------------------ ;= FUNDAMENTAL ; ------------------------------------------------------------------------------ ; ------------------------------------------------------------------------------ Function list_new.listC() ; create a new list Return New listC End Function ; ------------------------------------------------------------------------------ Function list_destroy(our_list.listC) ; delete a list and all of its nodes If our_list = Null Then RuntimeError("not a valid listC: null") ; walk through the nodes, deleting them this_node.listC_node = our_list\first_node While (this_node <> Null) old_node.listC_node = this_node this_node = this_node\next_node Delete old_node Wend ; finally, delete the list itself Delete our_list End Function ; ------------------------------------------------------------------------------ Function list_push.listC_node(our_list.listC, value) ; add a new node to the end of a linked list If our_list = Null Then RuntimeError("not a valid listC: null") ; create a new node Local our_node.listC_node = New listC_node our_node\list = our_list our_node\value = value ; if the list is empty, set our node as the first and last If (our_list\first_node = Null) Then our_list\first_node = our_node our_list\last_node = our_node our_list\elements = 1 ; otherwise, add our node after the last Else our_list\last_node\next_node = our_node our_node\prev_node = our_list\last_node our_list\last_node = our_node our_list\elements = our_list\elements + 1 EndIf Return our_node End Function ; ------------------------------------------------------------------------------ Function list_unshift.listC_node(our_list.listC, value) ; add a new node to the beginning of a linked list If our_list = Null Then RuntimeError("not a valid listC: null") ; create a new node Local our_node.listC_node = New listC_node our_node\list = our_list our_node\value = value ; if the list is empty, set our node as the first and last If (our_list\first_node = Null) Then our_list\first_node = our_node our_list\last_node = our_node our_list\elements = 1 ; otherwise, add our node before the first Else our_list\first_node\prev_node = our_node our_node\next_node = our_list\first_node our_list\first_node = our_node our_list\elements = our_list\elements + 1 EndIf Return our_node End Function ; ------------------------------------------------------------------------------ Function list_pop(our_list.listC) ; remove an element from the end of a linked list, returning its value Return list_remove_node(our_list\last_node) End Function ; ------------------------------------------------------------------------------ Function list_shift(our_list.listC) ; remove an element from the beginning of a linked list, returning its value Return list_remove_node(our_list\first_node) End Function ; ------------------------------------------------------------------------------ Function list_insert_after.listC_node(reference_node.listC_node, value) ; add a new node after an existing one If reference_node = Null Then RuntimeError("not a valid listC_node: null") ; create a new node Local our_node.listC_node = New listC_node our_node\list = reference_node\list our_node\value = value our_node\prev_node = reference_node our_node\next_node = reference_node\next_node reference_node\next_node = our_node If our_node\next_node <> Null Then our_node\next_node\prev_node = our_node Else our_node\list\last_node = our_node EndIf our_node\list\elements = our_node\list\elements + 1 Return our_node End Function ; ------------------------------------------------------------------------------ Function list_insert_before.listC_node(reference_node.listC_node, value) ; add a new node before an existing one If reference_node = Null Then RuntimeError("not a valid listC_node: null") ; create a new node Local our_node.listC_node = New listC_node our_node\list = reference_node\list our_node\value = value our_node\next_node = reference_node our_node\prev_node = reference_node\prev_node reference_node\prev_node = our_node If our_node\prev_node <> Null Then our_node\prev_node\next_node = our_node Else our_node\list\first_node = our_node EndIf our_node\list\elements = our_node\list\elements + 1 Return our_node End Function ; ------------------------------------------------------------------------------ Function list_remove_node(our_node.listC_node) ; remove an arbitrary element from a linked list, returning its value ; return 0 if we're trying to return an element that doesn't exist (e.g. empty_list\last_node) If (our_node = Null) Then Return 0 ; if there's a node before this one, it gets our next_node as its new next_node (or null if this is the last node) If (our_node\prev_node <> Null) Then our_node\prev_node\next_node = our_node\next_node EndIf ; if there's a node after this one, it gets our prev_node as its new prev_node (or null if this is the first node) If (our_node\next_node <> Null) Then our_node\next_node\prev_node = our_node\prev_node EndIf ; if this was the first node, the next node is now the first node (or null if the list is now empty) If (our_node = our_node\list\first_node) Then our_node\list\first_node = our_node\next_node EndIf ; if this was the last node, the prev node is now the last node (or null if the list is now empty) If (our_node = our_node\list\last_node) Then our_node\list\last_node = our_node\prev_node EndIf ; update the number of elements in the list our_node\list\elements = our_node\list\elements - 1 ; destroy the node, returning its value Local value = our_node\value Delete our_node Return value End Function ; ------------------------------------------------------------------------------ Function list_count(our_list.listC) Return our_list\elements End Function ; ------------------------------------------------------------------------------ ;= ITERATORS ; ------------------------------------------------------------------------------ ; sample usage ; ; for item.type = each list ; it.listC_iter = list_iterator_begin(list) ; while list_iterator_next(it) ; item.type = object.type(list_iterator_get(it)) ; wend ; ------------------------------------------------------------------------------ Function list_iterator_begin.listC_iter(our_list.listC) ; create a new iterator for traversing the list forwards it.listC_iter = New listC_iter If our_list <> Null Then it\list = our_list it\forwards = True it\current_node = Null it\next_node = our_list\first_node EndIf Return it End Function ; ------------------------------------------------------------------------------ Function list_iterator_begin_reverse.listC_iter(our_list.listC) ; create a new iterator for traversing the list backwards it.listC_iter = New listC_iter If our_list <> Null Then it\list = our_list it\forwards = False it\current_node = Null it\next_node = our_list\last_node EndIf Return it End Function ; ------------------------------------------------------------------------------ Function list_iterator_next(it.listC_iter) ; advance the iterator to the next item in the list ; drop out immediately if this iterator is void If it\list = Null Then Return False ; if there's a next node, advance to it and return true If it\next_node <> Null Then it\current_node = it\next_node If it\forwards Then it\next_node = it\current_node\next_node Else it\next_node = it\current_node\prev_node EndIf Return True ; otherwise, destroy the iterator and return false Else Delete it Return False EndIf End Function ; ------------------------------------------------------------------------------ Function list_iterator_get(it.listC_iter) ; return the value of the element the iterator is currently on Return it\current_node\value End Function ; ------------------------------------------------------------------------------ ;= CONVENIENCE ; ------------------------------------------------------------------------------ Function list_find_node_by_value.listC_node(our_list.listC, value) ; find the first node in a list matching the value given If our_list = Null Then RuntimeError("not a valid listC: null") this_node.listC_node = our_list\first_node While (this_node <> Null) If this_node\value = value Then Return this_node ; advance this_node = this_node\next_node Wend Return Null End Function ; ------------------------------------------------------------------------------ Function list_find_node_by_position.listC_node(our_list.listC, index) ; find the Nth node in a list If our_list = Null Then RuntimeError("not a valid listC: null") If index < 0 Then index = our_list\elements - index ; make sure there are enough nodes If index < 0 Or index > our_list\elements-1 Then Return Null this_node.listC_node = our_list\first_node For i = 0+1 To index this_node = this_node\next_node Next Return this_node End Function
this uses Ocothorpe's container hash tables, they are very useful.
I'm still not sure whether using the quicksort algorithm is faster than a binary heap, but I use the quicksort anyways.
Edit: binary heap made much faster, updated above. note: took away the spheres, just uncomment them to put them back in.