Posted to tcl by bairui at Tue Jan 29 06:13:41 GMT 2019view raw

  1. #!/usr/bin/env tclsh
  2.  
  3. # Useful examples of Functional Tcl
  4. # Barry Arthur, 2019-1-28
  5.  
  6. # Original Article: 15 Useful JS Examples of map(), reduce() and filter()
  7. # https://medium.com/@alex.permyakov/15-useful-javascript-examples-of-map-reduce-and-filter-74cbbb5e0a1f
  8. # by Alex Permyakov, 2019-1-16.
  9.  
  10. package require struct::set
  11. package require struct::list
  12. package require fptools
  13.  
  14. #
  15. # List of Dictionaries Helper
  16. #
  17.  
  18. namespace eval lod {}
  19.  
  20. proc ::lod::search {a_list_of_dicts a_key a_pat} {
  21. return [::fptools::lfilter it $a_list_of_dicts {string match $a_pat [dict get $it $a_key]}]
  22. }
  23.  
  24. proc ::lod::isearch {a_list_of_dicts a_key a_pat} {
  25. return [::fptools::lfilter it $a_list_of_dicts {string match -nocase $a_pat [dict get $it $a_key]}]
  26. }
  27.  
  28. proc ::lod::has {a_list_of_dicts a_key a_pat} {
  29. return [llength [lod::search $a_list_of_dicts $a_key $a_pat]]
  30. }
  31.  
  32. proc ::lod::ihas {a_list_of_dicts a_key a_pat} {
  33. return [llength [lod::isearch $a_list_of_dicts $a_key $a_pat]]
  34. }
  35.  
  36. proc ::lod::get {a_list_of_dicts a_list_of_keys} {
  37. lmap it $a_list_of_dicts {lmap k $a_list_of_keys {dict get $it $k}}
  38. }
  39.  
  40. #
  41. # Testing Helpers
  42. #
  43.  
  44. proc Example {args} {
  45. set ::eg [concat $args]
  46. }
  47.  
  48. proc source-line {frameinfo} {
  49. dict get [info frame $frameinfo] line
  50. }
  51.  
  52. proc assert_command {frameinfo args} {
  53. if {[lindex $args 0] eq "expr"} {
  54. set expected [list [lindex [lindex $args 1] end]]
  55. } else {
  56. set expected [list [lindex $args end]]
  57. set idx [lsearch -exact $args is]
  58. set args [lreplace $args $idx $idx]
  59. }
  60. set condition [uplevel 1 {*}[list $args]]
  61. if {!$condition} {
  62. puts "\n$::eg\n\n Fail at ([source-line $frameinfo])\n\n$args\n"
  63. } else {
  64. puts "$::eg\n-> $expected"
  65. }
  66. }
  67.  
  68. interp alias {} // {} assert_command [info frame] ::struct::list equal
  69. interp alias {} /// {} assert_command [info frame] expr
  70.  
  71. #
  72. # Functional Examples
  73. #
  74.  
  75. Example 1. Remove duplicates from an array of numbers/strings
  76.  
  77. set values {3 1 3 5 2 4 4 4}
  78. ::struct::set add uniques $values
  79. // $uniques is {4 1 5 2 3}
  80.  
  81.  
  82. Example 2. A simple search (case-sensitive)
  83.  
  84. set users {
  85. { id 11 name Adam age 23 group editor }
  86. { id 47 name John age 28 group admin }
  87. { id 85 name William age 34 group editor }
  88. { id 97 name Oliver age 28 group admin }
  89. }
  90. set res [::lod::search $users name oli*]
  91. // $res is {}
  92.  
  93.  
  94. Example 3. A simple search (case-insensitive)
  95.  
  96. set res [::lod::isearch $users name oli*]
  97. // $res is {{id 97 name Oliver age 28 group admin}}
  98.  
  99.  
  100. Example 4. Check if any of the users have admin rights
  101.  
  102. set hasAdmin [::lod::has $users group admin]
  103. /// 0 < $hasAdmin
  104.  
  105.  
  106. Example 5. Flattening an array of arrays
  107.  
  108. set nested {{1 2 3} {{4 5} 6} {7 8 9}}
  109. set flat [::fptools::lflatten $nested 2] ;# 2 is the depth of flattening
  110. // $flat is {1 2 3 4 5 6 7 8 9}
  111.  
  112.  
  113. Example 6. Create an object that contains the frequency of the specified key
  114.  
  115. set users {
  116. { id 11 name Adam age 23 group editor }
  117. { id 47 name John age 28 group admin }
  118. { id 85 name William age 34 group editor }
  119. { id 97 name Oliver age 28 group admin }
  120. }
  121. set groupByAge [::fptools::lreduce acc it [dict create] $users {
  122. dict incr acc [dict get $it age]
  123. }]
  124. // $groupByAge is {23 1 28 2 34 1}
  125.  
  126.  
  127. Example 7. Indexing an array of objects (lookup table)
  128.  
  129. set uTable [::fptools::lreduce acc it [dict create] $users {
  130. dict set acc [dict get $it id] $it
  131. }]
  132. // $uTable is {
  133. 11 { id 11 name Adam age 23 group editor }
  134. 47 { id 47 name John age 28 group admin }
  135. 85 { id 85 name William age 34 group editor }
  136. 97 { id 97 name Oliver age 28 group admin }
  137. }
  138.  
  139.  
  140. Example 8. Extract the unique values for the given key of each item in the array
  141.  
  142. lmap it $users {::struct::set add listOfUserGroups [dict get $it group]}
  143. // $listOfUserGroups is {admin editor}
  144.  
  145.  
  146. Example 9. Object key-value map reversal
  147.  
  148. set cities {
  149. Lyon France
  150. Berlin Germany
  151. Paris France
  152. }
  153. set countries [::fptools::lreduce acc it [dict create] [dict keys $cities] {
  154. dict lappend acc [dict get $cities $it] $it
  155. }]
  156. // $countries is {France {Lyon Paris} Germany {Berlin}}
  157.  
  158.  
  159. Example 10. Create an array of Fahrenheit values from an array of Celsius values
  160.  
  161. set celsius {-15 -5 0 10 16 20 24 32}
  162. set fahrenheit [lmap it $celsius {expr {$it * 1.8 + 32}}]
  163. // $fahrenheit is {5.0 23.0 32.0 50.0 60.8 68.0 75.2 89.6}
  164.  
  165.  
  166. Example 11. Encode an object into a query string
  167.  
  168. proc encodeURIComponent {elem} {return $elem}
  169. set params {lat 45 lng 6 alt 1000}
  170. set queryString [join [lmap {k v} $params {join [list [encodeURIComponent $k] [encodeURIComponent $v]] =}] &]
  171. /// {$queryString eq "lat=45&lng=6&alt=1000"}
  172.  
  173. Example 12. Print a table of users as a readable string only with specified keys
  174.  
  175. set users {
  176. { id 11 name Adam age 23 group editor }
  177. { id 47 name John age 28 group admin }
  178. { id 85 name William age 34 group editor }
  179. { id 97 name Oliver age 28 group admin }
  180. }
  181. set output [join [::lod::get $users {id age group}] \n]
  182. /// {$output eq
  183. "11 23 editor
  184. 47 28 admin
  185. 85 34 editor
  186. 97 28 admin"}
  187.  
  188.  
  189. Example 13. Find and replace key-value pair in an array of objects
  190.  
  191. set updatedUsers [lmap it $users {expr {[dict get $it id] == 47 ? [dict incr it age] : $it}}]
  192. /// [dict get [lindex $updatedUsers 1] age] == 29
  193.  
  194.  
  195. Example 14. Union (A * B) of arrays
  196.  
  197. set arrA {1 4 3 2}
  198. set arrB {5 2 6 7 1}
  199. set res [::struct::set union $arrA $arrB]
  200. // [lsort $res] [lsort {1 4 3 2 5 6 7}]
  201.  
  202.  
  203. Example 15. Intersection (A ) B) of arrays
  204.  
  205. set arrA {1 4 3 2}
  206. set arrB {5 2 6 7 1}
  207. // [::struct::set intersect $arrA $arrB] {1 2}
  208.  
  209.  
  210. Example 16. Difference (A - B) of arrays
  211.  
  212. set arrA {1 4 3 2}
  213. set arrB {5 2 6 7 1}
  214. // [::struct::set difference $arrA $arrB] {4 3}
  215.  
  216.  
  217. Example 17. Difference (B - A) of arrays
  218.  
  219. // [::struct::set difference $arrB $arrA] {5 6 7}
  220.  
  221.  
  222. Example 18. Symmetric Difference (A -- B) of arrays
  223.  
  224. // [lsort [::struct::set symdiff $arrA $arrB]] [lsort {4 5 6 7 3}]
  225.  
  226.  
  227. Example 19. Symmetric Difference (B -- A) of arrays
  228.  
  229. // [lsort [::struct::set symdiff $arrB $arrA]] [lsort {4 5 6 7 3}]
  230.