# -*- tcl -*-
# Tcl Benchmark File
#
# This file contains a number of benchmarks for the 'struct::tree'
# data structure to allow developers to monitor package performance.
#
# (c) 2003 Andreas Kupries <andreas_kupries@users.sourceforge.net>


# We need at least version 8.2 for the package and thus the
# benchmarks.

if {![package vsatisfies [package provide Tcl] 8.2]} {
    return
}

# ### ### ### ######### ######### ######### ###########################
## Setting up the environment ...

set moddir [file dirname [file dirname [info script]]]
lappend auto_path $moddir

package forget cmdline
catch {namespace delete ::cmdline}
source [file join $moddir cmdline cmdline.tcl]

package forget struct::list
catch {namespace delete ::struct::list}
source [file join [file dirname [info script]] list.tcl]

package forget struct::tree
catch {namespace delete ::struct::tree}
source [file join [file dirname [info script]] tree.tcl]

namespace import struct::tree

set code tcl
if {![catch {package present tcllibc}]} {
    set code {C  }
}
#set code $struct::tree::loaded
#set code $auto_path

proc makeNcmd {n} {
    return [linsert [struct::list iota $n] 0 t insert root end]
}

proc makeN {n} {
    tree t
    eval [makeNcmd $n]
    return
}

proc makeChainN {n} {
    tree t
    set p root
    for {set i 0} {$i < $n} {incr i} {
	set p [t insert $p end $i]
    }
    return $p
}

proc makeAttr {n} {
    tree t
    for {set i 0} {$i < $n} {incr i} {
	t set root $i .
    }
    return
}


# ### ### ### ######### ######### ######### ###########################
## Benchmarks.

# Tree operations fall into four distinctive classes, described
# below. Each have different expected performance characteristics. The
# benchmarks indicate the class of the tested operation in their
# description.

# [Ns] - At a single node
#        Computes data relevant to or associated with a single
#        node. They are expected to run in constant time.
#
#        For some this is something we have to check, as a bad
#        implementation may actually cause its performance to match
#        operations in [Ne].
#
# [N+] - At a single node, needing data from either or below
#        Similar to Ns, however to compute the result data from either
#        children or ancestors is required. They are expected to have
#        linear performance in general, across some parameter. Examples
#        of such parameters are: Depth of node in the tree, number of
#        (in)direct children, etc.
#
#	 They may have constant performance if the implementation
#	 takes measures like caching of results, or using special
#	 algorithms. The effectiveness of such measures may be limited
#	 to unchanging trees. I.e. changing the structure of the tree
#	 may invalidate cached data, forcing costly recomputation.
#
# [Tr] - Over the whole tree
#
#        These operations have to access the whole tree to compute
#        their result, making them linear in the size of the tree in
#        general. Only caching may yield better performance, however
#        only for unchanging trees.
#
# [Mo] - Structure modifiers
#
#        These operations change the tree, making them difficult to
#        measure as they are not idempotent like the operations in all
#        the other classes. Their performance is dependent on internal
#        data structures and memory allocation strategies. Dependence
#        on data structures implies that use of structures optimized
#        for the three preceding classes can affect the modifiers
#        negatively.

# **Note **
# At least the critcl implementation caches some of the structural
# information when computed (depth, height, size), and invalidates it
# after changes to the tree structure. The */redo benchmarks use a
# small operation (swap of two independent nodes) to perturb the cache
# and force recomputation of the data every time. The comparison to
# the equivalent non-redo benchmark gives us a best-to-worst estimate
# of the effect the cache has.

# ### ### ### ######### ######### ######### ###########################
## [Ns]

bench -desc "\[Ns\] tree exists ok" -pre {
    tree t
} -body {
    t exists root
} -post {
    t destroy
}

bench -desc "\[Ns\] tree exists miss" -pre {
    tree t
} -body {
    t exists miss
} -post {
    t destroy
}

# Navigation - Parent, Left/Right sibling

bench -desc "\[Ns\] tree parent" -pre {
    tree t
    t insert root end 0
} -body {
    t parent 0
} -post {
    t destroy
}

bench -desc "\[Ns\] tree next" -pre {
    tree t
    t insert root end 0
} -body {
    t next 0
} -post {
    t destroy
}

bench -desc "\[Ns\] tree previous" -pre {
    tree t
    t insert root end 0
} -body {
    t previous 0
} -post {
    t destroy
}

bench -desc "\[Ns\] tree isleaf" -pre {
    tree t
    t insert root end 0
} -body {
    t isleaf 0
} -post {
    t destroy
}

bench -desc "\[Ns\] tree index" -pre {
    tree t
    t insert root end 0
} -body {
    t index 0
} -post {
    t destroy
}

bench -desc "\[Ns\] tree rootname" -pre {
    tree t
} -body {
    t rootname
} -post {
    t destroy
}

foreach n {1 10 100 1000 10000} {
    bench -desc "\[Ns\] tree numchildren $n" -pre {
	makeN $n
    } -body {
	t numchildren root
    } -post {
	t destroy
    }
}

foreach n {1 10 100 1000 10000} {
    bench -desc "\[Ns\] tree getall $n" -pre {
	makeAttr $n
    } -body {
	t getall root
    } -post {
	t destroy
    }

    bench -desc "\[Ns\] tree keys $n" -pre {
	makeAttr $n
    } -body {
	t keys root
    } -post {
	t destroy
    }

    bench -desc "\[Ns\] tree set $n" -pre {
	makeAttr $n
    } -body {
	t set root attr test
    } -post {
	t destroy
    }

    bench -desc "\[Ns\] tree get $n" -pre {
	makeAttr $n
	t set root attr .
    } -body {
	t get root attr
    } -post {
	t destroy
    }

    bench -desc "\[Ns\] tree keyexists miss $n" -pre {
	makeAttr $n
    } -body {
	t keyexists root attr
    } -post {
	t destroy
    }

    bench -desc "\[Ns\] tree keyexists has $n" -pre {
	makeAttr $n
	t set root attr .
    } -body {
	t keyexists root attr
    } -post {
	t destroy
    }
}

# ### ### ### ######### ######### ######### ###########################
## [Ne]

foreach n {1 10 100 1000 10000} {
    # Notes on results:
    # - Tcl implementation of 'children' is basically constant.
    #   It simply has to return an already constructed list.
    #
    # - The critcl implementation currently has to generate a Tcl_Obj
    #   from the internal node array, and is thus linear.
    #
    # Break even for Tcl happens somewhere after 1000 nodes. I.e from
    # then on the C impl. is slower.

    bench -desc "\[Ne\] tree children $n" -pre {
	makeN $n
    } -body {
	t children root
    } -post {
	t destroy
    }
}

foreach n {1 10 100 1000 10000} {
    # root size is trivial
    bench -desc "\[Ne\] tree size root $n" -pre {
	makeChainN $n
    } -body {
	t size root
    } -post {
	t destroy
    } -post {
	t destroy
    }

    # non-root size requires descendants
    bench -desc "\[Ne\] tree size any $n" -pre {
	makeChainN $n
    } -body {
	t size 0
    } -post {
	t destroy
    } -post {
	t destroy
    }

    bench -desc "\[Ne\] tree size/redo root $n" -pre {
	makeChainN $n
	t insert root end a b
    } -body {
	t swap a b ; t size root
    } -post {
	t destroy
    } -post {
	t destroy
    }

    # non-root size requires descendants
    bench -desc "\[Ne\] tree size/redo any $n" -pre {
	makeChainN $n
	t insert root end a b
    } -body {
	t swap a b ; t size 0
    } -post {
	t destroy
    } -post {
	t destroy
    }

    bench -desc "\[Ne\] tree ancestors $n" -pre {
	set p [makeChainN $n]
    } -body {
	t ancestors $p
    } -post {
	t destroy
    }

    bench -desc "\[Ne\] tree depth $n" -pre {
	set p [makeChainN $n]
    } -body {
	t depth $p
    } -post {
	t destroy
    }

    bench -desc "\[Ne\] tree depth/redo $n" -pre {
	set p [makeChainN $n]
	t insert root end a b
    } -body {
	t swap a b ; t depth $p
    } -post {
	t destroy
    }
}

foreach n {1 10 100 1000} {
    bench -desc "\[Ne\] tree descendants $n" -pre {
       makeChainN $n
    } -body {
	t descendants root
    } -post {
	t destroy
    }

    bench -desc "\[Ne\] tree children -all $n" -pre {
	makeN $n
    } -body {
	t children -all root
    } -post {
	t destroy
    }
}

foreach n {1 10 100 1000} {
    bench -desc "\[Ne\] tree height $n" -pre {
       makeChainN $n
    } -body {
	t height root
    } -post {
	t destroy
    }

    bench -desc "\[Ne\] tree height/redo $n" -pre {
       makeChainN $n
	t insert root end a b
    } -body {
	t swap a b ; t height root
    } -post {
	t destroy
    }
}

# ### ### ### ######### ######### ######### ###########################
## [Tr]

foreach n {1 10 100 1000 10000} {
    bench -desc "\[Tr\] tree nodes $n" -pre {
	makeN $n
    } -body {
	t nodes
    } -post {
	t destroy
    }

    bench -desc "\[Tr\] tree leaves $n" -pre {
	makeN $n
    } -body {
	t leaves
    } -post {
	t destroy
    }
}

foreach n {1 10 100 1000} {
    bench -desc "\[Tr\] tree serialize flat $n" -pre {
	makeN $n
    } -body {
	t serialize
    } -post {
	t destroy
    }

    bench -desc "\[Tr\] tree deserialize flat $n" -pre {
	makeN $n
	set v [t serialize]
    } -body {
	t deserialize $v
    } -post {
	t destroy
    }
}

foreach n {1 10 100 1000} {
    bench -desc "\[Tr\] tree serialize deep $n" -pre {
	makeChainN $n
    } -body {
	t serialize
    } -post {
	t destroy
    }

    bench -desc "\[Tr\] tree deserialize deep $n" -pre {
	makeChainN $n
	set v [t serialize]
    } -body {
	t deserialize $v
    } -post {
	t destroy
    }
}

# ### ### ### ######### ######### ######### ###########################
## [Mo]

bench -desc "\[Mo\] tree create/destroy" -body {
    [tree] destroy
}

bench -desc "\[Mo\] tree swap" -pre {
    tree t ; t insert root end 0 1
} -body {
    t swap 0 1
} -post {
    t destroy
}

foreach n {1 10 100 1000} {
    # Note: We precompute a command which inserts n
    # nodes into the root, instead of doing the loop
    # as part of the benchmark. I.e. the only loop is
    # in the implementation of tree.

    bench -desc "\[Mo\] tree create/destroy $n" -pre {
	set cmd [makeNcmd $n]
    } -body {
	tree t ; eval $cmd ; t destroy
    }
}

foreach n {1 10 100 1000 10000} {
    # Note: the -iter argument.
    #       We add a node n times, one per iteration, and
    #       then see how much the operation took on average.
    #       In a C implementation this exercises the re-
    #       allocation code and strategy.
    #
    # A different way would be to insert n nodes once. This
    # is actually done in the create/destroy benchmarks. This
    # exercises the internal node insertion loop instead.

    bench -desc "\[Mo\] tree insert end $n" -pre {
	tree t
    } -body {
	t insert root end
    } -post {
	t destroy
    } -iter $n

    bench -desc "\[Mo\] tree insert front $n" -pre {
	tree t
    } -body {
	t insert root 0
    } -post {
	t destroy
    } -iter $n

    bench -desc "\[Mo\] tree insert middle1 $n" -pre {
	tree t ; t insert root end 0 1 2 3 4
    } -body {
	t insert root 5
    } -post {
	t destroy
    } -iter $n

    bench -desc "\[Mo\] tree insert middle2 $n" -pre {
	tree t ; t insert root end 0 1 2 3 4
    } -body {
	t insert root end-5
    } -post {
	t destroy
    } -iter $n
}

# ### ### ### ######### ######### ######### ###########################
## Complete

return

# ### ### ### ######### ######### ######### ###########################
## Notes ...

# :=, -->, =
#
# attr - filtered attr over all nodes
#
# walk, walkproc
#
# attr modifiers - append, lappend, unset
# modifiers      - cut, delete, move, rename, splice, swap (insert)

# Notes on optimizations we can do.
#
# Tcl - Cache structural data - depth, ancestors ...
# C   - Cache results, like child lists (Tcl_Obj's!)
#       Maybe use Tcl_Obj/List for child arrays instead
#       of N* ? Effect on modification performance ?
