Useful Examples of Functional Tcl

This work is based on an original article called "15 Useful JS Examples of map(), reduce() and filter()" (https://medium.com/@alex.permyakov/15-useful-javascript-examples-of-map-reduce-and-filter-74cbbb5e0a1f ) by Alex Permyakov, 2019-1-16.

Requirements

1. The examples on this page use the following libraries:

2. And the following assert procedure:

proc assert {args} {
  if {! [uplevel 1 expr $args]} {
    puts "FAIL -> $args"
  } else {
    puts "ok   -> [list [lindex $args end]]"
  }
}

Examples

Example 1. Remove duplicates from an array of numbers/strings

set values {3 1 3 5 2 4 4 4}
::struct::set add uniques $values
assert {$uniques eq {4 1 5 2 3}}

Example 2. A simple search (case-sensitive)

set users {
  { id  11  name   Adam      age  23  group   editor }
  { id  47  name   John      age  28  group   admin  }
  { id  85  name   William   age  34  group   editor }
  { id  97  name   Oliver    age  28  group   admin  }
}
set res [::fptools::lfilter it $users {string match oli* [dict get $it name]}]
assert {$res eq {}}

Or in plain Tcl 8.6:

set res [lmap it $users {if {[string match oli* [dict get $it name]]} {set it} else continue}]
assert {$res eq {}}

Example 3. A simple search (case-insensitive)

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set res [::fptools::lfilter it $users {string match -nocase oli* [dict get $it name]}]
assert {[::struct::list equal $res {{id 97 name Oliver age 28 group admin}}]}

Or in plain Tcl 8.6:

set res [lmap it $users {if {[string match -nocase oli* [dict get $it name]]} {set it} else continue}]
assert {[::struct::list equal $res {{id 97 name Oliver age 28 group admin}}]}

Example 4. Check if any of the users have admin rights

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set hasAdmin [::fptools::lfilter it $users {string match admin [dict get $it group]}]
assert {[llength $hasAdmin]}

Or in plain Tcl 8.6:

set hasAdmin [lmap it $users {if {[string match admin [dict get $it group]]} {set it} else continue}]
assert {[llength $hasAdmin]}

Example 5. Flattening an array of arrays

set nested {{1 2 3} {{4 5} 6} {7 8 9}}
set flat [::fptools::lflatten $nested 2]  ;# 2 is the depth of flattening
assert {[::struct::list equal $flat {1 2 3 4 5 6 7 8 9}]}

Example 6. Create an object that contains the frequency of the specified key

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set groupByAge [::fptools::lreduce acc it [dict create] $users {
  dict incr acc [dict get $it age]
}]
assert {$groupByAge eq {23 1 28 2 34 1}}

Example 7. Indexing an array of objects (lookup table)

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set uTable [::fptools::lreduce acc it [dict create] $users {
  dict set acc [dict get $it id] $it
}]
assert {[::struct::list equal $uTable {
  11 { id 11 name Adam    age 23 group editor }
  47 { id 47 name John    age 28 group admin  }
  85 { id 85 name William age 34 group editor }
  97 { id 97 name Oliver  age 28 group admin  }
}]}

Example 8. Extract the unique values for the given key of each item in the array

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
lmap it $users {::struct::set add listOfUserGroups [dict get $it group]}
assert {$listOfUserGroups eq {admin editor}}

Example 9. Object key-value map reversal

set cities {
  Lyon   France
  Berlin Germany
  Paris  France
}
set countries  [::fptools::lreduce acc it [dict create] [dict keys $cities] {
  dict lappend acc [dict get $cities $it] $it
}]
assert {[::struct::list equal $countries {France {Lyon Paris} Germany {Berlin}}]}

Example 10. Create an array of Fahrenheit values from an array of Celsius values

set celsius {-15 -5 0 10 16 20 24 32}
set fahrenheit [lmap it $celsius {expr {$it * 1.8 + 32}}]
assert {$fahrenheit eq {5.0 23.0 32.0 50.0 60.8 68.0 75.2 89.6}}

Example 11. Encode an object into a query string

proc encodeURIComponent {elem} {return $elem}
set params {lat 45 lng 6 alt 1000}
set queryString [join [lmap {k v} $params {join [list [encodeURIComponent $k] [encodeURIComponent $v]] =}] &]
assert {$queryString eq "lat=45&lng=6&alt=1000"}

Example 12. Print a table of users as a readable string only with specified keys

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set output [join [lmap it $users {lmap key {id age group} {dict get $it $key}}] \n]
assert {$output eq
"11 23 editor
47 28 admin
85 34 editor
97 28 admin"}

Example 13. Find and replace key-value pair in an array of objects

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set updatedUsers [lmap it $users {expr {[dict get $it id] == 47 ? [dict incr it age] : $it}}]
assert {[dict get [lindex $updatedUsers 1] age] == 29}

Example 14. Union (A ∪ B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
set res [::struct::set union $arrA $arrB]
assert {[lsort $res] eq [lsort {1 4 3 2 5 6 7}]}

Example 15. Intersection (A ∩ B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[::struct::set intersect $arrA $arrB] eq {1 2}}

Example 16. Difference (A - B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[::struct::set difference $arrA $arrB] eq {4 3}}

Example 17. Difference (B - A) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[::struct::set difference $arrB $arrA] eq {5 6 7}}

Example 18. Symmetric Difference (A -- B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[lsort [::struct::set symdiff $arrA $arrB]] eq [lsort {4 5 6 7 3}]}

Example 19. Symmetric Difference (B -- A) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[lsort [::struct::set symdiff $arrB $arrA]] eq [lsort {4 5 6 7 3}]}

Code

#!/usr/bin/env tclsh

# Useful examples of Functional Tcl
# Barry Arthur, 2019-1-28

# Original Article: 15 Useful JS Examples of map(), reduce() and filter()
#                   https://medium.com/@alex.permyakov/15-useful-javascript-examples-of-map-reduce-and-filter-74cbbb5e0a1f
#                   by Alex Permyakov, 2019-1-16.

package require struct::set
package require struct::list
package require fptools

#
# Testing Helpers
#

proc Example {args} {
  set ::eg [concat $args]
}

proc assert {args} {
  if {! [uplevel 1 expr $args]} {
    puts "FAIL $::eg\n-> $args"
  } else {
    puts "ok   $::eg\n-> [list [lindex $args end]]"
  }
}

#
# Functional Examples
#

Example 1. Remove duplicates from an array of numbers/strings

set values {3 1 3 5 2 4 4 4}
::struct::set add uniques $values
assert {$uniques eq {4 1 5 2 3}}


Example 2. A simple search (case-sensitive)

set users {
  { id  11  name   Adam      age  23  group   editor }
  { id  47  name   John      age  28  group   admin  }
  { id  85  name   William   age  34  group   editor }
  { id  97  name   Oliver    age  28  group   admin  }
}
set res [::fptools::lfilter it $users {string match oli* [dict get $it name]}]
assert {$res eq {}}
#
# Or in plain Tcl 8.6:
#
set res [lmap it $users {if {[string match oli* [dict get $it name]]} {set it} else continue}]
assert {$res eq {}}


Example 3. A simple search (case-insensitive)

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set res [::fptools::lfilter it $users {string match -nocase oli* [dict get $it name]}]
assert {[::struct::list equal $res {{id 97 name Oliver age 28 group admin}}]}
#
# Or in plain Tcl 8.6:
#
set res [lmap it $users {if {[string match -nocase oli* [dict get $it name]]} {set it} else continue}]
assert {[::struct::list equal $res {{id 97 name Oliver age 28 group admin}}]}


Example 4. Check if any of the users have admin rights

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set hasAdmin [::fptools::lfilter it $users {string match admin [dict get $it group]}]
assert {[llength $hasAdmin]}
#
# Or in plain Tcl 8.6:
#
set hasAdmin [lmap it $users {if {[string match admin [dict get $it group]]} {set it} else continue}]
assert {[llength $hasAdmin]}


Example 5. Flattening an array of arrays

set nested {{1 2 3} {{4 5} 6} {7 8 9}}
set flat [::fptools::lflatten $nested 2]  ;# 2 is the depth of flattening
assert {[::struct::list equal $flat {1 2 3 4 5 6 7 8 9}]}


Example 6. Create an object that contains the frequency of the specified key

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set groupByAge [::fptools::lreduce acc it [dict create] $users {
  dict incr acc [dict get $it age]
}]
assert {$groupByAge eq {23 1 28 2 34 1}}


Example 7. Indexing an array of objects (lookup table)

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set uTable [::fptools::lreduce acc it [dict create] $users {
  dict set acc [dict get $it id] $it
}]
assert {[::struct::list equal $uTable {
  11 { id 11 name Adam    age 23 group editor }
  47 { id 47 name John    age 28 group admin  }
  85 { id 85 name William age 34 group editor }
  97 { id 97 name Oliver  age 28 group admin  }
}]}


Example 8. Extract the unique values for the given key of each item in the array

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
lmap it $users {::struct::set add listOfUserGroups [dict get $it group]}
assert {$listOfUserGroups eq {admin editor}}


Example 9. Object key-value map reversal

set cities {
  Lyon   France
  Berlin Germany
  Paris  France
}
set countries  [::fptools::lreduce acc it [dict create] [dict keys $cities] {
  dict lappend acc [dict get $cities $it] $it
}]
assert {[::struct::list equal $countries {France {Lyon Paris} Germany {Berlin}}]}


Example 10. Create an array of Fahrenheit values from an array of Celsius values

set celsius {-15 -5 0 10 16 20 24 32}
set fahrenheit [lmap it $celsius {expr {$it * 1.8 + 32}}]
assert {$fahrenheit eq {5.0 23.0 32.0 50.0 60.8 68.0 75.2 89.6}}


Example 11. Encode an object into a query string

proc encodeURIComponent {elem} {return $elem}
set params {lat 45 lng 6 alt 1000}
set queryString [join [lmap {k v} $params {join [list [encodeURIComponent $k] [encodeURIComponent $v]] =}] &]
assert {$queryString eq "lat=45&lng=6&alt=1000"}


Example 12. Print a table of users as a readable string only with specified keys

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set output [join [lmap it $users {lmap key {id age group} {dict get $it $key}}] \n]
assert {$output eq
"11 23 editor
47 28 admin
85 34 editor
97 28 admin"}


Example 13. Find and replace key-value pair in an array of objects

set users {
  { id 11 name Adam    age 23 group editor }
  { id 47 name John    age 28 group admin  }
  { id 85 name William age 34 group editor }
  { id 97 name Oliver  age 28 group admin  }
}
set updatedUsers [lmap it $users {expr {[dict get $it id] == 47 ? [dict incr it age] : $it}}]
assert {[dict get [lindex $updatedUsers 1] age] == 29}


Example 14. Union (A ∪ B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
set res [::struct::set union $arrA $arrB]
assert {[lsort $res] eq [lsort {1 4 3 2 5 6 7}]}


Example 15. Intersection (A ∩ B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[::struct::set intersect $arrA $arrB] eq {1 2}}


Example 16. Difference (A - B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[::struct::set difference $arrA $arrB] eq {4 3}}


Example 17. Difference (B - A) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[::struct::set difference $arrB $arrA] eq {5 6 7}}


Example 18. Symmetric Difference (A -- B) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[lsort [::struct::set symdiff $arrA $arrB]] eq [lsort {4 5 6 7 3}]}


Example 19. Symmetric Difference (B -- A) of arrays

set arrA  {1 4 3 2}
set arrB  {5 2 6 7 1}
assert {[lsort [::struct::set symdiff $arrB $arrA]] eq [lsort {4 5 6 7 3}]}

Useful Examples of Functional Tcl

Requirements

Examples

Example 1. Remove duplicates from an array of numbers/strings

Example 2. A simple search (case-sensitive)

Example 3. A simple search (case-insensitive)

Example 4. Check if any of the users have admin rights

Example 5. Flattening an array of arrays

Example 6. Create an object that contains the frequency of the specified key

Example 7. Indexing an array of objects (lookup table)

Example 8. Extract the unique values for the given key of each item in the array

Example 9. Object key-value map reversal

Example 10. Create an array of Fahrenheit values from an array of Celsius values

Example 11. Encode an object into a query string

Example 12. Print a table of users as a readable string only with specified keys

Example 13. Find and replace key-value pair in an array of objects

Example 14. Union (A ∪ B) of arrays

Example 15. Intersection (A ∩ B) of arrays

Example 16. Difference (A - B) of arrays

Example 17. Difference (B - A) of arrays

Example 18. Symmetric Difference (A -- B) of arrays

Example 19. Symmetric Difference (B -- A) of arrays

Code

Discussion