open System
type Key<'k> =
|Key of 'k
|Root
type NodeRecord<'k> = {key:Key<'k>; down:Node<'k>; mutable succ:Node<'k>}
and Node<'k> =
|Node of NodeRecord<'k>
|Nil
|DownNil
let inline createTower k maxLvl =
let rec createNode node lvl=
match lvl with
|l when l < maxLvl ->
let r = {key= k;down = node; succ= Nil}
createNode (Node r) (lvl+1)
|_->node
createNode DownNil 0
let inline downNode node=
match node with
|Node record-> record.down
|_-> Nil
let inline setSucc succNode node=
match succNode with
|Node record-> record.succ<-node
|_->()
let inline setNewNode predecessor newNode node=
match predecessor,newNode with
|Node predrecord, Node newrecord->
newrecord.succ<-node
predrecord.succ<-newNode
|_->()
type SkipList<'k when 'k:comparison> (p:float, maxLvl:int) =
let maxLevel = maxLvl
let probability = p
let mutable curLevel = 0
let rnd =new Random()
//skip list data
let tskip = createTower Root maxLvl
member x.Data
with get() = tskip
member x.MaxLevel
with get() = maxLevel
member x.Probability
with get() = probability
member private x.Start
with get() =
let rec startNode node n =
match n with
|l when l > 0 -> startNode (downNode node) (n-1)
|_-> node
startNode tskip (maxLevel - (curLevel+1))
member inline private x.chooseLevel (rndm:Random)=
let rs = Seq.initInfinite (fun _-> rndm.NextDouble())
let samples = Seq.take (maxLevel - 1) rs
Seq.length (Seq.takeWhile ((<) probability ) samples)
member inline x.Insert (k:'k) =
let rec insertAcc lvl node newNode predecessor=
match node with
|DownNil->()
|Nil ->
match (lvl > 0) with
|false->
setSucc predecessor newNode
insertAcc lvl (downNode predecessor) (downNode newNode) Nil
|true->
insertAcc (lvl-1) (downNode predecessor) newNode Nil
|Node record ->
match record.key with
|Root ->
insertAcc lvl record.succ newNode node
|Key rkey->
match compare k rkey with
|GT when GT > 0 ->
insertAcc lvl record.succ newNode node
|LT when LT < 0->
match (lvl > 0) with
|false->
setNewNode predecessor newNode node
insertAcc lvl (downNode predecessor) (downNode newNode) Nil
|true->
insertAcc (lvl-1) (downNode predecessor) newNode Nil
|EQ -> ()
let newLvl = x.chooseLevel rnd
let newNodes = createTower (Key k) (newLvl+1)
if (curLevel < newLvl) then
curLevel <- newLvl
insertAcc (curLevel - newLvl) x.Start newNodes Nil
member inline x.Lookup (k:'k) =
let rec lookupAcc node predecessor=
match node with
|DownNil->None
|Nil -> lookupAcc (downNode predecessor) Nil
|Node record ->
match record.key with
|Root ->
lookupAcc record.succ node
|Key rkey->
match compare k rkey with
|GT when GT > 0 ->
lookupAcc record.succ node
|LT when LT < 0->
lookupAcc (downNode predecessor) Nil
|EQ -> Some k
lookupAcc x.Start Nil
member inline x.Delete k =
let rec deleteAcc node predecessor =
match node with
|DownNil-> ()
|Nil -> deleteAcc (downNode predecessor) Nil
|Node record ->
match record.key with
|Root ->
deleteAcc record.succ node
|Key rkey->
match compare k rkey with
|GT when GT > 0 ->
deleteAcc record.succ node
|LT when LT < 0->
deleteAcc (downNode predecessor) Nil
|EQ ->
setSucc predecessor record.succ
deleteAcc (downNode predecessor) Nil
deleteAcc x.Start Nil
Die einzige interessante Detail ist die chooseLevel -Methode.
//Choosing a Random Level
member inline private x.chooseLevel (rndm:Random)=
let rs = Seq.initInfinite (fun _-> rndm.NextDouble())
let samples = Seq.take (maxLevel - 1) rs
Seq.length (Seq.takeWhile ((<) probability ) samples)
