From a051d5585ebd10f22fe53e581530fa60665f6690 Mon Sep 17 00:00:00 2001
From: Julian Noble <julian@precisium.com.au>
Date: Sat, 15 Mar 2025 03:10:59 +1100
Subject: [PATCH] picalc experimental module

---
 src/modules/picalc-999999.0a1.0.tm   | 642 +++++++++++++++++++++++++++
 src/modules/picalc-buildversion.txt  |   3 +
 src/modules/punk/lib-999999.0a1.0.tm |   4 +
 3 files changed, 649 insertions(+)
 create mode 100644 src/modules/picalc-999999.0a1.0.tm
 create mode 100644 src/modules/picalc-buildversion.txt

diff --git a/src/modules/picalc-999999.0a1.0.tm b/src/modules/picalc-999999.0a1.0.tm
new file mode 100644
index 00000000..9f4e9467
--- /dev/null
+++ b/src/modules/picalc-999999.0a1.0.tm
@@ -0,0 +1,642 @@
+# -*- tcl -*-
+# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake  to update from <pkg>-buildversion.txt
+# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
+#
+# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
+# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# (C) 2025
+#
+# @@ Meta Begin
+# Application picalc 999999.0a1.0
+# Meta platform     tcl
+# Meta license      MIT
+# @@ Meta End
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# doctools header
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[manpage_begin shellspy_module_picalc 0 999999.0a1.0]
+#[copyright "2025"]
+#[titledesc {Module API}]  [comment {-- Name section and table of contents description --}]
+#[moddesc {-}]             [comment {-- Description at end of page heading --}] 
+#[require picalc]
+#[keywords module]
+#[description]
+#[para] -
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[section Overview]
+#[para] overview of picalc
+#[subsection Concepts]
+#[para] -
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Requirements
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[subsection dependencies]
+#[para] packages used by picalc
+#[list_begin itemized]
+
+package require Tcl 8.6-
+package require punk::lib 
+package require punk::args
+#*** !doctools
+#[item] [package {Tcl 8.6}]
+#[item] [package {punk::lib}]
+#[item] [package {punk::args}]
+
+# #package require frobz
+# #*** !doctools
+# #[item] [package {frobz}]
+
+#*** !doctools
+#[list_end]
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[section API]
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# oo::class namespace
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#tcl::namespace::eval picalc::class {
+    #*** !doctools
+    #[subsection {Namespace picalc::class}]
+    #[para] class definitions
+    #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} {
+        #*** !doctools
+        #[list_begin enumerated]
+
+        # oo::class create interface_sample1 {
+        #     #*** !doctools
+        #     #[enum] CLASS [class interface_sample1]
+        #     #[list_begin definitions]
+
+        #     method test {arg1} {
+        #         #*** !doctools
+        #         #[call class::interface_sample1    [method test] [arg arg1]]
+        #         #[para] test method
+        #         puts "test: $arg1"
+        #     }
+
+        #     #*** !doctools
+        #     #[list_end] [comment {-- end definitions interface_sample1}]
+        # }
+
+        #*** !doctools
+        #[list_end] [comment {--- end class enumeration ---}]
+    #}
+#}
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+
+
+tcl::namespace::eval picalc {
+    # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+    # Base namespace
+    # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+    #*** !doctools
+    #[subsection {Namespace picalc}]
+    #[para] Core API functions for picalc 
+    #[list_begin definitions]
+
+    variable PUNKARGS
+
+
+
+
+    #proc sample1 {p1 n args} {
+    #    #*** !doctools
+    #    #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]]
+    #    #[para]Description of sample1 
+    #    #[para] Arguments:
+    #    #   [list_begin arguments]
+    #    #   [arg_def tring p1]       A description of string argument p1.
+    #    #   [arg_def integer n]      A description of integer argument n.
+    #    #   [list_end]
+    #    return "ok" 
+    #}
+
+    #a known value for the _test functions
+    variable pifrac [string map {" " ""} "1415926535 8979323846 2643383279 5028841971"]
+
+    #10k  approx 2s
+    #20k  approx 18s
+    #100k approx 1519s (25+minutes)
+    proc fast {dp} {
+        package require math::bigfloat
+        #math::bigfloat calculates using 'precision' 
+        # --------------
+        #Faster for large values - but timing variable on same values!!
+        #After running on large values becomes - slower than calc and spigot for small values (somewhere around <1k)
+        catch {unset ::math::bigfloat::_pi0}
+        #this is due to the caching mechanism - for the purposes of comparison/testing and consistent results, we'll 'wreck' that caching here.
+        # --------------
+        set answer [math::bigfloat::tostr [math::bigfloat::pi [expr {$dp+3}]]] ;#we need to calculate with +3 precision to avoid rounding at the tail of chosen number of dp in all cases
+        return [string range $answer 0 end-2]
+    }
+    proc fast_test {max} {
+        variable pifrac
+        set pi 3.$pifrac
+        set result ""
+        set k 0
+        while {$k <= $max} {
+            set answer [fast $k]
+            set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] 
+            set lcplen [string length $lcp]
+            set tail [string range $answer $lcplen end]
+            set greenanswer  [a+ green]$lcp[a]$tail
+
+            package require overtype ;#can't use 'format' for ANSI coloured strings
+            set col1 [string repeat " " [expr {$max + 3}]]
+            append result "[format %3s $k]-> [overtype::left $col1 $greenanswer]" \n
+            incr k
+        }
+        return $result
+    }
+
+
+    lappend PUNKARGS [list {
+        @id     -id     ::picalc::spigot
+        @cmd    -name   picalc::spigot -help\
+            "Return digits of pi to dp decimal places.
+
+            'classic' Rabinowitz and Wagon spigot algorithm.
+            https://www.cs.williams.edu/~heeringa/classes/cs135/s15/readings/spigot.pdf
+            relatively straight port from pascal algorithm
+            
+            This algorithm for generating digits of pi uses a long list relative to the number of required digits
+            Performance doesn't seem to be spectacular,
+            (seems to be around 7-8secs for 1000 digits
+             93s for 10K digits)
+            
+            The 'fast' (math::bigfloat based) function is much faster,
+            but also becomes extremely slow at a few 10's of thousands of digits.
+            "
+        @leaders -min 0 -max 0
+        @opts
+        -channel -choices {none stdout stderr} -default none -choicerestricted 0 -choicelabels {
+            none\
+            " Return as result string"
+        }
+        @values -min 0 -max 1
+        dp -type int -default 32 -help\
+            "Number of decimal places
+             (final digit is not rounded)"
+    }]
+    # 5K approx 25s
+    #10K approx 93s
+    proc spigot_emit {c chan countvar dp} {
+        upvar $countvar count
+        incr count
+        if {$chan eq "none"} {
+            upvar result r
+            append r $c  ;#leave chars beyond dp to be trimmed by caller
+            return
+        } else {
+            if {$count > 2} {
+                if {$count <= $dp + 2} {
+                    puts -nonewline $chan $c
+                } 
+            } else {
+                if {$count == 1} {
+                    puts -nonewline $chan 3
+                } else {
+                    puts -nonewline $chan "."
+                }
+            }
+        }
+    }
+    proc spigot {args} {
+        set argd [punk::args::parse $args withid ::picalc::spigot]
+        lassign [dict values $argd] leaders opts values received
+        set dp      [dict get $values dp]
+        set channel    [dict get $opts -channel]
+
+        if {$dp < 1} {return 3}
+        set n [expr {$dp +2}] ;#dp +1 can get rounding errors
+        set len [expr {(10 * $n) / 3}]
+        set a [lrepeat [expr {$len+1}] 2]
+        set nines 0
+        set predigit 0
+        set result ""
+        set countvar 0
+        if {$channel eq "none"} {
+            set dpextra 2 
+        } else {
+            set dpextra 2
+        }
+        for {set j 1} {$j <= $len} {incr j} {
+            set q 0
+            for {set i $len} {$i > 0} {incr i -1} {
+                set ai      [lindex $a $i]
+                set x       [expr {(10 * $ai) + ($q * $i)}]
+                lset a $i   [expr {$x % (2*$i-1)}]
+                set q       [expr {$x / (2*$i-1)}]
+            }
+            lset a 1    [expr {$q % 10}]
+            set q       [expr {$q / 10}]
+            if {$q == 9} {
+                incr nines
+            } else {
+                if {$q == 10} {
+                    #append result [expr {$predigit + 1}]
+                    spigot_emit [expr {$predigit + 1}] $channel countvar $dp
+                    if {$countvar == $dp +$dpextra} {
+                        break
+                    }
+                    for {set k 1} {$k <= $nines} {incr k} {
+                        #append result 0
+                        spigot_emit 0 $channel countvar $dp
+                        if {$countvar == $dp +$dpextra} {
+                            break
+                        }
+                    }
+                    if {$countvar == $dp +$dpextra} {
+                        break
+                    }
+
+                    set predigit 0
+                    set nines 0
+                } else {
+                    #append result $predigit
+                    spigot_emit $predigit $channel countvar $dp
+                    if {$countvar == $dp +$dpextra} {
+                        #+2 for leading 03
+                        break
+                    }
+                    set predigit $q
+                    if {$nines != 0} {
+                        for {set k 1} {$k <= $nines} {incr k} {
+                            #append result 9
+                            spigot_emit 9 $channel countvar $dp
+                            if {$countvar == $dp +$dpextra} {
+                                break
+                            }
+                        }
+                        if {$countvar == $dp +$dpextra} {
+                            break
+                        }
+                        set nines 0
+                    }
+                }
+            }
+        }
+        #append result $predigit
+        spigot_emit $predigit $channel countvar $dp
+        #eg result 0314159
+        if {$channel eq "none"} {
+            set result 3.[string range $result 2 $dp+1] ;#always trim to dp+1 (= $dp+2-1) - longer answer can have erroneous digits
+            #set result 3.[string range $result 2 end]
+            return $result
+        } else {
+            flush $channel
+            #review
+            return "emitted $countvar chars to channel $channel"
+        }
+    }
+
+
+    proc spigot_test {max} {
+        variable pifrac
+        set pi 3.$pifrac
+        set result ""
+        set k 0
+        while {$k <= $max} {
+            set answer [spigot $k]
+            set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] 
+            set lcplen [string length $lcp]
+            set tail [string range $answer $lcplen end]
+            set greenanswer  [a+ green]$lcp[a]$tail
+
+            package require overtype ;#can't use 'format' for ANSI coloured strings
+            set col1 [string repeat " " [expr {$max + 3}]]
+            append result "[format %3s $k]-> [overtype::left $col1 $greenanswer]" \n
+            incr k
+        }
+        return $result
+    }
+
+
+    #def f(n):
+    #    numerator, denominator = 1, 1
+    #    # i/(2i + 1) = n/(2n + 1), ..., 3/7, 2/5, 1/3
+    #    for i in range(n, 0, -1):
+    #        # multiply by i/(2i + 1)
+    #        numerator *= i
+    #        denominator *= 2 * i + 1
+    #        # add 1 (p/q -> (p + q)/q = p/q + q/q = p/q + 1)
+    #        numerator += denominator
+    #    return 2 * numerator, denominator
+    #for n in range(20):
+    #    p, q = f(n)
+    #   print(Fraction(p, q))
+
+    #an approx of pi that rapidly creates a fraction too big to calculate with standard Tcl doubles..
+    proc fraction {dp} {
+        if {$dp < 1} {return 3}
+        #determine an n big enough to give dp valid digits
+        set n [expr {$dp +1}] 
+        set n [expr {(10 * $n) / 3}]
+        return [fraction_iteration $n]
+    }
+    # 5k  approx 27s
+    # 10k approx 127s
+    proc calc {dp} {
+        if {$dp < 1} {return 3}
+        set n [expr {$dp +1}] 
+        set n [expr {(10 * $n) / 3}]
+        package require math::bigfloat
+        lassign [fraction_iteration $n] a b
+        set bigfloat [math::bigfloat::div [math::bigfloat::int2float $a] [math::bigfloat::int2float $b]]
+        set answer [math::bigfloat::tostr $bigfloat]
+        #10*$d/3 == $n
+        #set trustdigits [expr {(3*$n)/10}] ;#??
+        return [string range $answer 0 $dp+1]  ;#= +2-1
+        return $answer
+    }
+    proc calc_test {max} {
+        variable pifrac
+        set pi 3.$pifrac
+        set k 0 
+        set result ""
+        set last_lcplen 0 
+        set got ""
+        while {$k <= $max} {
+            set answer [calc $k]
+
+            set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] 
+            set lcplen [string length $lcp]
+            if {$lcplen > $last_lcplen} {
+                set last_lcplen $lcplen
+                set got [string index $lcp end]
+                set c red
+            } else {
+                set c yellow
+            }
+            set tail [string range $answer $lcplen end]
+            set greenanswer  [a+ green]$lcp[a]$tail
+            
+            package require overtype
+            set col1 [string repeat " " [expr {$max + 3}]]
+            append result "[overtype::left "  " [a+ $c $got]] [format %3s $k]-> [overtype::left $col1 $greenanswer]" \n
+            incr k
+        }
+        return $result
+    } 
+
+    proc fraction_iteration {n} {
+            set numerator 1; set denominator 1
+            for {set i $n} {$i > 0} {incr i -1} {
+                set numerator   [expr {$numerator * $i}]
+                set denominator [expr {$denominator * (2 * $i + 1)}]
+                incr numerator $denominator
+            }
+            return [list [expr {$numerator * 2}] $denominator] 
+    }
+    proc fraction_iteration_test {max} {
+        variable pifrac
+        set pi 3.$pifrac
+        set k 0 
+        set result ""
+        set last_lcplen 0 
+        set got ""
+        package require math::bigfloat
+        while {$k <= $max} {
+            set s [fraction_iteration $k]
+            lassign $s a b
+            #set answer [expr {$a / double($b)}] ;limited range
+            set bigfloat [math::bigfloat::div [math::bigfloat::int2float $a] [math::bigfloat::int2float $b]]
+            set answer [math::bigfloat::tostr $bigfloat]
+
+
+            set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] 
+            set lcplen [string length $lcp]
+            if {$lcplen > $last_lcplen} {
+                set last_lcplen $lcplen
+                set got [string index $lcp end]
+                set c red
+            } else {
+                set c yellow
+            }
+
+            set tail [string range $answer $lcplen end]
+            set greenanswer  [a+ green]$lcp[a]$tail
+            #math::numtheory::gcd
+            #set gcd  [punk::lib::gcd {*}$s]
+            #if {$gcd > 1} {
+            #    set a [expr {$a/$gcd}]
+            #    set b [expr {$b/$gcd}]
+            #}
+
+            set ax [string map [list $got [a+ $c]$got[a]] $a]
+            set bx [string map [list $got [a+ $c]$got[a]] $b]
+            set m [expr {$a % $b}]
+            set mx [string map [list $got [a+ $c]$got[a]] $m]
+            
+            package require overtype
+            set sp40 [string repeat " " 40]
+            set sp60 [string repeat " " 60]
+            append result "[format %1s $got] [format %3s $k]-> [overtype::left $sp40 $greenanswer] [overtype::left $sp60 $ax] [overtype::left $sp60 $bx] [overtype::left $sp60 $mx]" \n
+            incr k
+        }
+        return $result
+    } 
+
+    #an experiment 
+    proc slow_approx {{m 1000}} {
+        set pi 0
+        set d [expr {1.0}]
+        for {set i 1} {$i <= $m} {incr i} {
+            set a   [expr {2 * ($i % 2) - 1}]
+            set pi  [expr {$pi + ($a * 4 / $d)}]
+            set d   [expr {$d + 2.0}]
+        }
+        return $pi
+    }
+
+
+
+
+
+
+    #*** !doctools
+    #[list_end] [comment {--- end definitions namespace picalc ---}]
+}
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# Secondary API namespace
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+tcl::namespace::eval picalc::lib {
+    tcl::namespace::export {[a-z]*}  ;# Convention: export all lowercase
+    tcl::namespace::path [tcl::namespace::parent]
+    #*** !doctools
+    #[subsection {Namespace picalc::lib}]
+    #[para] Secondary functions that are part of the API 
+    #[list_begin definitions]
+
+    #proc utility1 {p1 args} {
+    #    #*** !doctools
+    #    #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
+    #    #[para]Description of utility1 
+    #    return 1 
+    #}
+
+
+
+    #*** !doctools
+    #[list_end] [comment {--- end definitions namespace picalc::lib ---}]
+}
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[section Internal]
+#tcl::namespace::eval picalc::system {
+    #*** !doctools
+    #[subsection {Namespace picalc::system}]
+    #[para] Internal functions that are not part of the API
+
+
+
+#}
+
+
+# == === === === === === === === === === === === === === ===
+# Sample 'about' function with punk::args documentation
+# == === === === === === === === === === === === === === ===
+tcl::namespace::eval picalc {
+    tcl::namespace::export {[a-z]*}  ;# Convention: export all lowercase
+    variable PUNKARGS
+    variable PUNKARGS_aliases
+
+    lappend PUNKARGS [list {
+            @id     -id "(package)picalc"
+            @package    -name "picalc" -help\
+            "Package 
+            Description"
+        }]
+
+    namespace eval argdoc {
+        #namespace for custom argument documentation
+        proc package_name {} {
+            return picalc
+        }
+        proc about_topics {} {
+            #info commands results are returned in an arbitrary order (like array keys)
+            set topic_funs [info commands [namespace current]::get_topic_*]
+            set about_topics [list]
+            foreach f $topic_funs {
+                set tail [namespace tail $f]
+                lappend about_topics [string range $tail [string length get_topic_] end]
+            }
+            #Adjust this function or 'default_topics' if a different order is required
+            return [lsort $about_topics]
+        }
+        proc default_topics {} {return [list Description *]}
+
+        # -------------------------------------------------------------
+        # get_topic_ functions add more to auto-include in about topics
+        # -------------------------------------------------------------
+        proc get_topic_Description {} {
+             punk::args::lib::tstr [string trim {
+                package picalc
+                experiments in calculating pi in Tcl
+            } \n]
+        }
+        proc get_topic_License {} {
+            return "MIT"
+        }
+        proc get_topic_Version {} {
+            return "$::picalc::version"
+        }
+        proc get_topic_Contributors {} {
+            set authors {<unspecified>}
+            set contributors ""
+            foreach a $authors {
+                append contributors $a \n
+            }
+            if {[string index $contributors end] eq "\n"} {
+                set contributors [string range $contributors 0 end-1]
+            }
+            return $contributors
+        }
+        proc get_topic_notes {} {
+            punk::args::lib::tstr -return string {
+                A playground for evaluating performance and testing methods to calculate
+                the digits pi in Tcl.
+
+                A precalculated value of enough precision for almost any 
+                usecase is available at $::math::constants::pi after loading
+                the math::constants package.
+
+                Note that this package is focused on calculating the digits of pi so
+                there is no rounding of the final digit.
+
+                For large values of pi using the mathematical concept of 'precision'
+                rather than decimal places - consider math::bigfloat::pi
+            }
+        }
+        # -------------------------------------------------------------
+    }
+
+    # we re-use the argument definition from punk::args::standard_about and override some items
+    set overrides [dict create]
+    dict set overrides @id  -id   "::picalc::about"
+    dict set overrides @cmd -name "picalc::about"
+    dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
+                            Experiments in calculating the digits of pi
+                            }] \n]
+    dict set overrides topic -choices           [list {*}[picalc::argdoc::about_topics] *]
+    dict set overrides topic -choicerestricted  1
+    dict set overrides topic -default [picalc::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
+    set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
+    lappend PUNKARGS [list $newdef]
+    proc about {args} {
+        package require punk::args
+        #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
+        set argd [punk::args::parse $args withid ::picalc::about]
+        lassign [dict values $argd] _leaders opts values _received
+        punk::args::package::standard_about -package_about_namespace ::picalc::argdoc {*}$opts {*}[dict get $values topic]
+    }
+}
+# end of sample 'about' function
+# == === === === === === === === === === === === === === ===
+
+
+# -----------------------------------------------------------------------------
+#    register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
+# -----------------------------------------------------------------------------
+#    variable PUNKARGS
+#    variable PUNKARGS_aliases
+namespace eval ::punk::args::register {
+    #use fully qualified so 8.6 doesn't find existing var in global namespace
+    lappend ::punk::args::register::NAMESPACES ::picalc
+}
+# -----------------------------------------------------------------------------
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Ready
+package provide picalc [tcl::namespace::eval picalc {
+    variable pkg picalc
+    variable version
+    set version 999999.0a1.0
+}]
+return
+
+#*** !doctools
+#[manpage_end]
+
diff --git a/src/modules/picalc-buildversion.txt b/src/modules/picalc-buildversion.txt
new file mode 100644
index 00000000..f47d01c8
--- /dev/null
+++ b/src/modules/picalc-buildversion.txt
@@ -0,0 +1,3 @@
+0.1.0
+#First line must be a semantic version number
+#all other lines are ignored.
diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm
index d5af1000..a22fc051 100644
--- a/src/modules/punk/lib-999999.0a1.0.tm
+++ b/src/modules/punk/lib-999999.0a1.0.tm
@@ -3958,8 +3958,12 @@ tcl::namespace::eval punk::lib::flatgrid {
     }
 }
 
+tcl::namespace::eval punk::lib::test {
 
 
+
+}
+
 # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
 #todo - way to generate 'internal' docs separately?
 #*** !doctools