How to count repeated words from the list - tcl

I have a list of cells,
U1864
u_dhm_lut/U4
u_dhm_lut/lut_out_reg_2_
u_dhm_lut/lut_in_reg_2_
And I want to calculate how many times each name comes
Result will:
U1864 1
u_dhm_lut/lut_out_reg_2_ 18
u_dhm_lut/lut_in_reg_2_ 14
u_dhm_lut/U4 10
The code is like:
set cell_cnt [open "demo.txt" r]
set cell [read $cell_cnt]
set b [open "number_of_cell.txt" w+]
proc countwords {cell_count} {
set unique_name [lsort -unique $cell_count]
foreach count $unique_name {
set cnt 0
foreach item $cell_count {
if {$item == $count} {
incr cnt
}
}
puts $b "$count :: $cnt"
}
}
countwords $cell
It says can't read "b":no such variable while executing
"puts $b "$count :: $cnt""
Why am i not able write a file inside proc?

Code inside a procedure scope can't use variables defined outside that scope, e.g. global variables. To be able to use global variables, you can import them into the procedure scope:
proc countwords cell_count {
global b
or use a qualified name:
puts $::b ...
You can also bypass the issue by passing the file handle to the procedure:
proc countwords {b cell_count} {
...
countwords $b $cell
or move the code for opening the file inside the procedure (not recommended: procedures should have one job only).
Old answer, based on the question title
This is one of the most frequently asked frequently asked questions. If you look a while back in the question list, you will find quite a few answers to this.
The solution is actually pretty easy, and the core of it is to use an array as a frequency table, with the words as keys and the frequencies as values. The incr command creates new entries (with a value of one) in the table as needed.
foreach word $words {
incr count($word)
}
The result is similarly easy to check:
parray count
The result can of course also be used in a script in any way that an array can be used.
Documentation:
array,
foreach,
incr,
parray

You can use the open file code i.e "set b [open "number_of_cell.txt" w+]" inside the method. This should also solve your problem

Related

Assigning value to a variable only if argv specified in TCL

I am new to the TCL scripting .I have a script called "Sample.tcl". In the Sample.tcl I have a variable called $name. How can I assign a value to the variable if there exist a specific argv i.e.
Sample.tcl -step xyz
Only if I specify -step then $name should be xyz.
I'm not sure what $name might be in this context (it's a really unusual name for a variable, and using variable variable names is typically a bad idea) but under the guess that you're trying to set step to xyz in this case, you can put this in your script:
apply {{} {
# For each pair of values in the arguments (after the script name)
global argv
foreach {key value} $argv {
# Safety-check: if the key starts with a hyphen...
if {[string match -* $key]} {
# ... strip the leading hyphen(s)
set varname [string trimleft $key "-"]
# ... bind that global var name to a local name
upvar 1 $varname var
# ... and set the variable to the value we've got.
set var $value
}
}
}}
It's done in an apply so that we don't pollute the global namespace with all our working variables (key, value, varname and var) and because we don't really need to make a procedure for something we're only going to do once.
This isn't a safe piece of code, not by any means, but it is a useful and flexible way to get something working.
In general, parsing command line arguments can take quite a bit of thought to get perfectly right and there's various packages to help out, but that's only really important when writing code for other people to run. When it's just for yourself, you can be a lot sloppier and get the job done in a few minutes.
Using the cmdline package from tcllib you could write:
#!/usr/bin/env tclsh
package require cmdline
set options {
{step.arg "" "Set the step value"}
}
try {
array set params [cmdline::getoptions argv $options]
} on error e {
puts stderr $e
exit 1
}
if {$params(step) ne ""} {
set name $params(step)
}
if {[info exists name]} {
puts "name = $name"
} else {
puts "name is not set"
}

What purpose does upvar serve?

In the TCL code that I currently work on, the arguments in each procedure is upvar'ed to a local variable so to speak and then used. Something like this:
proc configure_XXXX { params_name_abc params_name_xyz} {
upvar $params_name_abc abc
upvar $params_name_xyz xyz
}
From here on, abc and xyz will be used to do whatever. I read the upvar TCL wiki but could not understand the advantages. I mean why cant we just use the variables that have been received as the arguments in the procedure. Could anybody please elaborate?
I mean why cant we just use the variables that have been received as the arguments in the procedure.
You can. It just gets annoying.
Typically, when you pass the name of a variable to a command, it is so that command can modify that variable. The classic examples of this are the set and incr commands, both of which take the name of a variable as their first argument.
set thisVariable $thisValue
You can do this with procedures too, but then you need to access the variable from the context of the procedure when it is a variable that is defined in the context of the caller of the procedure, which might be a namespace or might be a different local variable frame. To do that, we usually use upvar, which makes an alias from a local variable to a variable in the other context.
For example, here's a reimplementation of incr:
proc myIncr {variable {increment 1}} {
upvar 1 $variable v
set v [expr {$v + $increment}]
}
Why does writing to the local variable v cause the variable in the caller's context to be updated? Because we've aliased it (internally, it set up via a pointer to the other variable's storage structure; it's very fast once the upvar has been done). The same underlying mechanism is used for global and variable; they're all boiled down to fast variable aliases.
You could do it without, provided you use uplevel instead, but that gets rather more annoying:
proc myIncr {variable {increment 1}} {
set v [uplevel 1 [list set $variable]]
set v [expr {$v + $increment}]
uplevel 1 [list set $variable $v]
}
That's pretty nasty!
Alternatively, supposing we didn't do this at all. Then we'd need to pass the variable in by its value and then assign the result afterwards:
proc myIncr {v {increment 1}} {
set v [expr {$v + $increment}]
return $v
}
# Called like this
set foo [myIncr $foo]
Sometimes the right thing, but a totally different way of working!
One of the core principles of Tcl is that pretty much anything you can do with a standard library command (such as if or puts or incr) could also be done with a command that you wrote yourself. There are no keywords. Naturally there might be some efficiency concerns and some of the commands might need to be done in another language such as C to work right, but the semantics don't make any command special. They all just plain commands.
The upvar command will allow you to modify a variable in a block and make this modification visible from parent block.
Try this:
# a function that will modify the variable passed
proc set_upvar { varname } {
upvar 1 $varname var
puts "var was $var\n"
set var 5
puts "var is now $var\n"
}
# a function that will use the variable but that will not change it
proc set_no_upvar { var } {
puts "var was $var\n"
set var 6
puts "var is now $var\n"
}
set foo 10
# note the lack of '$' here
set_upvar foo
puts "foo is $foo\n"
set_no_upvar $foo
puts "foo is $foo\n"
As it was mentioned in comment above, it is often used for passing function arguments by reference (call by reference). A picture costs a thousand words:
proc f1 {x} {
upvar $x value
set value 0
}
proc f2 {x} {
set x 0
}
set x 1
f1 x
puts $x
set x 1
f2 x
puts $x
will result in:
$ ./call-by-ref.tcl
0
1
With upvar we changed variable x outside of function (from 1 to 0), without upvar we didn't.

Tcl Output redirection from stdout to a file

I know this question has been asked several times here. I have looked at the responses, but couldn't figure out the way it worked.Can you please help me understand.
Here it goes:
I'm trying to source a tcl script on the tclsh command line, and I want to redirect the output of that script into a file.
$ source my_script.tcl
The script my_script.tcl is something like this:
set output_file final_result
set OUT [open $output_file w]
proc calculate{} {
<commands>
return $result
}
foreach value [calculate] {
puts $output_file "$value"
}
This script still throws out the output onto the stdout, while I expected it to redirect the output into a file specified as "final_result"
Can you please help me understand where I went wrong ?
As you've described here, your program looks OK (apart from minor obvious issues). Your problem is that calculate must not write to stdout, but rather needs to return a value. Or list of values in your case, actually (since you're stuffing them through foreach).
Thus, if you're doing:
proc calculate {} {
set result {}
puts [expr {1 + 2 * 3}]
return $result
}
Then you're going to get output written stdout and an empty final_result (since it's an empty list). If you change that to:
proc calculate {} {
set result {}
lappend result [expr {1 + 2 * 3}]
return $result
}
then your code will do as expected. That is, from puts to lappend result. This is what I recommend you do.
You can capture “stdout” by overriding puts. This is a hack!
rename puts _puts
proc puts {args} {
# Detect where we're running. IMPORTANT!
if {[info level] > 1 && [lindex [info level -1] 0] eq "calculate"} {
upvar 1 result r
lappend r [lindex $args end]
} else {
_puts {*}$args
}
return
}
I'm not convinced that the code to detect whether to capture the value is what it ought to be, but it works in informal testing. (It's also possible to capture stdout itself by a few tricks, but the least horrible — a stacked “transformation” that intercepts the channel — takes a lot more code… and the other alternatives are worse in terms of subtleties.)
Assuming that calculate doesn't write to stdout, and all the other good stuff pointed out and suggested by #DonalFellows has been done...
You need to change the puts in the main script to
puts $OUT "$value"
The script as posted writes to a channel named final_result which almost certainly doesn't exist. I'd expect an error from the puts statement inside the foreach loop.
Don't forget to close the output file - either by exiting from the tclsh interpreter, or preferrably by executing
close $OUT
before you check for anything in it,

"can't read:variable is array" error in ns2

In ns2, I declared a simple array using
array set ktree {}
then I tried to use it as a GOD variable as
create-god $ktree
but this gives the error
can't read "ktree": variable is array
while executing
"create-god $ktree {}"
Any help is greatly appreciated.
In Tcl, $varName means “read from the variable called varName” and is not a general reference to the variable (unlike some other languages, notably Perl and PHP, which do rather different things). Reading from a whole array, instead of an element of that array, is always an error in Tcl.
To pass an array to a command, you pass the name of that array in. It's then up to that command to access it as it sees fit. For procedures and methods written in Tcl, it'll typically involve upvar to link the array into a local view. (Things written directly in C or C++ have far fewer restrictions as they don't automatically push a Tcl stack frame.)
Note however that the command must be expecting the name of an array when you pass that name in. (Good programmers will document this fact, of course.) Whether create-god does, I really have no idea; it's not a general Tcl command but rather something that's more specific. (Part of ns2? Or maybe your own code.)
Example of passing in an array
An example of passing in an array by name is the parray command that should be part of every Tcl distribution. It's a procedure that prints an array out. Here's the source code without a few boiler-plate comments:
proc parray {a {pattern *}} {
upvar 1 $a array
if {![array exists array]} {
error "\"$a\" isn't an array"
}
set maxl 0
set names [lsort [array names array $pattern]]
foreach name $names {
if {[string length $name] > $maxl} {
set maxl [string length $name]
}
}
set maxl [expr {$maxl + [string length $a] + 2}]
foreach name $names {
set nameString [format %s(%s) $a $name]
puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
}
}
The key thing here is that we first see upvar 1 to bind the named variable in the caller to a local variable, and a test with array exists to see if the user really passed in an array (so as to give a good error message rather than a rubbishy one). Everything else then is just the implementation of how to actually pretty-print an associative array (finding out the max key length and doing some formatted output); it's just plain Tcl code.

SWIG + TCL flags

Will the ownership of a pointer last only in the block in which we set the -acquire flag for it?
Eg.:
{
{
$xyz -acquire
}
}
Firstly, Tcl doesn't define blocks with {/}. The scope is defined by the procedure call or namespace.
Secondly, Tcl commands are always defined to have lifetime that corresponds to the namespace that owns them; they are never† scoped to a procedure call. They must be manually disposed one way or another; there are two ways to do this manual disposal: calling $xyz -delete or rename $xyz "" (or to anything else that is the empty string). Frankly, I prefer the first method.
But if you do want the lifespan to be tied to a procedure call, that's actually quite possible to do. It just requires some extra code:
proc tieLifespan args {
upvar 1 "____lifespan handle" v
if {[info exists v]} {
trace remove variable v unset $v
set args [concat [lindex $v 1] $args]
}
set v [concat Tie-Garbage-Collect $args]
trace add variable v unset $v
}
proc Tie-Garbage-Collect {handles var dummy1 dummy2} {
upvar 1 $var v
foreach handle $handles {
# According to SWIG docs, this is how to do explicit destruction
$handle -delete
# Alternatively: rename $handle ""
}
}
That you'd use like this in the scope that you want to tie $xyz's life to:
tieLifespan $xyz
# You can register multiple objects at once too
And that's it. When the procedure (or procedure-like entity if you're using Tcl 8.5 or later) exits, the tied object will be deleted. It's up to you to decide if that's what you really want; if you later disown the handle, you probably ought to not use tying.
† Well, hardly ever; some extensions do nasty things. Discount this statement as it doesn't apply to SWIG-generated code!