I need some help with writing a tcl code, to sort the data from a dictionary. The dictionary saves lists in a .txt file. I need to access the file and sort it through the second column of the lists.
1,0.8,bananas,,,,,
2,1.0,apples,,,,,
3,5.1,grapes,,,,,
4,2.4,oranges,,,,,
5,1.7,pineapples,,,,,
...
how can i sort that dict data, to look like that:
1,0.8,bananas,,,,,
2,1.0,apples,,,,,
5,1.7,pineapples,,,,,
4,2.4,oranges,,,,,
3,5.1,grapes,,,,,
...
please, can you help me making this sorting code?
i tried many codes, but with no sucess.
Tcl's lsort -command option would be useful here.
To use it, first define a proc that takes two arguments (usually called a and b) which returns -1, 0, or 1. Each pair of items in the list will be used as a pair of arguments to this proc.
set lines {
1,0.8,bananas,,,,,
2,1.0,apples,,,,,
3,5.1,grapes,,,,,
4,2.4,oranges,,,,,
5,1.7,pineapples,,,,,
}
proc sort_by_col2 {a b} {
set list_a [split $a ","]
set list_b [split $b ","]
set a2 [lindex $list_a 1]
set b2 [lindex $list_b 1]
if {$a2 < $b2} {
return -1
} elseif {$a2 > $b2} {
return 1
} else {
return 0
}
}
lsort -command sort_by_col2 $lines
--> 1,0.8,bananas,,,,,
2,1.0,apples,,,,,
5,1.7,pineapples,,,,,
4,2.4,oranges,,,,,
3,5.1,grapes,,,,,
Related
I want to convert a column of a file in to list using Tcl Script. I have a file names "input.dat" with the data in two columns as follows:
7 0
9 9
0 2
2 1
3 4
And I want to convert the first column into a list and I wrote the Tcl Script as follows:
set input [open "input.dat" r]
set data [read $input]
set values [list]
foreach line [split $data \n] {
lappend values [lindex [split $line " "] 0]
}
puts "$values"
close $input
The result shows as: 7 9 0 2 3 {} {}
Now, my question is what is these two extra "{}" and what is the error in my script because of that it's producing two extra "{}" and How can I solve this problem?
Can anybody help me?
Those empty braces indicate empty strings. The file you used most probably had a couple empty lines at the end.
You could avoid this situation by checking a line before lappending the first column to the list of values:
foreach line [split $data \n] {
# if the line is not equal to blank, then lappend it
if {$line ne ""} {
lappend values [lindex [split $line " "] 0]
}
}
You can also remove those empty strings after getting the result list, but it would mean you'll be having two loops. Still can be useful if you cannot help it.
For example, using lsearch to get all the values that are not blank (probably simplest in this situation):
set values [lsearch -all -inline -not $values ""]
Or lmap to achieve the same (a bit more complex IMO but gives more flexibility when you have more complex situations):
set values [lmap n $values {if {$n != ""} {set n}}]
The first {} is caused by the blank line after 3 4.
The second {} is caused by a blank line which indicates end of file.
If the last blank line is removed from the file, then there will be only one {}.
If the loop is then coded in the following way, then there will be no {}.
foreach line [split $data \n] {
if { $line eq "" } { break }
lappend values [lindex [split $line " "] 0]
}
#jerry has a better solution
Unless intermittent empty strings carry some meaning important to your program's task, you may also use a transformation from a Tcl list (with empty-string elements) to a string that prunes empty-string elements (at the ends, and in-between):
concat {*}[split $data "\n"]
I have the following code -
#Create a list, call it 'p'
set p {dut.m0.x,dut.m1.y,dut.m2.z,dut.m3.z,dut.a0.vout}
#Here is a procedure to return this list
proc get_ie_conn_ports {ie} {
global p
set my_list {}
foreach n [split $p ","] {
lappend my_list $n
}
return [list $my_list]
}
#This procedure call the previous procedure to retrieve the list
#It then prints it
proc print_ports_and_direction {ie} {
set ie_ports [get_ie_conn_ports ie]
puts $ie_ports
foreach n [split $ie_ports (|\{|\})] {
puts [string trim $n]
}
}
#I call the procedure, dont worry about the argument (place holder for now)
print_ports_and_direction "dut.net00.RL_Bidir_ddiscrete_1.8"
When this list prints, I get this -
dut.m0.x dut.m1.y dut.m2.z dut.m3.z dut.a0.vout
The white space is not being accounted for. Please advise as to how I can print each member on a new line. Thanks for your help!
The value of ie_ports is dut.m0.x dut.m1.y dut.m2.z dut.m3.z dut.a0.vout and you are trying to split on any one of the characters ( | { } ), which are not present in ie_ports, so you will be left with the whole list.
I'm not sure what you are trying to do exactly, but you can iterate on the list itself:
foreach n $ie_ports {
puts [string trim $n]
}
Another issue is that your procedure get_ie_conn_ports is wrapping the list $my_list in another list, which is not needed. You should return the list itself:
proc get_ie_conn_ports {ie} {
global p
set my_list {}
foreach n [split $p ","] {
lappend my_list $n
}
return $my_list
}
You might also want to change the following line:
set ie_ports [get_ie_conn_ports ie]
to
set ie_ports [get_ie_conn_ports $ie]
Running the modifications to your code in codepad gives the following results where each member are on a line:
dut.m0.x
dut.m1.y
dut.m2.z
dut.m3.z
dut.a0.vout
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
I have a file like this:
set position {0.50 0.50}
set visibility false
set text {ID: {entity.id}\n Value: {entity.contour_val}}
And I want to do something similar to source, but I want to use a file handle only.
My current attempt looks like this:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
set cl [expr "$cl + 1"]
set line [gets $fileHandle]
if [$line eq {}] continue
puts $line
namespace eval ::__esg_priv "
uplevel 1 {*}$line
"
info vars ::__esg_priv::*
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
In place of uplevel I tried many combinations of eval and quoting.
My problem is, it either fails on the lines with lists or it does not actuall set the variables.
What is the right way to do it, if the executed commands are expected to be any valid code.
An extra question would be how to properly apply error checking, which I haven't tried yet.
After a call to
readArray [open "myFile.tcl" r] arr
I expect that
parray arr
issues something like:
arr(position) = 0.50 0.50
arr(text) = ID: {entity.id}\n Value: {entity.contour_val}
arr(visibility) = false
BTW: The last line contains internal {}, which are supposed to make it into the string variables. And there is no intent to make this a dict.
This code works, but there are still some problems with it:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
incr cl ;# !
set line [gets $fileHandle]
if {$line eq {}} continue ;# !
puts $line
namespace eval ::__esg_priv $line ;# !
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
I've taken out a couple of lines that didn't seem necessary, and changed some lines a bit.
You don't need set cl [expr "$cl + 1"]: incr cl will do.
if [$line eq {}] continue will fail because the [...] is a command substitution. if {$line eq {}} continue (braces instead of brackets) does what you intend.
Unless you are accessing variables in another scope, you won't need uplevel. namespace eval ::__esg_priv $line will evaluate one line in the designated namespace.
I didn't change the following, but maybe you should:
set varName [string map { ::__esg_priv:: "" } $varPath] works as intended, but set varName [namespace tail $varPath] is cleaner.
Be aware that if there exists a global variable with the same name as one of the variables in your file, no namespace variable will be created; the global variable will be updated instead.
If you intend to use the value in the text variable as a dictionary, you need to remove either the \n or the braces.
According to your question title, you want to evaluate the file line by line. If that requirement can be lifted, your code could be simplified by reading the whole script in one operation and then evaluating it with a single namespace eval.
ETA
This solution is a lot more robust in that it reads the script in a sandbox (always a good idea when writing code that will execute arbitrary external code) and redefines (within that sandbox) the set command to create members in your array instead of regular variables.
proc readArray {fileHandle arrayName} {
upvar 1 $arrayName arr
set int [interp create -safe]
$int alias set apply {{name value} {
uplevel 1 [list set arr($name) $value]
}}
$int eval [read $fileHandle]
interp delete $int
}
To make it even more safe against unexpected interaction with global variables etc, look at the interp package in the Tcllib. It lets you create an interpreter that is completely empty.
Documentation: apply, continue, eof, foreach, gets, if, incr, info, interp package, interp, list, namespace, proc, puts, set, string, uplevel, upvar, while
I'm producing a TCL procedure that will return a list of arrays of devices under a switch. The definition is an XML file that is read. The resulting lists of XML entries are parsed using a recursive procedure and the device attributes are placed in an array.
Each array is then placed in a list and reflected back to the caller. My problem is that when I print out the list of devices, the last device added to the list is printed out each time. The contents of the list is all duplicates.
Note: I'm using the excellent proc, 'xml2list' that was found here. I'm sorry, I forgot who submitted this.
The following code illustrates the problem:
source C:/src/tcl/xml2list.tcl
# Read and parse XML file
set fh [open C:/data/tcl/testfile.xml r]
set myxml [read $fh]
set mylist [xml2list $myxml]
array set mydevice {}
proc devicesByName { name thelist list_to_fill} {
global mydevice
global set found_sw 0
upvar $list_to_fill device_arr
foreach switch [lindex $thelist 2] {
set atts [lindex $switch 1]
if { [lindex $switch 0] == "Switch" } {
if { $name == [lindex $atts 3] } {
set found_sw 1
puts "==== Found Switch: $name ===="
} else {
set found_sw 0
}
} elseif { $found_sw == 1 && [string length [lindex $atts 3]] > 0 } {
set mydevice(hdr) [lindex $switch 0]
set mydevice(port) [lindex $atts 1]
set mydevice(name) [lindex $atts 3]
set mydevice(type) [lindex $atts 5]
puts "Device Found: $mydevice(name)"
set text [lindex $switch 2]
set mydevice(ip) [lindex [lindex $text 0] 1]
lappend device_arr mydevice
}
devicesByName $name $switch device_arr
}
}
#--- Call proc here
# set a local array var and send to the proc
set device_arr {}
devicesByName "Switch1" $mylist device_arr
# read out the contents of the list of arrays
for {set i 0} {$i<[llength $device_arr]} {incr i} {
upvar #0 [lindex $device_arr $i] temp
if {[array exists temp]} {
puts "\[$i\] Device: $temp(name)-$temp(ip)"
}
}
The XML file is here:
<Topology>
<Switch ports="48" name="Switch1" ip="10.1.1.3">
<Device port="1" name="RHEL53-Complete1" type="host">10.1.1.10</Device>
<Device port="2" name="Windows-Complete1" type="host">10.1.2.11</Device>
<Device port="3" name="Solaris-Complete1" type="host">10.1.2.12</Device>
</Switch>
<Switch ports="36" name="Switch2" ip="10.1.1.4">
<Device port="1" name="Windows-Complete2" type="host">10.1.3.10</Device>
</Switch>
<Router ports="24" name="Router1" ip="10.1.1.2">
<Device port="1" name="Switch1" type="switch">10.1.1.3</Device>
<Device port="2" name="Switch2" type="switch">10.1.1.4</Device>
</Router>
</Topology>
If my code blocks look bad, please excuse that. I followed the directions as I read them, but it didn't look correct. I could not fix it, so just posted anyway.
Thanks in advance...
Arrays in tcl are not values. Therefore they don't behave like regular variables. They are in fact something special like filehandles or sockets.
You cannot assign an array to a list like that. Doing:
lappend device_arr mydevice
simply appends the string "mydevice" to the list device_arr. That string happens to be the name of a global variable so that string may be used later to access that global variable.
To build up a key-value data structure what you want is a dict. You can think of a dict as a special list that has even numbers of elements in the format: {key value key value}. In fact, this data structure works even on very old versions of tcl before the introduction of dicts because the foreach loop in tcl can be used to process key-value pairs.
So what you want is to create a new $mydevice dict each loop and use [dict set] to assign the values.
Alternatively you can keep most of your code and change your lappend to:
lappend device_arr [array get mydevice]
This works because [array get] returns a key-value list which can be treated as a dict. You can later access the data using the dict command.
Array variables can't be used as values. To put the contents of one into a list element, send it to a proc, write it to a file etc, convert it to list form (key, value, key, value...) with array get.
lappend device_arr [array get mydevice]
To use it later, write the list back to an array with array set.
foreach device_l $device_arr {
#array unset device
array set device $device_l
puts "$device(name)-$device(ip)"
}
Note that array set doesn't erase the old keys in the destination array, so if you use it in a loop and the key names aren't always the same, you need to clear the array every iteration.
You can store this information in two ways using arrays . First is as a multi-dimensional array, in this case a three dimensional array and the second is a one dimensional array storing a list that can be converted easily to an array later for accessing data at a later time.
For the 3d array the key would be Switch Name,device_port,dataname you would change your erroneous temporary myDevice and lappend code to
# attr is a list of { attributename1 value1 ... attributenameN valueN}
array set temp $attr
set port $temp(port)
set text [lindex $switch 2]
set ip [lindex [lindex $text 0] 1]
# name already set to "Switch1" etc
foreach f [array names temp ] {
set device_arr($name,$port,$f) $temp($f)
}
set device_arr($name,$port,ip) $ip
array unset temp
this code results in the following ( when parray device_arr
parray device_arr
device_arr(Switch1,1,name) "Switch1"
device_arr(Switch1,1,port) 1
device_arr(Switch1,1,type) "RedHat .."
device_arr(Switch1,1,ip) 10..
device_arr(Switch1,2,name) "Switch1"
device_arr(Switch1,2,port) 1
device_arr(Switch1,2,type) "RedHat .."
device_arr(Switch1,2,ip) 10..
...
device_arr(Switch2,1,name) "Switch1"
device_arr(Switch2,1,port) 1
device_arr(Switch2,1,type) "Windows Complete"
device_arr(Switch2,1,ip) 10..
....
to find ip of Switch1 port2 you would:
puts "the ip of Switch1 port 2 is $device_arr(Switch1,2,ip)"
Note lots of data duplication but you can access all data directly without having to go to an intermediate step to get to the data as in the next scheme
# attr is a list of { attributename1 value1 ... attributenameN valueN}
set data $attr
array set temp $attr
set text [lindex $switch 2]
set ip [lindex [lindex $text 0] 1]
lappend data ip $ip
set key "$name,$temp(port)"
# name already set to "Switch1" etc
set device_arr($name,$port) $data
array unset temp
doing a parray device_arr gives:
device_arr(Switch1,1) { port "1" name "RHEL53-Complete1" type "host" ip 10.1.1.10 }
device_arr(Switch1,2) { port "2" name "Windows-Complete1" type "host" ip 10.1.2.11}
....
to find the ip of swtich1 port 2 you would
array set temp $device_array(Switch1,2)
puts "ip of device 2 is $temp(ip)"