package require Tcl 8.6 #package require textutil ;# from tcllib namespace import tcl::mathfunc::min namespace import tcl::mathfunc::max #puts "prelude [info script]" 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 args} { return [string map $args $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" } } proc regsplit {re str {varname {}}} { set result [textutil::split::splitx $str $re] if {$varname ne ""} { upvar $varname dest set dest $result } return $result } # 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 }