cHashTable.pkg

// cHashTable class v1.10:
// Created by Erik Svensson and published on eriksven.com in February 2013
// License: MIT
Define cHASHTABLE_INCLUDED for 1

#IFNDEF NULL_ENTRY
Global_Variable Variant NULL_ENTRY
Move (Character(0)) to NULL_ENTRY
#ENDIF

#IFNDEF NULL_KEY
Global_Variable Variant NULL_KEY
Move (Character(255)) to NULL_KEY
#ENDIF

Class _cHashEntry is a Array
    
    Procedure Construct_Object
        Forward Send Construct_Object
        Property Variant[] pvaValues
        Property Integer[] piaSortOrders
    End_Procedure

    Function _Update Variant v Variant[] va Integer i Returns Variant[]
        Move v to va[i]
        Function_Return va
    End_Function

    Procedure Put String sKey Integer iSortOrder Variant vValue
        Integer i iItem iLastItem
        String sStoredKey
        Variant[] vaValues
        Integer[] iaSortOrders
        Move 0 to i
        Get Item_Count to iLastItem
        While (i <= iLastItem)
            Get Value i to sStoredKey
            If (sStoredKey = sKey and Length(sStoredKey) = Length(sKey)) Begin
                Get pvaValues to vaValues
                Get _Update vValue vaValues i to vaValues
                Set pvaValues to vaValues
                Procedure_Return
            End
            Increment i
        Loop
        Decrement i
        Set Value i to sKey
        Get pvaValues to vaValues        
        #IF !@ < 170              
        Get _Update vValue vaValues i to vaValues
        #ELSE
        Move (ResizeArray(vaValues,i+1,vValue)) to vaValues
        #ENDIF
        Set pvaValues to vaValues
        
        Get piaSortOrders to iaSortOrders
        Move (ResizeArray(iaSortOrders,i+1,iSortOrder)) to iaSortOrders
        Set piaSortOrders to iaSortOrders
    End_Procedure

    Procedure AssociateByIndex Integer iIndex String ByRef sKey Variant ByRef vValue Integer ByRef iSortOrder
        Variant[] vaValues
        Integer[] iaSortOrders

        Get pvaValues to vaValues
        Get piaSortOrders to iaSortOrders
        
        Get Value iIndex to sKey
        Move vaValues[iIndex] to vValue
        Move iaSortOrders[iIndex] to iSortOrder

    End_Procedure

    Procedure Associate String sKey Variant ByRef vValue Integer ByRef iSortOrder
        Integer i iItem iLastItem
        String sStoredKey
        Variant[] vaValues
        Integer[] iaSortOrders
        Get Item_Count to iLastItem
        While (i <= iLastItem)
            Get Value i to sStoredKey
            If (sStoredKey = sKey and Length(sStoredKey) = Length(sKey)) Begin
                Get pvaValues to vaValues
                Get piaSortOrders to iaSortOrders
                Move vaValues[i] to vValue
                Move iaSortOrders[i] to iSortOrder
                Procedure_Return
            End
            Increment i
        Loop        
        
        Move -1 to iSortOrder
        
    End_Procedure
    
End_Class

//  The hash table class
Class cHashTable is a cObject
    
    Procedure Construct_Object
        Forward Send Construct_Object
        Property Handle[] pBuckets
        Property Integer piMaxBucketSize
        Property Integer piMaxBucketCount
        Property Integer piCount -1
        Property Integer piCapacity 
        Property Number pnLoadFactor 0.75
        
        Send _InitializeBuckets
        
        Forward Send Construct_Object
    End_Procedure
    
    { Visibility=Private }
    Procedure _InitializeBuckets
        
        Set piMaxBucketSize to 64
        Set piMaxBucketCount to 128
        Set piCount to -1 
        
        //Calculate the initial maximum capacity
        Set piCapacity to (piMaxBucketSize(Self) * piMaxBucketCount(Self))

        Handle[] buckets
        Integer i
        For i from 0 to (piMaxBucketCount(Self)-1)
            Move (Create(Self,U__cHashEntry)) to buckets[i]
        Loop

        Set pBuckets to buckets
    End_Procedure

    { Visibility=Public }
    Function Is_cHashTable Returns Boolean
        Function_Return True
    End_Function

    { Visibility=Private }
    Function _Hash String s Integer iMod Returns Integer
        BigInt hash
        Integer i
        Char[] ca
        Address aStr
        Move 5381 to hash
        Move (ResizeArray(ca,Length(s)+1)) to ca
        Move (AddressOf(ca)) to aStr
        Move s to aStr
        Repeat
            Move ((33 * hash) + ca[i]) to hash
            Increment i
        Until (ca[i] = 0)
        If (hash > 0) Function_Return (hash - (iMod * (hash / iMod)))
        Else Function_Return (iMod + (hash - (iMod * (hash / iMod))) - 1)
    End_Function
    
    { Visibility=Private }
    Procedure _Resize
        Handle[] buckets_new
        Handle[] buckets
        Integer i ii iHash iBucketCount iSize iSortOrder iLastItem
        String sKey
        Variant vValue

        Get piMaxBucketCount to iBucketCount
        Move (iBucketCount*2) to iBucketCount
        Set piMaxBucketCount to iBucketCount
        
        Set piCapacity to (piMaxBucketSize(Self) * piMaxBucketCount(Self))
        
        Move (ResizeArray(buckets_new, iBucketCount)) to buckets_new

        Get pBuckets to buckets

        For i from 0 to (piMaxBucketCount(Self)-1)
            Move (Create(Self,U__cHashEntry)) to buckets_new[i]
        Loop

        For i from 0 to ((iBucketCount/2)-1)
            Move (Item_Count(buckets[i]) - 1) to iLastItem
            For ii from 0 to iLastItem
                Send AssociateByIndex of buckets[i] ii (&sKey) (&vValue) (&iSortOrder)
                Move (_Hash(Self, sKey, iBucketCount)) to iHash
                Send Put of buckets_new[iHash] sKey iSortOrder vValue
            Loop         
            Send Destroy of buckets[i]
        Loop

        Set pBuckets to buckets_new

    End_Procedure
    
    Function _ProcessKey String sKey Returns String
        If (String(sKey) = "") Function_Return NULL_KEY
        Else If (String(sKey) = NULL_KEY) Function_Return ""
        Function_Return sKey
    End_Procedure
    
    { Visibility=Public }
    Procedure Set Value String sKey Variant vValue
        Handle[] buckets
        Integer iBucket iIndex iCount iSortOrder
        Variant vStoredValue
        
        Get _ProcessKey sKey to sKey
        
        Get piCount to iCount
        
        Get pBuckets to buckets
        Move (_Hash(Self,sKey,piMaxBucketCount(Self))) to iBucket
        
        Send Associate of buckets[iBucket] sKey (&vStoredValue) (&iSortOrder)

        If (iSortOrder = -1) Begin
            Increment iCount
            Move iCount to iSortOrder
            Set piCount to iCount
        End

        Send Put of buckets[iBucket] sKey iSortOrder vValue

        If (Number(piCount(Self)) / Number(piCapacity(Self)) > pnLoadFactor(Self)) Begin
            Send _Resize
        End
  
    End_Procedure
    
    { Visibility=Public }
    Function Value String sKey Returns Variant
        Handle[] buckets
        Integer iBucket iIndex iCount iSortOrder
        Variant vValue
        
        Get _ProcessKey sKey to sKey
        
        Get piCount to iCount
        
        Get pBuckets to buckets
        Move (_Hash(Self,sKey,piMaxBucketCount(Self))) to iBucket
        
        Send Associate of buckets[iBucket] sKey (&vValue) (&iSortOrder)

        If (iSortOrder = -1) Begin
            Move True to FindErr
            Move False to Found
            Function_Return NULL_ENTRY
        End
        Else Begin
            Move False to FindErr
            Move True to Found
            Function_Return vValue
        End
        
    End_Function
    
    { Visibility=Public }
    Function Keys Returns String[]
        Integer i ii iSize iSortOrder
        String[] saKeys
        Handle[] buckets
        String sKey
        Variant vValue
        
        Get pBuckets to buckets
        Move (SizeOfArray(buckets)-1) to iSize 
        
        For i from 0 to iSize
            For ii from 0 to (Item_Count(buckets[i]) - 1)
                Send AssociateByIndex of buckets[i] ii (&sKey) (&vValue) (&iSortOrder)
                Get _ProcessKey sKey to sKey
                Move sKey to saKeys[iSortOrder]
            Loop
        Loop
        
        Function_Return saKeys
        
    End_Function
    
    { Visibility=Public }
    Procedure Clear
        Handle[] buckets
        Integer iSize i
        
        Get pBuckets to buckets
        Move (SizeOfArray(buckets)-1) to iSize
        For i from 0 to iSize
            Send Destroy of buckets[i]
        Loop
        
        Send _InitializeBuckets
    End_Procedure

End_Class