Index: openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl,v diff -u -r1.10.2.10 -r1.10.2.11 --- openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl 1 Mar 2023 14:21:54 -0000 1.10.2.10 +++ openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl 1 Mar 2023 14:24:17 -0000 1.10.2.11 @@ -3,21 +3,38 @@ ad_library { Functional Programming in Tcl? - Absolutely! -

+ This library adds the expressive power of functional languages like LISP, Gofer or Haskell to the Tcl language! -

+ If you don't know what functional programming is, here's a good place to start:

+ A general naming convention in this file is: -

- f = a function
- x = an element
+ f = a function + x = an element xs = a list of elements + This library was completely rewritten on July 18, 2000. The + design is now much cleaner. Constructed functions are no longer + represented by strings, but by real (callable) function + objects. The auxiliary functions eval_unary and eval_binary are + gone. + + Special thanks go to Sarah Arnold and Carsten Clasohm for + extensive testing of this library and using it in the Sharenet + project. Also many thanks to Branimir Dolicki for inventing the + lambda function and to Archit Shah for finding a simple way to + eliminate its memory leak. + This was part of ACS 3. Added to OpenACS by bdolicki on 11 Feb 2004: I just converted @@ -32,46 +49,36 @@ namespace eval ::f { -# This library was completely rewritten on July 18, 2000. -# The design is now much cleaner. Constructed functions -# are no longer represented by strings, but by real -# (callable) function objects. The auxiliary functions -# eval_unary and eval_binary are gone. - -# Special thanks go to Sarah Arnold and Carsten Clasohm for extensive -# testing of this library and using it in the Sharenet project. -# Also many thanks to Branimir Dolicki for inventing the lambda function -# and to Archit Shah for finding a simple way to eliminate its memory leak. - # -------------------------------------------------------------------------------- # Lambda # -------------------------------------------------------------------------------- -ad_proc -public -deprecated lambda {args body} { - The lambda function - one of the foundations of functional programming - - defines an anonymous proc and returns it. This is useful if you quickly - need an auxiliary function for a small task. -

Examples

- -

Note

- Although lambda defines a proc and therefore consumes memory, executing - the same lambda expression twice will just re-define this proc. - Thus, there is no memory leak, if you have a lambda inside a loop. - DEPRECATED: As of tcl8.5, Tcl has native support for 'lambda' provided by - means of 'apply' per TIP 194. Tcllib provides a 'lambda' package - with procs that make use of it. + Note: + Although lambda defines a proc and therefore consumes memory, + executing the same lambda expression twice will just re-define + this proc. Thus, there is no memory leak, if you have a lambda + inside a loop. - @see https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm + @return a proc name } { # # To make the lambda proc universally accessible, we need to @@ -85,26 +92,13 @@ return $name } -# I know, I know - it looks sooo harmless. But it unleashes the real power of Tcl. -# It defines a proc with name "args.body" (weird, but unique name) that takes "args" -# as arguments and has the body "body". Then, this proc is returned. - -# Example: -# [lambda {x} {expr $x*$x}] 5 = 25 - # -------------------------------------------------------------------------------- # binding values to arguments of a function # -------------------------------------------------------------------------------- -ad_proc -deprecated bind {f args} { - binds args to the first k arguments of the n-ary function f - and returns the resulting (n-k)-ary function - - DEPRECATED: As of tcl8.5, Tcl has native support for 'lambda' provided by - means of 'apply' per TIP 194. Tcllib provides a 'lambda' package - with procs that make use of it. - - @see https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm +ad_proc -public bind {f args} { + Binds args to the first k arguments of the n-ary function f and + returns the resulting (n-k)-ary function. } { set i 0 foreach arg $args { @@ -117,14 +111,8 @@ lambda [lrange $proc_args [llength $args] $num_proc_args] $code } -ad_proc -deprecated bind2nd {f arg} { - binds arg to the 2nd argument of f - - DEPRECATED: As of tcl8.5, Tcl has native support for 'lambda' provided by - means of 'apply' per TIP 194. Tcllib provides a 'lambda' package - with procs that make use of it. - - @see https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm +ad_proc -public bind2nd {f arg} { + Binds arg to the 2nd argument of f. } { set code "set [lindex [info args $f] 1] {$arg}\n" append code [info body $f] @@ -154,27 +142,22 @@ # map # -------------------------------------------------------------------------------- -ad_proc -deprecated map {f xs} { - Takes a function f and a list { x1 x2 x3 ...}, - applies the function on each element of the list - and returns the result, i.e. { f x1, f x2, f x3, ...}. -

Examples

+ad_proc -public map {f xs} { + + Takes a function f and a list { x1 x2 x3 ...}, applies the + function on each element of the list and returns the result, + i.e. { f x1, f x2, f x3, ...}. + + Examples: (fib = fibonacci function, sqr = square function) - - DEPRECATED: this proc is superseded by the Tcl command lmap, - available since Tcl 8.6. + Applying a function to each element of a list: + f::map fib [list 0 1 2 3 4 5 6 7 8] = {0 1 1 2 3 5 8 13 21} - @see lmap + Applying a function to each element of a matrix (a list of lists) + can be done with a nested call: + f::map [f::lambda {row} {f::map sqr $row}] [list [list 1 2 3] [list 4 5 6]] = {{1 4 9} {16 25 36}} + } { set result {} foreach x $xs { @@ -188,17 +171,12 @@ # -------------------------------------------------------------------------------- ad_proc -public fold {f e xs} { - Takes a binary function f, a start element e and a list {x1 x2 ...} - and returns f (...(f (f (f e x1) x2) x3)...). -

Examples

- + Takes a binary function f, a start element e and a list {x1 x2 + ...} and returns f (...(f (f (f e x1) x2) x3)...). + + Examples: + f::fold + 0 [list 1 2 3 4] = 10 + f::fold * 1 [list 1 2 3 4] = 24 } { set result $e foreach x $xs { @@ -208,20 +186,18 @@ } ad_proc -public fold1 {f xs} { - Takes a binary function f and a list {x1 x2 x3 ...} - and returns (...(f (f (f x1 x2) x3) x4)...). -

+ Takes a binary function f and a list {x1 x2 x3 ...} and returns + (...(f (f (f x1 x2) x3) x4)...). + "fold1" behaves like "fold", but does not take a start element and does not work for empty lists. -

Examples

- + + Examples: + f::fold1 min [list 3 1 4 1 5 9 2 6] = 1 + + f::fold1 max [list 3 1 4 1 5 9 2 6] = 9 + + @see fold1 } { if { [null_p $xs] } { error "ERROR: fold1 is undefined for empty lists." @@ -234,8 +210,14 @@ # scanl # -------------------------------------------------------------------------------- -ad_proc -public scanl {f e xs} "takes a binary function f, a start element e and a list {x1 x2 ...} - and returns {e (f e x1) (f (f e x1) x2) ...}" { +ad_proc -public scanl {f e xs} { + Takes a binary function f, a start element e and a list {x1 x2 + ...} and returns {e (f e x1) (f (f e x1) x2) ...}. + + Example: + scanl + 0 [list 1 2 3 4] = {0 1 3 6 10} + scanl * 1 [list 1 2 3 4] = {1 1 2 6 24} +} { set current_element $e set result [list $e] foreach x $xs { @@ -245,42 +227,55 @@ return $result } -# Example: -# scanl + 0 [list 1 2 3 4] = {0 1 3 6 10} -# scanl * 1 [list 1 2 3 4] = {1 1 2 6 24} +ad_proc -public scanl1 {f xs} { + Takes a binary function f and a list {x1 x2 x3 ...} and returns + {x1 (f x1 x2) (f (f x1 x2) x3) ...}. -ad_proc -public scanl1 {f xs} "takes a binary function f and a list {x1 x2 x3 ...} - and returns {x1 (f x1 x2) (f (f x1 x2) x3) ...}" { + "scanl1" behaves like "scanl", but does not take a start element + and does not work for empty lists. + + Examples: + scanl1 min [list 3 1 4 1 5 9 2 6] = {3 1 1 1 1 1 1 1} + + scanl1 max [list 3 1 4 1 5 9 2 6] = {3 3 4 4 5 9 9 9} + + @see scanl +} { if { [null_p $xs] } { error "ERROR: scanl1 is undefined for empty lists." } else { scanl $f [head $xs] [tail $xs] } } -# "scanl1" behaves like "scanl", but does not take a start element and -# does not work for empty lists. -# -# Example: -# scanl1 min [list 3 1 4 1 5 9 2 6] = {3 1 1 1 1 1 1 1} -# scanl1 max [list 3 1 4 1 5 9 2 6] = {3 3 4 4 5 9 9 9} - # -------------------------------------------------------------------------------- # Standard combinators # -------------------------------------------------------------------------------- ad_proc -public id {x} { Identity function: just returns its argument. -

- I'm not kidding! An identity function can be useful sometimes, e.g. - as a default initializer for optional arguments of functional kind. + + I'm not kidding! An identity function can be useful sometimes, + e.g. as a default initializer for optional arguments of + functional kind. } { return $x } # Example application of id function: -ad_proc -public qsort {xs {value id}} "sorts a sequence with the quicksort algorithm" { +ad_proc -public qsort { + xs + {value id} +} { + Sorts a sequence with the quicksort algorithm. + + Examples: + f::qsort {5 2 9 4} = 2 4 5 9 + + f::qsort {Oracle ArsDigita SAP Vignette} [lambda {s} {string + length $s}] = {SAP Oracle Vignette ArsDigita} +} { if { [llength $xs]<2 } { return $xs } set pivot [head $xs] set big_elmts {} @@ -295,23 +290,14 @@ concat [qsort $small_elmts $value] [list $pivot] [qsort $big_elmts $value] } -# % qsort {5 2 9 4} -# 2 4 5 9 -# % qsort {Oracle ArsDigita SAP Vignette} [lambda {s} {string length $s}] -# SAP Oracle Vignette ArsDigita +ad_proc -public const {k} { -ad_proc -deprecated const {k} { - Returns a unary function that ignores its argument and constantly returns k. -

Example

- + Returns a unary function that ignores its argument and constantly + returns k. - DEPRECATED: As of tcl8.5, Tcl has native support for 'lambda' provided by - means of 'apply' per TIP 194. Tcllib provides a 'lambda' package - with procs that make use of it. + Example: + f::map [f::const 7] [list 1 2 3 4 5] = {7 7 7 7 7} - @see https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm } { lambda {x} [list return $k] } @@ -324,14 +310,13 @@ } ad_proc -public uncurry {f tuple} { - Converts a function that takes a series of single arguments - into a function that takes one tuple as an argument. -

Example

- + Converts a function that takes a series of single arguments into a + function that takes one tuple as an argument. + + Example: + f::min 3 5 = 3 + f::min {3 5} = error (because min expects two arguments) + f::uncurry min {3 5} = 3 } { uplevel [list eval "$f $tuple"] } @@ -342,15 +327,21 @@ # {{3 1} {4 1} {5 9} {2 6}} into {1 1 5 2} (each tuple is replaced # by the minimum of its two components). -ad_proc -public fst {xs} "returns the first element of a list" { +ad_proc -private fst {xs} { + @return the first element of a list +} { lindex $xs 0 } -ad_proc -public snd {xs} "returns the second element of a list" { +ad_proc -private snd {xs} { + @return the second element of a list +} { lindex $xs 1 } -ad_proc -public thd {xs} "returns the third element of a list" { +ad_proc -private thd {xs} { + @return the third element of a list +} { lindex $xs 2 } @@ -360,14 +351,16 @@ # set last_names [map snd $people] # set emails [map thd $people] -ad_proc -public flip {f a b} "takes a binary function 'f' and two arguments 'a' and 'b' - and returns f b a (arguments are flipped)" { +ad_proc -public flip {f a b} { + Takes a binary function 'f' and two arguments 'a' and 'b' and + returns f b a (arguments are flipped). + + Example: + flip lindex 0 {42 37 59 14} = 42 +} { $f $b $a } -# Example: -# flip lindex 0 {42 37 59 14} = 42 - # Exercise 2 # ---------- # Using "fold", "map", "flip" and "lindex", @@ -380,25 +373,32 @@ # First try to extract the list {1 5 7 8} using "map", "flip" and "lindex", # then reduce it to 21 using "fold". -ad_proc -public compose {f g x} "function composition: evaluates f (g x)" { - $f [$g $x] -} +ad_proc -public compose {f g x} { + function composition: evaluates f (g x) -# Example: -# map [bind compose sqr [bind + 7]] {1 2 3 4 5} = {64 81 100 121 144} + Example: + f::map [f::bind compose sqr [f::bind + 7]] {1 2 3 4 5} = {64 81 100 121 144} -# Algebraic Property: -# map [bind compose f g] $xs = map f [map g $xs] + Algebraic Property: + f::map [f::bind f::compose f g] $xs = f::map f [f::map g $xs] +} { + $f [$g $x] +} + # -------------------------------------------------------------------------------- # Standard numerical functions # -------------------------------------------------------------------------------- -ad_proc -public abs {x} "returns the absolute value of x" { +ad_proc -public abs {x} { + @return the absolute value of x +} { expr {$x<0 ? -$x : $x} } -ad_proc -public gcd {x y} "returns the greatest common divisor of x and y" { +ad_proc -public gcd {x y} { + @return the greatest common divisor of x and y +} { gcd' [abs $x] [abs $y] } @@ -407,133 +407,182 @@ gcd' $y [expr {$x%$y}] } -ad_proc -public lcm {x y} "returns the least common multiple of x and y" { +ad_proc -public lcm {x y} { + @return the least common multiple of x and y +} { if { $x==0} { return 0 } if { $y==0} { return 0 } abs [expr {$x/[gcd $x $y]*$y}] } -ad_proc -public odd_p {n} "returns 1 if n is odd and 0 otherwise" { +ad_proc -public odd_p {n} { + @return 1 if n is odd and 0 otherwise +} { expr {$n%2} } -ad_proc -public even_p {n} "returns 1 if n is even and 0 otherwise" { +ad_proc -public even_p {n} { + @return 1 if n is even and 0 otherwise +} { expr {1-$n%2} } -ad_proc -public min {x y} "returns the minimum of x and y" { +ad_proc -public min {x y} { + @return the minimum of x and y +} { expr {$x<$y ? $x : $y} } -ad_proc -public max {x y} "returns the maximum of x and y" { +ad_proc -public max {x y} { + @return the maximum of x and y +} { expr {$x>$y ? $x : $y} } # -------------------------------------------------------------------------------- # List Aggregate Functions # -------------------------------------------------------------------------------- -ad_proc -public and {xs} "reduces a list of boolean values using &&" { +ad_proc -public and {xs} { + Reduces a list of boolean values using && + + Examples: + f::and {1 1 0 1} = 0 + + f::and {1 1 1 1} = 1 + + @return boolean +} { fold && 1 $xs } -# Example -# and {1 1 0 1} = 0 -# and {1 1 1 1} = 1 +ad_proc -public or {xs} { + Reduces a list of boolean values using || -ad_proc -public or {xs} "reduces a list of boolean values using ||" { + Example: + f::or {1 1 0 1} = 1 + f::or {0 0 0 0} = 0 + + @return boolean +} { fold || 0 $xs } -# Example -# or {1 1 0 1} = 1 -# or {0 0 0 0} = 0 - ad_proc -public all {pred xs} { - Takes a predicate pred and a list xs and returns 1 - if all elements of xs fulfill pred. -

Examples

- + + Takes a predicate pred and a list xs and returns 1 if all elements + of xs fulfill pred. + + Examples: + f::all f::even_p {2 44 64 80 10} = 1 + + f::all f::even_p {2 44 65 80 10} = 0 + + @return boolean } { and [map $pred $xs] } -ad_proc -public any {pred xs} "takes a predicate pred and a list xs and returns 1 - if there exists an element of xs that fulfills pred" { +ad_proc -public any {pred xs} { + + Takes a predicate pred and a list xs and returns 1 if there exists + an element of xs that fulfills pred. + + Examples: + f::any f::odd_p {2 44 64 80 10} = 0 + + f::any odd_p {2 44 65 80 10} = 1 + + @return boolean +} { or [map $pred $xs] } -# Example: -# any odd_p {2 44 64 80 10} = 0 -# any odd_p {2 44 65 80 10} = 1 - -ad_proc -public lmin {xs} "returns the minimum element of the list xs" { +ad_proc -public lmin {xs} { + @return the minimum element of the list xs +} { fold1 min $xs } -ad_proc -public lmax {xs} "returns the maximum element of the list xs" { +ad_proc -public lmax {xs} { + @return the maximum element of the list xs +} { fold1 max $xs } -ad_proc -public sum {xs} "returns the sum of the elements of the list xs" { +ad_proc -public sum {xs} { + @return the sum of the elements of the list xs +} { fold + 0 $xs } -ad_proc -public product {xs} "returns the product of the elements of the list xs" { +ad_proc -public product {xs} { + @return the product of the elements of the list xs +} { fold * 1 $xs } -ad_proc -public sums {xs} "returns the list of partial sums of the list xs" { +ad_proc -public sums {xs} { + @return the list of partial sums of the list xs +} { scanl + 0 $xs } -ad_proc -public products {xs} "returns the list of partial products of the list xs" { +ad_proc -public products {xs} { + @return the list of partial products of the list xs +} { scanl * 1 $xs } # -------------------------------------------------------------------------------- # Standard list processing functions # -------------------------------------------------------------------------------- -ad_proc -public head {xs} "first element of a list" { +ad_proc -public head {xs} { + @return first element of a list +} { lindex $xs 0 } -ad_proc -public last {xs} "last element of a list" { +ad_proc -public last {xs} { + @return last element of a list +} { lindex $xs [expr {[llength $xs]-1}] } -ad_proc -public init {xs} "all elements of a list but the last" { +ad_proc -public init {xs} { + @return all elements of a list but the last +} { lrange $xs 0 [expr {[llength $xs]-2}] } -ad_proc -public tail {xs} "all elements of a list but the first" { +ad_proc -public tail {xs} { + @return all elements of a list but the first +} { lrange $xs 1 [expr {[llength $xs]-1}] } -ad_proc -public take {n xs} "returns the first n elements of xs" { +ad_proc -public take {n xs} { + @return the first n elements of xs +} { lrange $xs 0 [expr {$n-1}] } -ad_proc -public drop {n xs} "returns the remaining elements of xs (without the first n)" { +ad_proc -public drop {n xs} { + @return the remaining elements of xs (without the first n) +} { lrange $xs $n [expr {[llength $xs]-1}] } ad_proc -public filter {pred xs} { - Returns all elements of the list xs that fulfill the predicate pred. -

Examples

- + + Examples: + f::filter f::even_p {3 1 4 1 5 9 2 6} = {4 2 6} + + f::filter [f::lambda {x} {expr $x>500}] {317 826 912 318} = {826 912} + + @return all elements of the list 'xs' that fulfill the predicate + 'pred'. } { set result {} foreach x $xs { @@ -544,48 +593,64 @@ return $result } -ad_proc -public copy {n x} "returns list of n copies of x" { +ad_proc -public copy {n x} { + Example: + f::copy 10 7 = {7 7 7 7 7 7 7 7 7 7} + + @return list of n copies of x +} { set result {} for {set i 0} {$i<$n} {incr i} { lappend result $x } return $result } -# Example: -# copy 10 7 = {7 7 7 7 7 7 7 7 7 7} +ad_proc -public cycle {n xs} { + Example: + f::cycle 4 {1 2 3} = {1 2 3 1 2 3 1 2 3 1 2 3} -ad_proc -public cycle {n xs} "returns concatenated list of n copies of xs" { + @return concatenated list of n copies of xs +} { set result {} for {set i 0} {$i<$n} {incr i} { lappend result {*}$xs } return $result } -# Example: -# cycle 4 {1 2 3} = {1 2 3 1 2 3 1 2 3 1 2 3} +ad_proc -public cons {x xs} { + Inserts x at the front of the list xs. -ad_proc -public cons {x xs} "inserts x at the front of the list xs" { + @return list +} { concat [list $x] $xs } -ad_proc -deprecated -public reverse {xs} { - reverses the list xs. +ad_proc -deprecated reverse {xs} { + Reverses the list xs. Tcl has a built-in support for reversing lists: "lreverse". - Use this instead. + Use this instead. @see lreverse } { - fold [bind flip cons] {} $xs + f::fold [f::bind f::flip f::cons] {} $xs } -ad_proc -public elem_p {x xs} "checks if x is contained in s" { +ad_proc -public elem_p {x xs} { + Checks if x is contained in s. + + @return boolean +} { expr {[lsearch $xs $x]==-1 ? 0 : 1} } -ad_proc -public not_elem_p {x xs} "checks if x is not contained in s" { +ad_proc -public not_elem_p {x xs} { + Checks if x is not contained in s. + + @return boolean +} { expr {[lsearch $xs $x]==-1 ? 1 : 0} } @@ -599,11 +664,19 @@ return $result } -ad_proc -public null_p {xs} "checks if xs is the empty list" { +ad_proc -public null_p {xs} { + Checks if xs is the empty list. + + @return boolean +} { expr {[llength $xs]==0} } -ad_proc -public enum_from_to {lo hi} "generates {lo lo+1 ... hi-1 hi}" { +ad_proc -public enum_from_to {lo hi} { + Generates {lo lo+1 ... hi-1 hi} + + @return list +} { set result {} for {set i $lo} {$i<=$hi} {incr i} { lappend result $i @@ -615,22 +688,36 @@ # zip and zip_with functions # -------------------------------------------------------------------------------- -ad_proc -public zip {args} "takes two lists {x1 x2 x3 ...} and {y1 y2 y3 ...} and - returns a list of tuples {x1 y1} {x2 y2} {x3 y3} ... - Works analogously with 3 or more lists." { +ad_proc -public zip {args} { + Takes two lists {x1 x2 x3 ...} and {y1 y2 y3 ...} and returns a + list of tuples {x1 y1} {x2 y2} {x3 y3} ... + + Works analogously with 3 or more lists. + + Example: + % set first_names {Nicole Tom} + % set last_names {Kidman Cruise} + + f::zip $first_names $last_names = {{Nicole Kidman} {Tom Cruise}} + + f::map [f::bind f::flip join _] [f::zip $first_names $last_names] + = Nicole_Kidman Tom_Cruise +} { transpose $args } -# Example: -# % set first_names {Nicole Tom} -# % set last_names {Kidman Cruise} -# % zip $first_names $last_names -# {Nicole Kidman} {Tom Cruise} -# % map [bind flip join _] [zip $first_names $last_names] -# Nicole_Kidman Tom_Cruise +ad_proc -public zip_with {f xs ys} { + Takes two lists {x1 x2 x3 ...} and {y1 y2 y3 ...} and returns the + list {(f x1 y1) (f x2 y2) (f x3 y3) ...} -ad_proc -public zip_with {f xs ys} "takes two lists {x1 x2 x3 ...} and {y1 y2 y3 ...} and - returns the list {(f x1 y1) (f x2 y2) (f x3 y3) ...}" { + Example: + % set first_names {Sandra Catherine Nicole} + % set last_names {Bullock Zeta-Jones Kidman} + + f::zip_with [f::lambda {f l} {return "$f $l"}] $first_names + $last_names = {{Sandra Bullock} {Catherine Zeta-Jones} {Nicole Kidman}} + +} { set result {} foreach x $xs y $ys { if { !([null_p $x] || [null_p $y]) } { @@ -640,14 +727,9 @@ return $result } -# Example: -# % set first_names {Sandra Catherine Nicole} -# % set last_names {Bullock Zeta-Jones Kidman} -# % zip_with [lambda {f l} {return "$f $l"}] $first_names $last_names -# "Sandra Bullock" "Catherine Zeta-Jones" "Nicole Kidman" - - -ad_proc -public transpose {lists} "transposes a matrix (a list of lists)" { +ad_proc -public transpose {lists} { + Transposes a matrix (a list of lists) +} { set num_lists [llength $lists] if {!$num_lists} { return "" } for {set i 0} {$i<$num_lists} {incr i} { @@ -675,13 +757,15 @@ # -------------------------------------------------------------------------------- ad_proc -public iterate {n f x} { - Returns {x (f x) (f (f x) (f (f (f x))) ...}. -

Examples

- + + Examples: + f::iterate 10 [f::lambda {x} {expr $x+1}] 5 = {5 6 7 8 9 10 11 12 13 14} + + f::iterate 10 [f::lambda {x} {expr $x*2}] 1 = {1 2 4 8 16 32 64 128 256 512} + + f::iterate 4 f::tail {1 2 3 4 5} = {{1 2 3 4 5} {2 3 4 5} {3 4 5} {4 5}} + + @return {x (f x) (f (f x) (f (f (f x))) ...}}. } { set result {} for {set i 0} {$i<$n} {incr i} { @@ -691,8 +775,15 @@ return $result } -ad_proc -public unzip {xs} "unzip takes a list of tuples {x1 y1} {x2 y2} {x3 y3} ... and - returns a tuple of lists {x1 x2 x3 ...} {y1 y2 y3 ...}." { +ad_proc -public unzip {xs} { + + Unzip takes a list of tuples {x1 y1} {x2 y2} {x3 y3} ... and + returns a tuple of lists {x1 x2 x3 ...} {y1 y2 y3 ...}. + + It is just a special case of the function "transpose" and is here + just for completeness. + +} { set left {} set right {} foreach x $xs { @@ -703,32 +794,23 @@ return [list $left $right] } -# "unzip" is just a special case of the function "transpose" -# and is here just for completeness. - # -------------------------------------------------------------------------------- # List breaking functions: To gain a real advantage from using these functions, # you would actually need a language that has "lazy evaluation" (like Haskell). # In Tcl they can be useful too, but they are not as powerful. -# -# split_at n xs = (take n xs, drop n xs) -# -# take_while p xs returns the longest initial segment of xs whose -# elements satisfy p -# drop_while p xs returns the remaining portion of the list -# span p xs = (takeWhile p xs, dropWhile p xs) -# -# take_until p xs returns the list of elements up to and including the -# first element of xs which satisfies p -# # -------------------------------------------------------------------------------- -ad_proc -public split_at {n xs} "splits a list using take and drop" { +ad_proc -public split_at {n xs} { + Splits a list using take and drop. + + Usage: split_at n xs = (take n xs, drop n xs) +} { list [take $n $xs] [drop $n $xs] } -ad_proc -public take_while {p xs} "returns the longest initial segment of xs whose - elements satisfy p" { +ad_proc -public take_while {p xs} { + @return the longest initial segment of xs whose elements satisfy p +} { set index 0 foreach x $xs { if { ![$p $x] } { break } @@ -737,7 +819,9 @@ take $index $xs } -ad_proc -public drop_while {p xs} "returns the remaining portion of the list" { +ad_proc -public drop_while {p xs} { + @return the remaining portion of the list +} { set index 0 foreach x $xs { if { ![$p $x] } { break } @@ -746,12 +830,18 @@ drop $index $xs } -ad_proc -public span {p xs} "splits a list using take_while and drop_while" { +ad_proc -public span {p xs} { + Splits a list using take_while and drop_while. + + Usage span p xs = (takeWhile p xs, dropWhile p xs) +} { list [take_while $p $xs] [drop_while $p $xs] } -ad_proc -public take_until {p xs} "returns the list of elements up to and including the - first element of xs which satisfies p" { +ad_proc -public take_until {p xs} { + @return the list of elements up to and including the first element + of xs which satisfies p +} { set index 0 foreach x $xs { incr index @@ -765,46 +855,41 @@ # -------------------------------------------------------------------------------- ad_proc -public factorial {n} { - compute n! + Compute n! } { product [enum_from_to 1 $n] } -ad_proc -public mul {n fraction} "multiplies n with a fraction (given as a tuple)" { +ad_proc -public mul {n fraction} { + Multiplies n with a fraction (given as a tuple) +} { set num [fst $fraction] set denom [snd $fraction] set g [gcd $n $denom] expr {($n/$g)*$num/($denom/$g)} } -ad_proc -deprecated choose {n k} { +ad_proc -public choose {n k} { Here's how to compute 'n choose k' like a real nerd. - - DEPRECATED: As of tcl8.5, Tcl has native support for 'lambda' provided by - means of 'apply' per TIP 194. Tcllib provides a 'lambda' package - with procs that make use of it. - - @see https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm } { fold mul 1 [transpose [list [iterate $k [bind flip - 1] $n] [enum_from_to 1 $k]]] } -ad_proc -deprecated pascal {size} { - prints Pascal's triangle - - DEPRECATED: As of tcl8.5, Tcl has native support for 'lambda' provided by - means of 'apply' per TIP 194. Tcllib provides a 'lambda' package - with procs that make use of it. - - @see https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm +ad_proc -public pascal {size} { + Prints Pascal's triangle } { for {set n 0} {$n<=$size} {incr n} { puts [map [bind choose $n] [enum_from_to 0 $n]] } } ad_proc -public prime_p {n} { - @return 1 if n is prime + + Example: + f::filter f::prime_p [f::enum_from_to 1 100] = {2 3 5 7 11 13 17 + 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97} + + @return boolean, 1 if n is prime } { if { $n<2 } { return 0 } if { $n==2 } { return 1 } @@ -815,9 +900,6 @@ return 1 } -# % filter prime_p [enum_from_to 1 100] -# 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 - proc multiplication_table {x} { # This is an extreme example for test purposes only. # This way of programming is not recommended. Kids: do not try this at home. @@ -832,7 +914,7 @@ # -------------------------------------------------------------------------------- # http://www.haskell.org/aboutHaskell.html -# http://www.md.chalmers.se/~rjmh/Papers/whyfp.html +# https://www.cse.chalmers.se/~rjmh/Papers/whyfp.pdf namespace export *