############################################################################## # AUTHOR: Dr. Detlef Groth # Copyright (c) Get it, use it, share it, improve it, but don't blame me. package provide memoize 0.1 namespace eval ::memoize { variable Memo } proc ::memoize::memoize {} { variable Memo set cmd [info level -1] if {[info level] > 2 && [lindex [info level -2] 0] eq "memoize::memoize"} return if { ! [info exists Memo($cmd)]} {set Memo($cmd) [eval $cmd]} return -code return $Memo($cmd) } proc ::memoize::save {file {cmd ""}} { variable Memo set names [array names Memo -glob $cmd*] if [catch { set out [open $file w 0600] }] { error "Could not open $file!" } else { foreach name $names { puts $out "set {memoize::Memo($name)} {$Memo($name)}" } } close $out } proc ::memoize::load {file} { variable Memo if {[file readable $file]} { source $file } } proc ::memoize::unload {{cmd ""}} { variable Memo array unset Memo "$cmd*" } # testing actually longer than the code itself if {0} { # RS example proc memoize {} { global memo set cmd [info level -1] if {[info level] > 2 && [lindex [info level -2] 0] eq "memoize"} return if { ! [info exists memo($cmd)]} {set memo($cmd) [eval $cmd]} return -code return $memo($cmd) } proc fib x {expr {$x <=1? 1 : [fib [expr {$x-1}]] + [fib [expr {$x-2}]]}} proc fibm x {memoize; expr {$x <=1? 1 : [fibm [expr {$x-1}]] + [fibm [expr {$x-2}]]}} proc fibmp x {memoize::memoize; expr {$x <=1? 1 : [fibm [expr {$x-1}]] + [fibm [expr {$x-2}]]}} fib 20 ;#= 10946 fibm 20 ;#= 10946 fibmp 20 ;#= 10946 time {fib 32} ;#= 7757279 microseconds per iteration time {fib 32} ;#= 7763364 microseconds per iteration time {fib 32} ;#= 7927045 microseconds per iteration array unset memo time {fibm 32} ;#= 1365 microseconds per iteration time {fibm 32} ;#= 27 microseconds per iteration time {fibm 32} ;#= 28 microseconds per iteration memoize::unload time {fibmp 32} ;#= 97 microseconds per iteration time {fibmp 32} ;#= 29 microseconds per iteration time {fibmp 32} ;#= 28 microseconds per iteration memoize::save test.tmf memoize::unload memoize::load test.tmf time {fibmp 32} ;#= 33 microseconds per iteration time {fibmp 32} ;#= 29 microseconds per iteration time {fibmp 32} ;#= 28 microseconds per iteration }
RHS This seems like a very good candidate for Tcllib.DDG I did a feature request on the tcllib sourceforge site.
SS: This wonderful version of memoize just entered the Jim standard library. The implementation uses Jim Closures, so does not need to take state in a global var:
proc memoize {} {{Memo {}}} { set cmd [info level -1] if {[info level] > 2 && [lindex [info level -2] 0] eq "memoize"} return if {![info exists Memo($cmd)]} {set Memo($cmd) [eval $cmd]} return -code return $Memo($cmd) }For the rest it seems identical. I consider this a Tcl programming pearl, thanks DDG.