##############################################################################
# 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.
