Posted to tcl by bairui at Tue Jan 29 06:13:41 GMT 2019view raw
- #!/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}]