Useful examples of functional Tcl

#!/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

#
# List of Dictionaries Helper
#

namespace eval lod {}

proc ::lod::search {a_list_of_dicts a_key a_pat} {
  return [::fptools::lfilter it $a_list_of_dicts {string match $a_pat [dict get $it $a_key]}]
}

proc ::lod::isearch {a_list_of_dicts a_key a_pat} {
  return [::fptools::lfilter it $a_list_of_dicts {string match -nocase $a_pat [dict get $it $a_key]}]
}

proc ::lod::has {a_list_of_dicts a_key a_pat} {
  return [llength [lod::search $a_list_of_dicts $a_key $a_pat]]
}

proc ::lod::ihas {a_list_of_dicts a_key a_pat} {
  return [llength [lod::isearch $a_list_of_dicts $a_key $a_pat]]
}

proc ::lod::get {a_list_of_dicts a_list_of_keys} {
  lmap it $a_list_of_dicts {lmap k $a_list_of_keys {dict get $it $k}}
}

#
# Testing Helpers
#

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

proc source-line {frameinfo} {
  dict get [info frame $frameinfo] line
}

proc assert_command {frameinfo args} {
  if {[lindex $args 0] eq "expr"} {
    set expected [list [lindex [lindex $args 1] end]]
  } else {
    set expected [list [lindex $args end]]
    set idx [lsearch -exact $args is]
    set args [lreplace $args $idx $idx]
  }
  set condition [uplevel 1 {*}[list $args]]
  if {!$condition} {
    puts "\n$::eg\n\n  Fail at ([source-line $frameinfo])\n\n$args\n"
  } else {
    puts "$::eg\n-> $expected"
  }
}

interp alias {} //  {} assert_command [info frame] ::struct::list equal
interp alias {} /// {} assert_command [info frame] expr

#
# 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
// $uniques is {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 [::lod::search $users name oli*]
// $res is {}


Example 3. A simple search (case-insensitive)

set res [::lod::isearch $users name oli*]
// $res is {{id 97 name Oliver age 28 group admin}}


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

set hasAdmin [::lod::has $users group admin]
/// 0 < $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
// $flat is {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]
}]
// $groupByAge is {23 1 28 2 34 1}


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

set uTable [::fptools::lreduce acc it [dict create] $users {
  dict set acc [dict get $it id] $it
}]
// $uTable is {
  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

lmap it $users {::struct::set add listOfUserGroups [dict get $it group]}
// $listOfUserGroups is {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
}]
// $countries is {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}}]
// $fahrenheit is {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]] =}] &]
/// {$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 [::lod::get $users {id age group}] \n]
/// {$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 updatedUsers [lmap it $users {expr {[dict get $it id] == 47 ? [dict incr it age] : $it}}]
/// [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]
// [lsort $res] [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}
// [::struct::set intersect $arrA $arrB] {1 2}


Example 16. Difference (A - B) of arrays

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


Example 17. Difference (B - A) of arrays

// [::struct::set difference $arrB $arrA] {5 6 7}


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

// [lsort [::struct::set symdiff $arrA $arrB]] [lsort {4 5 6 7 3}]


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

// [lsort [::struct::set symdiff $arrB $arrA]] [lsort {4 5 6 7 3}]