101 lines
2.2 KiB
Tcl
101 lines
2.2 KiB
Tcl
package require Tcl 8.6
|
|
namespace import tcl::mathfunc::min
|
|
namespace import tcl::mathfunc::max
|
|
|
|
proc {#} args {}
|
|
|
|
# short aliases for common things
|
|
|
|
proc llen {lst} { return [llength $lst] }
|
|
proc slen {str} { return [string length $str] }
|
|
proc trim args { return [uplevel [concat string trim $args]] }
|
|
proc replace {str a b} { return [string map [list $a $b] $str] }
|
|
|
|
# sum and product
|
|
|
|
proc ladd {list} {
|
|
set t 0
|
|
foreach x $list { incr t $x }
|
|
return $t
|
|
}
|
|
|
|
proc lmul {list} {
|
|
set p 1
|
|
foreach x $list { set p [expr {$p * $x}] }
|
|
return $p
|
|
}
|
|
|
|
# split s on a substring
|
|
proc splitstr {s sep} {
|
|
# replace $sep with ascii char 30, aka "record separator"
|
|
return [split [replace $s $sep "\x1E"] "\x1E"]
|
|
}
|
|
|
|
proc must_regexp args {
|
|
if {! [uplevel [concat regexp $args]]} {
|
|
error "regexp failed"
|
|
}
|
|
}
|
|
|
|
# transpose a list of strings
|
|
#
|
|
# % transpose {abc 123}
|
|
# a1 b2 c3
|
|
# % transpose a1 b2 c3
|
|
# abc 123
|
|
#
|
|
proc transpose strings {
|
|
set out {}
|
|
set C [slen [lindex $strings 0]]
|
|
for {set i 0} {$i < $C} {incr i} {
|
|
set column {}
|
|
foreach row $strings {
|
|
lappend column [string index $row $i]
|
|
}
|
|
lappend out [join $column ""]
|
|
}
|
|
return $out
|
|
}
|
|
|
|
# transpose a list of lists
|
|
#
|
|
# % ltranspose {{a b c} {1 2 3}}
|
|
# {a 1} {b 2} {c 3}
|
|
# % ltranspose {{a 1} {b 2} {c 3}}
|
|
# {a b c} {1 2 3}
|
|
#
|
|
proc ltranspose lists {
|
|
set out {}
|
|
set C [llen [lindex $lists 0]]
|
|
for {set i 0} {$i < $C} {incr i} {
|
|
set column {}
|
|
foreach row $lists {
|
|
lappend column [lindex $row $i]
|
|
}
|
|
lappend out $column
|
|
}
|
|
return $out
|
|
}
|
|
|
|
# extracts one or more indexes from a strided list
|
|
# e.g.
|
|
# % set l {0 1 2 a b c x y z}
|
|
# % lextract $l 3 0
|
|
# 0 a x
|
|
# % lextract $l 3 {1 2}
|
|
# 1 2 b c y z
|
|
#
|
|
# equivalent to [lmap {a b c} $lst {list $b $c}] except that
|
|
# you don't have to name the list elements
|
|
proc lextract {lst stride index} {
|
|
set i 0
|
|
set out {}
|
|
if {$stride <= 0} { error "stride must be positive: $stride" }
|
|
for {set i 0} {$i < [llength $lst]} {incr i $stride} {
|
|
foreach j $index {
|
|
lappend out [lindex $lst $i+$j]
|
|
}
|
|
}
|
|
return $out
|
|
}
|