Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

hashtable.bas mit toList()

Uploader:MitgliedStringEpsilon
Datum/Zeit:30.01.2015 00:27:14

' Dictionary.bas,  written by StringEpsilon.
' Heavily influenced by the implementation of the Dictionary-class in .NET / Mono.
' The array of primes is taken from the mono source code.
' The function StringHash()) is a direct reimplementation of the GetHashCode-Method of the string class (.NET)
'
' Do what the fuck you want (WTFPL).

' If you have the linkedlist.bas, you can activate "toList" with "#define fbDictionary_ToList"
' freebasic.bas: http://www.freebasic-portal.de/porticula/linkedlist-bas-1793.html
' It was the simpliest linkedList I could find. If we ever get interfaces, I'll do something nicer.

namespace fbDictionary

dim shared PRIMES(0 to ...) as integer = { 11,19,37,73,109,163,251,367,557,823,1237,1861,2777,4177_
,6247,9371,14057,21089,31627,47431,71143,106721,160073, _
240101,360163,540217,810343,1215497,1823231,2734867, _
4102283,6153409,9230113,13845163 }

function StringHash(value as string) as integer
    dim as integer hash
    if (value = "" ) then return 0

    for i as integer = 0 to len(value)
        hash = 31 * hash + value[i]
    next
    return hash
end function

end namespace

#MACRO DeclareDictionary(datatype )

#ifdef fbDictionary_ToList
    #include once "linkedlist.bas"
    #print ##datatype##List
    #ifndef ##datatype##List
        DeclareList(datatype)
    #endif
#endif

type ##datatype##Bucket
    key as string
    value as datatype ptr
    nextBucket as ##datatype##Bucket ptr

    declare constructor()
    declare constructor(key as string, value as datatype)
    declare destructor()
end type

constructor ##datatype##Bucket
    this.value = callocate(sizeof(datatype))
end constructor

constructor ##datatype##Bucket(key as string, value as datatype)
    this.value = callocate(sizeof(datatype))
    this.key = key
    *this.value = value
end constructor


destructor ##datatype##Bucket()
    deallocate(this.value)
    deallocate this.nextBucket
end destructor


Type ##datatype##Dictionary
    declare constructor ()
    declare destructor()

    declare operator [](key as string) as datatype ptr
    declare property Size() as uinteger
    declare property Count() as uinteger
    declare sub Remove(key as string)
    declare sub Insert(key as string, value as datatype)

    #ifdef fbDictionary_ToList
    declare function ToList() as ##datatype##List
    #endif

    private:
        _table as ##datatype##Bucket ptr ptr
        _size as uinteger
        _inUse as uinteger

        declare sub Rehash(newsize as uinteger)
end type

#ifdef fbDictionary_ToList
function ##datatype##Dictionary.ToList() as ##datatype##List
    dim as ##datatype##List list
    dim as ##datatype##Bucket ptr bucket

    for i as integer = 0 to this._size
        bucket = this._table[i]
        while (bucket <> 0)
            list.append(*bucket->value)
            ? i,list.count, list.item(list.count -1)
            bucket = bucket->nextBucket
        wend
    next
    return list
end function
#endif

operator ##datatype##Dictionary.[](key as string) as datatype ptr
    dim as integer index = fbDictionary.StringHash(key) MOD this._size
    dim as ##datatype##Bucket ptr bucket = this._table[index]
    if bucket = 0 then
        return 0
    end if

    if (bucket->key = key) then
        return bucket->value
    else
        bucket = bucket->nextBucket

        while ( bucket <> 0 ANDALSO bucket->key <> key)

            bucket = bucket->nextBucket
        wend
        if (bucket <> 0) then
            return bucket->value
        end if
    end if
    return 0
end operator

constructor ##datatype##Dictionary()
    this._size = fbDictionary.PRIMES(0)
    this._table = callocate( this._size, sizeof(##datatype##Bucket) )
end constructor

sub ##datatype##Dictionary.Insert(key as string, value as datatype)
    if key = "" then exit sub
    dim as integer index = fbDictionary.StringHash(key) MOD this._size

    if (this._table[index] = 0) then
        this._table[index] = new ##datatype##Bucket(key, value)
        this._inUse += 1
    else

        if (this._table[index]->key = key ) then exit sub
        if (this._inUse >= this._size) then

            ' Resize / Rehash the table if it's full with the next best prime number
            dim as integer newPrime
            for i as integer = 0 to ubound(fbDictionary.PRIMES)
                if ( this._size*2 < fbDictionary.PRIMES(i)) then
                    newPrime = fbDictionary.PRIMES(i)
                    exit for
                end if
            next

            this.rehash( newPrime )
            this.Insert(key, value)
        else
            this._table[index]->nextBucket = new ##datatype##Bucket(key, value)
            this._inUse += 1
        end if
    end if
end sub


sub ##datatype##Dictionary.Rehash(newsize as uinteger)
    dim as ##datatype##Bucket ptr ptr oldTable = this._table
    dim as integer oldSize = this._size
    this._inUse = 0
    this._size = newSize
    this._table = callocate(newsize, sizeof(##datatype##Bucket))

    for i as uinteger = 0 to oldSize
        if ( oldTable[i]->key <> "" ) then
            dim as ##datatype##Bucket ptr item = oldTable[i]
            do while ( item <> 0 )
                this.Insert(item->key, *item->value)
                item = item->nextBucket
            loop
        end if
    next
    deallocate oldTable
    this._size = newSize
end sub

destructor ##datatype##Dictionary()
    deallocate this._table
end destructor

property ##datatype##Dictionary.Size() as uinteger
    return this._size
end property

property ##datatype##Dictionary.Count() as uinteger
    return this._inUse
end property

sub ##datatype##Dictionary.Remove(key as string)
    dim as integer index = fbDictionary.StringHash(key) MOD this._size
    dim as ##datatype##Bucket ptr bucket = this._table[index]

    if bucket = 0 then
        exit sub
    end if

    if (bucket->key = key) then
        if ( bucket->nextBucket = 0 ) then
            delete bucket
        else
            this._table[index] = bucket->nextBucket
            bucket->nextBucket = 0
            delete bucket
        end if
        this._inUse -= 1
    else
        dim as ##datatype##Bucket ptr oldBucket = bucket
        while ( bucket <> 0 ANDALSO bucket->key <> key)
            oldBucket = bucket
            bucket = bucket->nextBucket
        wend
        if (bucket->key = key) then
            oldBucket->nextBucket = bucket->nextBucket
            bucket->nextBucket = 0
            delete bucket
            this._inUse -= 1
        end if
    end if

end sub

#endMacro