#fastest is to know the number of lists to be zipped
#fastest is to know the number of lists to be zipped
@ -1053,6 +1101,7 @@ namespace eval punk::lib {
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
#wiki - courtesy JAL
set list_l $args
set list_l $args
set zip_l []
set zip_l []
@ -1068,6 +1117,7 @@ namespace eval punk::lib {
return $zip_l
return $zip_l
}
}
proc lzipn_tcl9a {args} {
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#approx 2x faster for large lists or more lists
@ -1121,15 +1171,38 @@ namespace eval punk::lib {
}
}
return $zip_l
return $zip_l
}
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
}
namespace import ::punk::args::lib::tstr
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
proc is_list_all_ni_list2 {a b} $body
}
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
namespace eval argdoc {
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
variable PUNKARGS
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
lappend PUNKARGS [list {
proc ldiff {fromlist removeitems} {
@id -id ::punk::lib::ldiff
if {[llength $removeitems] == 0} {return $fromlist}
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
if {$item ni $removeitems} {
lappend result $item
lappend result $item
}
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
return [array names tmp]
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
#default/fallback implementation
proc lunique_unordered {list} {
proc lunique_unordered {list} {
lunique $list
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
struct::set union $list {}
}
}
} else {
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
#we could also test a sequence of: struct::set add
}
}
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
proc lunique {list} {
set new {}
set new {}
foreach item $list {
foreach item $list {
@ -2569,7 +2702,7 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
range of valid values.
e.g the following are all valid ranges
e.g the following are all valid ranges
@ -2581,6 +2714,9 @@ namespace eval punk::lib {
(index 2 to 11)
(index 2 to 11)
..
..
(all indices)
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-1. would represent end to base with step -1
.-1. would represent end to base with step -1
If start is omitted and only the end is supplied:
If start is omitted and only the end is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
If end is omitted and onlthe start is supplied:
The default step is 1 indicating ascension and the missing start is equivalent to the base.
The default step is 1 indicating ascension and the missing start is equivalent to the base.
indexset_resolve 5 ..2
indexset_resolve 5 ..2
-> 0 1 2
-> 0 1 2
The default start is 'end' if the step is negative
The default start is 'end' if the step is negative
indexset_resolve 5 .-1.2
indexset_resolve 5 .-1.2
-> 4 3 2
-> 4 3 2
If end is omitted and only the start is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
Like the tcl9 lseq command - a step (by) value of zero produces no results.
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
@cmd -name punk::lib::gcd\
-summary\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
-help\
"Return the greatest common divisor of m and n.
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
return $m
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#use eq test with emptystring instead of 'string length' - test for emptiness shouldn't cause shimmering if popped inputchunks member if an 'ansisplit' list
#The overflow can only be triggered by a grapheme (todo cluster?) - but our unapplied could contain SGR codes prior to the grapheme that triggered overflow - so we need to skip beyond any SGRs
#The overflow can only be triggered by a grapheme (todo cluster?) - but our unapplied could contain SGR codes prior to the grapheme that triggered overflow - so we need to skip beyond any SGRs
#There may be more than one, because although the stack leading up to overflow may have been merged - codes between the last column and the overflowing grapheme will remain separate
#There may be more than one, because although the stack leading up to overflow may have been merged - codes between the last column and the overflowing grapheme will remain separate
#We don't expect any movement or other ANSI codes - as if they came before the grapheme, they would have triggered a different instruction to 'overflow'
#We don't expect any movement or other ANSI codes - as if they came before the grapheme, they would have triggered a different instruction to 'overflow'
set drop_graphemes [list] ;#list of contiguous grapheme indices
set new_unapplied_list [list]
set unapplied_ansisplit [list ""]
set idx 0
set idx 0
set next_grapheme_index -1
foreach u $unapplied_list {
foreach u $unapplied_list {
if {![punk::ansi::ta::detect $u]} {
if {![punk::ansi::ta::detect $u]} {
set next_grapheme_index $idx
#puts stderr "g$idx:$u"
break
if {![llength $drop_graphemes] || $idx == [lindex $drop_graphemes end]+1} {
#we are in the first run of uninterrupted graphemes
#drop by doing nothing with it here
lappend drop_graphemes $idx
} else {
lappend new_unapplied_list $u
ledit unapplied_ansisplit end end "[lindex $unapplied_ansisplit end]$u"
}
} else {
lappend new_unapplied_list $u
lappend unapplied_ansisplit $u ""
}
}
incr idx
incr idx
}
}
assert {$next_grapheme_index >= 0}
#debug
#drop the overflow grapheme - keeping all codes in place.
if {[llength $drop_graphemes]} {
set unapplied [join [lreplace $unapplied_list $next_grapheme_index $next_grapheme_index] ""]
#we need to run the reduced unapplied on the same line - further graphemes will just overflow again, but codes or control chars could trigger jumps to other lines
#we need to run the reduced unapplied on the same line - further graphemes will just overflow again, but codes or control chars could trigger jumps to other lines
set opt_colstart [tcl::dict::get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay
set opt_colstart [tcl::dict::get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay
set opt_colcursor [tcl::dict::get $opts -cursor_column];#start cursor column relative to overlay
set opt_colcursor [tcl::dict::get $opts -cursor_column];#start cursor column relative to overlay
set opt_row_context [tcl::dict::get $opts -cursor_row]
set opt_row_context [tcl::dict::get $opts -cursor_row]
set opt_overtext_type [tcl::dict::get $opts -overtext_type]
if {[string length $opt_row_context]} {
if {[string length $opt_row_context]} {
if {![tcl::string::is integer -strict $opt_row_context] || $opt_row_context <1 } {
if {![tcl::string::is integer -strict $opt_row_context] || $opt_row_context <1 } {
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use
set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use
#experiment
set overlay_grapheme_control_stacks [list]
set overlay_grapheme_control_stacks [list]
#REVIEW - even if we pass in a pre-split overtext (-overtext_type ansisplit)
#we are re-generating the overlay_grapheme_control_stacks list each time
#this is a big issue when overtext is not broken into lines, but is just a big long ansi and/or plain text string.
#todo - return also the unapplied portion of the overlay_grapheme_control_stacks list??
foreach {pt code} $overmap {
foreach {pt code} $overmap {
if {$pt ne ""} {
if {$pt ne ""} {
#todo - wrap in test for empty pt (we used split_codes_single - and it may be common for sgr sequences to be unmerged and so have empty pts between)
#todo - wrap in test for empty pt (we used split_codes_single - and it may be common for sgr sequences to be unmerged and so have empty pts between)
#fastest is to know the number of lists to be zipped
#fastest is to know the number of lists to be zipped
@ -1053,6 +1101,7 @@ namespace eval punk::lib {
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
#wiki - courtesy JAL
set list_l $args
set list_l $args
set zip_l []
set zip_l []
@ -1068,6 +1117,7 @@ namespace eval punk::lib {
return $zip_l
return $zip_l
}
}
proc lzipn_tcl9a {args} {
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#approx 2x faster for large lists or more lists
@ -1121,15 +1171,38 @@ namespace eval punk::lib {
}
}
return $zip_l
return $zip_l
}
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
}
namespace import ::punk::args::lib::tstr
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
proc is_list_all_ni_list2 {a b} $body
}
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
namespace eval argdoc {
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
variable PUNKARGS
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
lappend PUNKARGS [list {
proc ldiff {fromlist removeitems} {
@id -id ::punk::lib::ldiff
if {[llength $removeitems] == 0} {return $fromlist}
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
if {$item ni $removeitems} {
lappend result $item
lappend result $item
}
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
return [array names tmp]
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
#default/fallback implementation
proc lunique_unordered {list} {
proc lunique_unordered {list} {
lunique $list
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
struct::set union $list {}
}
}
} else {
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
#we could also test a sequence of: struct::set add
}
}
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
proc lunique {list} {
set new {}
set new {}
foreach item $list {
foreach item $list {
@ -2569,7 +2702,7 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
range of valid values.
e.g the following are all valid ranges
e.g the following are all valid ranges
@ -2581,6 +2714,9 @@ namespace eval punk::lib {
(index 2 to 11)
(index 2 to 11)
..
..
(all indices)
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-1. would represent end to base with step -1
.-1. would represent end to base with step -1
If start is omitted and only the end is supplied:
If start is omitted and only the end is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
If end is omitted and onlthe start is supplied:
The default step is 1 indicating ascension and the missing start is equivalent to the base.
The default step is 1 indicating ascension and the missing start is equivalent to the base.
indexset_resolve 5 ..2
indexset_resolve 5 ..2
-> 0 1 2
-> 0 1 2
The default start is 'end' if the step is negative
The default start is 'end' if the step is negative
indexset_resolve 5 .-1.2
indexset_resolve 5 .-1.2
-> 4 3 2
-> 4 3 2
If end is omitted and only the start is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
Like the tcl9 lseq command - a step (by) value of zero produces no results.
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
@cmd -name punk::lib::gcd\
-summary\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
-help\
"Return the greatest common divisor of m and n.
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
return $m
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#fastest is to know the number of lists to be zipped
#fastest is to know the number of lists to be zipped
@ -1053,6 +1101,7 @@ namespace eval punk::lib {
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
#wiki - courtesy JAL
set list_l $args
set list_l $args
set zip_l []
set zip_l []
@ -1068,6 +1117,7 @@ namespace eval punk::lib {
return $zip_l
return $zip_l
}
}
proc lzipn_tcl9a {args} {
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#approx 2x faster for large lists or more lists
@ -1121,15 +1171,38 @@ namespace eval punk::lib {
}
}
return $zip_l
return $zip_l
}
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
}
namespace import ::punk::args::lib::tstr
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
proc is_list_all_ni_list2 {a b} $body
}
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
namespace eval argdoc {
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
variable PUNKARGS
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
lappend PUNKARGS [list {
proc ldiff {fromlist removeitems} {
@id -id ::punk::lib::ldiff
if {[llength $removeitems] == 0} {return $fromlist}
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
if {$item ni $removeitems} {
lappend result $item
lappend result $item
}
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
return [array names tmp]
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
#default/fallback implementation
proc lunique_unordered {list} {
proc lunique_unordered {list} {
lunique $list
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
struct::set union $list {}
}
}
} else {
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
#we could also test a sequence of: struct::set add
}
}
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
proc lunique {list} {
set new {}
set new {}
foreach item $list {
foreach item $list {
@ -2569,7 +2702,7 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
range of valid values.
e.g the following are all valid ranges
e.g the following are all valid ranges
@ -2581,6 +2714,9 @@ namespace eval punk::lib {
(index 2 to 11)
(index 2 to 11)
..
..
(all indices)
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-1. would represent end to base with step -1
.-1. would represent end to base with step -1
If start is omitted and only the end is supplied:
If start is omitted and only the end is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
If end is omitted and onlthe start is supplied:
The default step is 1 indicating ascension and the missing start is equivalent to the base.
The default step is 1 indicating ascension and the missing start is equivalent to the base.
indexset_resolve 5 ..2
indexset_resolve 5 ..2
-> 0 1 2
-> 0 1 2
The default start is 'end' if the step is negative
The default start is 'end' if the step is negative
indexset_resolve 5 .-1.2
indexset_resolve 5 .-1.2
-> 4 3 2
-> 4 3 2
If end is omitted and only the start is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
Like the tcl9 lseq command - a step (by) value of zero produces no results.
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
@cmd -name punk::lib::gcd\
-summary\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
-help\
"Return the greatest common divisor of m and n.
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
return $m
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#fastest is to know the number of lists to be zipped
#fastest is to know the number of lists to be zipped
@ -1053,6 +1101,7 @@ namespace eval punk::lib {
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
#wiki - courtesy JAL
set list_l $args
set list_l $args
set zip_l []
set zip_l []
@ -1068,6 +1117,7 @@ namespace eval punk::lib {
return $zip_l
return $zip_l
}
}
proc lzipn_tcl9a {args} {
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#approx 2x faster for large lists or more lists
@ -1121,15 +1171,38 @@ namespace eval punk::lib {
}
}
return $zip_l
return $zip_l
}
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
}
namespace import ::punk::args::lib::tstr
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
proc is_list_all_ni_list2 {a b} $body
}
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
namespace eval argdoc {
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
variable PUNKARGS
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
lappend PUNKARGS [list {
proc ldiff {fromlist removeitems} {
@id -id ::punk::lib::ldiff
if {[llength $removeitems] == 0} {return $fromlist}
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
if {$item ni $removeitems} {
lappend result $item
lappend result $item
}
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
return [array names tmp]
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
#default/fallback implementation
proc lunique_unordered {list} {
proc lunique_unordered {list} {
lunique $list
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
struct::set union $list {}
}
}
} else {
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
#we could also test a sequence of: struct::set add
}
}
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
proc lunique {list} {
set new {}
set new {}
foreach item $list {
foreach item $list {
@ -2569,7 +2702,7 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
range of valid values.
e.g the following are all valid ranges
e.g the following are all valid ranges
@ -2581,6 +2714,9 @@ namespace eval punk::lib {
(index 2 to 11)
(index 2 to 11)
..
..
(all indices)
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-1. would represent end to base with step -1
.-1. would represent end to base with step -1
If start is omitted and only the end is supplied:
If start is omitted and only the end is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
If end is omitted and onlthe start is supplied:
The default step is 1 indicating ascension and the missing start is equivalent to the base.
The default step is 1 indicating ascension and the missing start is equivalent to the base.
indexset_resolve 5 ..2
indexset_resolve 5 ..2
-> 0 1 2
-> 0 1 2
The default start is 'end' if the step is negative
The default start is 'end' if the step is negative
indexset_resolve 5 .-1.2
indexset_resolve 5 .-1.2
-> 4 3 2
-> 4 3 2
If end is omitted and only the start is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
Like the tcl9 lseq command - a step (by) value of zero produces no results.
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
@cmd -name punk::lib::gcd\
-summary\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
-help\
"Return the greatest common divisor of m and n.
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
return $m
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
set overtext [lpop inputchunks 0] ;#could be a list 'ansisplit' or text 'plain|mixed'
set overtext [lpop inputchunks 0]
if {![tcl::string::length $overtext]} {
#use eq test with emptystring instead of 'string length' - test for emptiness shouldn't cause shimmering if popped inputchunks member if an 'ansisplit' list
set opt_colstart [tcl::dict::get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay
set opt_colstart [tcl::dict::get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay
set opt_colcursor [tcl::dict::get $opts -cursor_column];#start cursor column relative to overlay
set opt_colcursor [tcl::dict::get $opts -cursor_column];#start cursor column relative to overlay
set opt_row_context [tcl::dict::get $opts -cursor_row]
set opt_row_context [tcl::dict::get $opts -cursor_row]
set opt_overtext_type [tcl::dict::get $opts -overtext_type]
if {[string length $opt_row_context]} {
if {[string length $opt_row_context]} {
if {![tcl::string::is integer -strict $opt_row_context] || $opt_row_context <1 } {
if {![tcl::string::is integer -strict $opt_row_context] || $opt_row_context <1 } {
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use
set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use
#experiment
set overlay_grapheme_control_stacks [list]
set overlay_grapheme_control_stacks [list]
#REVIEW - even if we pass in a pre-split overtext (-overtext_type ansisplit)
#we are re-generating the overlay_grapheme_control_stacks list each time
#this is a big issue when overtext is not broken into lines, but is just a big long ansi and/or plain text string.
#todo - return also the unapplied portion of the overlay_grapheme_control_stacks list??
foreach {pt code} $overmap {
foreach {pt code} $overmap {
if {$pt ne ""} {
if {$pt ne ""} {
#todo - wrap in test for empty pt (we used split_codes_single - and it may be common for sgr sequences to be unmerged and so have empty pts between)
#todo - wrap in test for empty pt (we used split_codes_single - and it may be common for sgr sequences to be unmerged and so have empty pts between)
#fastest is to know the number of lists to be zipped
#fastest is to know the number of lists to be zipped
@ -1053,6 +1101,7 @@ namespace eval punk::lib {
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
#wiki - courtesy JAL
set list_l $args
set list_l $args
set zip_l []
set zip_l []
@ -1068,6 +1117,7 @@ namespace eval punk::lib {
return $zip_l
return $zip_l
}
}
proc lzipn_tcl9a {args} {
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#approx 2x faster for large lists or more lists
@ -1121,15 +1171,38 @@ namespace eval punk::lib {
}
}
return $zip_l
return $zip_l
}
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
}
namespace import ::punk::args::lib::tstr
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
proc is_list_all_ni_list2 {a b} $body
}
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
namespace eval argdoc {
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
variable PUNKARGS
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
lappend PUNKARGS [list {
proc ldiff {fromlist removeitems} {
@id -id ::punk::lib::ldiff
if {[llength $removeitems] == 0} {return $fromlist}
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
if {$item ni $removeitems} {
lappend result $item
lappend result $item
}
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
return [array names tmp]
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
#default/fallback implementation
proc lunique_unordered {list} {
proc lunique_unordered {list} {
lunique $list
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
struct::set union $list {}
}
}
} else {
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
#we could also test a sequence of: struct::set add
}
}
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
proc lunique {list} {
set new {}
set new {}
foreach item $list {
foreach item $list {
@ -2569,7 +2702,7 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
range of valid values.
e.g the following are all valid ranges
e.g the following are all valid ranges
@ -2581,6 +2714,9 @@ namespace eval punk::lib {
(index 2 to 11)
(index 2 to 11)
..
..
(all indices)
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-1. would represent end to base with step -1
.-1. would represent end to base with step -1
If start is omitted and only the end is supplied:
If start is omitted and only the end is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
If end is omitted and onlthe start is supplied:
The default step is 1 indicating ascension and the missing start is equivalent to the base.
The default step is 1 indicating ascension and the missing start is equivalent to the base.
indexset_resolve 5 ..2
indexset_resolve 5 ..2
-> 0 1 2
-> 0 1 2
The default start is 'end' if the step is negative
The default start is 'end' if the step is negative
indexset_resolve 5 .-1.2
indexset_resolve 5 .-1.2
-> 4 3 2
-> 4 3 2
If end is omitted and only the start is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
Like the tcl9 lseq command - a step (by) value of zero produces no results.
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
@cmd -name punk::lib::gcd\
-summary\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
-help\
"Return the greatest common divisor of m and n.
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
return $m
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
