Updated 2014-01-15 02:04:08 by RLE

memoize

A package that can be used to cache, load and save the values of expensive pure function calls.

HISTORY

DDG 2004-06-03: A fix to memoize::save for handling strings with spaces

DDG 2004-06-04: Adding memoize::unload to unset the Memo array or parts of it, instead of directly manipulating it via array unset memoize::Memo

SEE ALSO

memoizing, Perl Memoize Package [1]
 ##############################################################################
 #  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.