Foreach for TCL List - tcl

I would like to ask a question regarding TCL.
Let say I have an instance 111 and under this 3 instances (11100, 11102, 11103) are attached. You may say 11100, 11102, 11103 are id's and then there are names attached to these ids such as A, B, C.
At the moment I got all these ids 11100, 11102, 11103 how can use these ids in loop to iterate in loop for three time so I can find each ids name.

This is how you can iterate loop over the ids what you already have,
foreach i {11101 11102 11103} {
puts $i
;# do what ever with i
}
Another option what you said is you have three variable A B C,
lappend list $A $B $C
foreach i $list {
puts $i
;# do what ever with i
}

Related

sorting a tcl dictionary inside txt file

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,,,,,

function to calculate the sum of a given array

I am new to Tcl so i am learning the basics. I wrote a function to calculate the sum of an array and print its elements. Here is the code
proc print_sum { tab } {
set s 0
foreach key [array names tab] {
puts "${key}=$tab($key)"
incr $s $tab($key)
}
puts "the sum = $s"
}
Here is how I called it:
print_sum tab
and I created the tab like this:
set tab("1") 41
set tab("m2") 5
set tab("3") 3
set tab("tp") 9
set tab("2") 7
set tab("100") 16
But the output is wrong! It outputs 0 instead of the actual sum and it does not output any element. But when I used the code directly without writing it in a function, it works.
The issue is that you're passing the string "tab" to the proc, and then you store that in the variable name "tab". This is just a plain variable, not an array, so when you do array names tab, you get an empty list back. The foreach loop loops zero times, and the sum is still zero.
You need to use the upvar command to link to the "tab" array in the caller's stack frame:
proc print_sum { arrayName } {
upvar 1 $arrayName a ;# "alias" the array in the caller's scope
set s 0
foreach key [array names a] {
puts "${key}=$a($key)"
incr s $a($key) ;# increment the *variable* not the *variablevalue*
}
puts "the sum = $s"
}
print_sum tab
outputs
"tp"=9
"100"=16
"1"=41
"2"=7
"3"=3
"m2"=5
the sum = 81

How to count repeated words from the list

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

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