String pattern matching with tcl - tcl

I am new to tcl and am trying to only capture a user-specified hierarchy depth of the following:
top.run.end
top.run.something.end
top.simple.end1
top.simple.end2
top.simple.something.end1
top.simple.something.end2
top.simple.something.else.end
top.simple.something.else.other.name.end
I would like to only capture the final element in a hierarchy that does not continue with more elements deliminated by a ".". I.e. I would like to append all instances to a list (final element name could be anything).
If the user wants to select the 2nd hierarchy level, the comparison should only allow these elements from above:
top.run.end
top.simple.end1
top.simple.end2
If the user specifies the 3rd hierarchy level, then I would like to grab these elements:
top.simple.something.end1
top.simple.something.end2
4th hierarchy level:
top.simple.something.else.end
So on and so forth... I have all the code written except the string comparison, but everything I've tried doesn't seem to do what I want.
set num_hierarchy 3; # how many levels deap to search for "end"
set num_facs [ gtkwave::getNumFacs ]; # returns number of elements in file
for {set group_to_add 1} {$group_to_add <= $num_hierarchy} {incr group_to_add} {
set wave [list]
for {set i 0} {$i < $num_facs } {incr i} {
set fac_name [ gtkwave::getFacName $i ]; #returns string in form noted above
set indx [string <how to compare strings??> $fac_name]
if {$indx == <match>} {
lappend wave "$fac_name"
}
}
}

I can't say I understand why you are doing the loops like in your question, so I'll show a slightly different code snippet. I believe you should easily be able to implement the solution in your own if I can show you how mine works. The matching is done by counting the number of dots:
set elements {
top.run.end
top.run.something.end
top.simple.end1
top.simple.end2
top.simple.something.end1
top.simple.something.end2
top.simple.something.else.end
top.simple.something.else.other.name.end
}
set depth_required 3
set wave [list]
foreach element $elements {
# initial length of element
set i_len [string length $element]
# final length of element after removing dots
set f_len [string length [string map {. ""} $element]]
# thus number of dots
set n_dots [expr {$i_len-$f_len}]
# if the number equals the required hierarchy, then we got one
if {$n_dots == $depth_required} {
lappend wave $element
}
}
wave then contains:
top.run.something.end top.simple.something.end1 top.simple.something.end2
You could use regsub (which can directly return the number of substitutions performed) or split the element on dots then count of the number of resulting sub-elements as well, but I found this wiki where it shows using string map is the fastest method overall.

Related

Tcl - Differentiate between list/dict and anonymous proc

I wrote the following proc, which simulates the filter function in Lodash (javascript library) (https://lodash.com/docs/4.17.4#filter). You can call it in 3.5 basic formats, seen in the examples section. For the latter three calling options I would like to get rid of the the requirement to send in -s (shorthand). In order to do that I need to differentiate between an anonymous proc and a list/dict/string.
I tried looking at string is, but there isn't a string is proc. In researching here: http://wiki.tcl.tk/10166 I found they recommend info complete, however in most cases the parameters would pass that test regardless of the type of parameter.
Does anyone know of a way to reliable test this? I know I could leave it or change the proc definition, but I'm trying to stay as true as possible to Lodash.
Examples:
set users [list \
[dict create user barney age 36 active true] \
[dict create user fred age 40 active false] \
]
1. set result [_filter [list 1 2 3 4] {x {return true}}]
2. set result [_filter $users -s [dict create age 36 active true]]
3. set result [_filter $users -s [list age 36]]
4. set result [_filter $users -s "active"]
Proc Code:
proc _filter {collection predicate args} {
# They want to use shorthand syntax
if {$predicate=="-s"} {
# They passed a list/dict
if {[_dictIs {*}$args]} {
set predicate {x {
upvar args args
set truthy 1
dict for {k v} {*}$args {
if {[dict get $x $k]!=$v} {
set truthy false
break
}
}
return $truthy
}}
# They passed just an individual string
} else {
set predicate {x {
upvar args args;
if {[dict get $x $args]} {
return true;
}
return false;
}}
}
}
# Start the result list and the index (which may not be used)
set result {}
set i -1
# For each item in collection apply the iteratee.
# Dynamically pass the correct parameters.
set paramLen [llength [lindex $predicate 0]]
foreach item $collection {
set param [list $item]
if {$paramLen>=2} {lappend param [incr i];}
if {$paramLen>=3} {lappend param $collection;}
if {[apply $predicate {*}$param]} {
lappend result $item
}
}
return $result
}
Is x {return true} a string, a list, a dictionary or a lambda term (the correct name for an anonymous proc)?
The truth is that it may be all of them; it would be correct to say it was a value that was a member of any of the mentioned types. You need to describe your intent more precisely and explicitly rather than hiding it inside some sort of type magic. That greater precision may be achieved by using an option like -s or by different main command names, but it is still necessary either way. You cannot correctly and safely do what you seek to do.
In a little more depth…
All Tcl values are valid as strings.
Lists have a defined syntax and are properly subtypes of strings. (They're implemented differently internally, but you are supposed to ignore such details.)
Dictionaries have a syntax that is equivalent to lists with even numbers of elements where the elements at the even indices are all unique from each other.
Lambda terms are lists with two or three elements (the third element is the name of the context namespace, and defaults to the global namespace if it is absent). The first element of the list needs to be a valid list as well.
A two-element list matches the requirements for all the above. In Tcl's actual type logic, it is simultaneously all of the above. A particular instantiation of the value might have a particular implementation representation under the covers, but that is a transient thing that does not reflect the true type of the value.
Tcl's type system is different to that of many other languages.

Tcl script to do Indentation

I want to write a tcl script to align my tcl script with proper indentation. For Example if i have a code like :
proc calc { } {
set a 5
set b 10
if {a < b} {
puts "b Greater"
}
}
I need to change like:
proc calc { } {
set a 5
set b 10
if {a < b} {
puts "b Greater"
}
}
Could u guys help on this.
Writing an indenter that handles your example is trivial. A full indenter that can handle most Tcl scripts is going to be very big and quite complicated. An indenter that can handle any Tcl script will have to incorporate a full Tcl interpreter.
This is because Tcl source code is very dynamic: for one thing you can't always just look at the code and know which parts are executing code and which parts are data. Another thing is user-defined control structures, which might change how the code is to be viewed. The example below works by counting braces, but it makes no attempt to distinguish between quoting braces that should increase indentation and quoted braces that should not.
This example is a very simple indenter. It is severely limited and should not be used for serious implementations.
proc indent code {
set res {}
set ind 0
foreach line [split [string trim $code] \n] {
set line [string trim $line]
# find out if the line starts with a closing brace
set clb [string match \}* $line]
# indent the line, with one less level if it starts with a closing brace
append res [string repeat { } [expr {$ind - $clb}]]$line\n
# look through the line to find out the indentation level of the next line
foreach c [split $line {}] {
if {$c eq "\{"} {incr ind}
if {$c eq "\}"} {incr ind -1}
}
}
return $res
}
This will convert your first code example to your second one. Add even a single brace as data somewhere in the code to be indented, though, and the indentation will be off.
Documentation: append, expr, foreach, if, incr, proc, return, set, split, string

How search for list's each element existence in file

How can I organize a cycle using TCL for searching list's each element existence in file or in another list, and if it doesn't exists there return unmatched element.
If the number of things that you are checking for is significantly smaller than the number of lines/tokens in the file, it is probably best to use the power of associative arrays to do the check as this can be done with linear scans (associative arrays are fast).
proc checkForAllPresent {tokens tokenList} {
foreach token $tokens {
set t($token) "dummy value"
}
foreach token $tokenList {
unset -nocomplain t($token)
}
# If the array is empty, all were found
return [expr {[array size t] == 0}]
}
Then, all we need to do is a little standard stanza to get the lines/tokens from the file and run them through the checker. Assuming we're dealing with lines:
proc getFileLines {filename} {
set f [open $filename]
set data [read $f]
close $f
return [split $data "\n"]
}
set shortList [getFileLines file1.txt]
set longList [getFileLines file2.txt]
if {[checkForAllPresent $shortList $longList]} {
puts "All were there"
} else {
puts "Some were absent"
}
It's probably better to return the list of absent lines (with return [array names t]) instead of whether everything is absent (with the general check of “is everything there” being done with llength) as that gives more useful information. (With more work, you can produce even more information about what is present, but that's a bit more code and makes things less clear.)
(When searching, be aware that leading and trailing whitespace on lines matters. This is all exact matching here. Or use string trim.)
Working with words instead of lines is really just as easy. You just end up with slightly different code to extract the tokens from the read-in contents of the files.
return [regexp -all -inline {\w+} $data]
Everything else is the same.

Combinations of all charcaters and all lengths with using less number of loops?

Brain Teaser: I self originated this question, but stuck completely.
I want to create all possible combination of all characters, but of all possible lengths. Suppose, [a-z] combination of 1 length, then [a-z] combination of 2 length, and so on till the maximum length achieved.
this could be very easily done by iterative looping.
Example for 3 length:
proc triples list {
foreach i $list {
foreach j $list {
foreach k $list {
puts [list $i $j $k]
}
}
}
}
But, it should solve using less loops (looping needs to be dynamic)
set chars "abcdefghijklmnopqrstuvwxyz"
set chars [split $chars ""]
set complete_length [llength $chars]
set start 0
set maximum_length 15
while {1} {
if {$start > $maximum_length} {
break
}
for {set i [expr $maximum_length-$start]} {$i >= 0} {incr i -1} {
# dump combinations
}
incr start
}
In this chunk, what algorithm or method i should apply? Any kind of suggestions/help/code will be appreciated.
Sry, this is not an answer, but hopefully some interesting discussion anyway:
The word "combinations" is often used way too generally, so it can be interpreted in many different ways. Let's say that you have a source list of 26 different elements, the english letters, and you want to pick 3 of them and combine in a 3 element destination list:
Can you always pick any letter from the source list, or do the elements disappear from it as you pick them? Either define "pick" (are the elements copied or moved during a pick), or define the set of source values (is there 1 of each of A-Z or an infinite amount of A-Z).
Does the order in the destination list matter? Is AHM considered to be the same combination as HAM? Define "combine".
If you have a list where not all elements are different, e.g. {2 10 10 64 100}, you have even more possibilities. Define your set of values.
Your first example prints permutations, not combinations. If that's what you want, the easiset way is a recursive procedure. Combinations are more complicated to generate.
EDIT:
I wrote this procedure for a Project Euler program. It picks all the elements, but maybe you can modify it to pick n. It takes a command prefix as argument, so you don't have to store all permutations.
package require Tcl 8.5.0
proc forEachPerm {list cmdPrefix} {
_forEachPerm {} $list $cmdPrefix
}
proc _forEachPerm {head list cmdPrefix} {
if {![llength $list]} {
{*}$cmdPrefix $head
} else {
for {set i 0} {$i < [llength $list]} {incr i} {
_forEachPerm [concat $head [lrange $list $i $i]] [lreplace $list $i $i] $cmdPrefix
}
}
}
# example use:
forEachPerm {a b c} {apply {{list} {puts [join $list]}}}

Array manipulation in TCL

I have the following data each in separate arrays such as atten(), power(), bandwidth(), Time()
Atten Power Bandwidth Time
30 1.52E+01 52638515 0
31 1.51E+01 49807360 10
32 1.46E+01 52848230 20
33 1.51E+01 39845888 30
I need to change the arrangement to the following format
Atten Power Bandwidth Time
30 1.52E+01 52638515 0
30 1.52E+01 49807360 10
31 1.51E+01 52848230 20
31 1.51E+01 39845888 30
. . . .
Now i need to make atten() and power() appear twice without changing anything for the arrays bandwidth() and time in an excel in csv format???.. The following is how i write my data to excel in CSV format.
set application [::tcom::ref createobject "Excel.Application"]
set XlFileFormat(xlCSV) [expr 6]
set workbooks [$application Workbooks]
set workbook [$workbooks Add]
$application DisplayAlerts False
set worksheets [$workbook Worksheets]
set worksheet [$worksheets Item [expr 1]]
set cells [$worksheet Cells]
set rows [array size atten]
for {set row 1} {$row <= $rows} {incr row} {
$cells Item $row "A" $atten($row)
}
The following code snippet is example of how to use a chronological list of array keys, in order to print out array contents in order. This is then used to make an array with two of every element.
#!/usr/bin/tclsh
proc add_element {array_name key value} {
upvar $array_name aa
if { ![info exists aa($key)] } {
set aa($key) $value
lappend aa() $key
}
}
add_element names 1 Jane
add_element names 2 Tom
add_element names 3 Elisabeth
add_element names 4 Ted
add_element names 5 Sally
foreach e $names() {
add_element morenames $e $names($e)
add_element morenames $[expr $e + 1 ] $names($e)
}
foreach e $morenames() {
puts $morenames($e)
}
In order to solve your problem you would generate new arrays for atten and power with double element as per the above example. You would then generate your other arrays using a function similar to the example above, unless they already are returned ordered when iterating through them.
You would then iterate through on of the other arrays, say newTime, using something similar to the snippet below:
set rows [array size newTime]
for {set row 1} {$row <= $rows} {incr row} {
$cells Item $row "A" $newatten($row)
$cells Item $row "B" $newpower($row)
$cells Item $row "C" $newbandwidth($row)
$cells Item $row "C" $newTime($row)
}
The following code snippet is an example of how to remap numeric keys of a TCL Array (Associative array or HashMap).
#!/usr/bin/tclsh
set names(1) Jane
set names(2) Tom
set names(3) Elisabeth
set names(4) Robert
set names(5) Julia
set names(6) Victoria
foreach n [array names names] {
puts $n
puts $names($n)
}
puts "-------------"
foreach n [array names names] {
set newnames([expr $n -1]) $names($n)
}
foreach n [array names newnames] {
puts $n
puts $newnames($n)
}
This isn't sufficient to do what you want.
You would have to do this and then remove unset the first element and add set a last element.
You haven't specified in your question what your last element would be.
If you are using non numeric keys, e.g string keys then you would have to give those keys some concept of order, whether by mapping them to numeric keys or using some other method.
Note that TCL arrays don't return things in order in a foreach loop unless you tell them to.
TCL lists are better suited to that, as demostrated by.
#!/usr/bin/tclsh
set i 0
foreach j "a b c" {
puts "$j is item number $i in list x"
incr i
}
You also haven't specified what data structures you want to convert to or whether you just want to write the input to screen (using puts) or to file.
E.g Whether you would to generate any of the folllowing data structures for your table ?
A TCL array of TCL arrays (Hashmap of Hashmap)
A List of Lists
A TCL array of Lists
A List of TCL Arrays (List of Hashmap)
For further information see:
Arrays Page TCL Wiki
List Page TCL Wiki
Associative Arrays Page TCL Tutorial
List Page TCL Tutorial