How to find corresponding values in columns using TCL - tcl

I'm a regular matlab user who needs to do some processing in TCL. I have no experience with tcl so up to now what I have done is by searching on google.
Please pardon novice ways...
I have data in column A and B which is imported via file Data_1, I would like to get the corresponding values from column B for two numbers in column A e.g.
when A is 0.1 then B is 9 and when A is 0.3 then B is 21, store 9 & 21 in variable for later use
I'd like to open another file Data_2, which has two columns C and D.
I'd like to take all the numbers of column D that fall between Column 9 and 21 (positive numbers) in Column C and average it and put it in a variable for later use.
I've started with first trying to find corresponding values for 0.1 and 0.3, and that is where I am stuck.
I can (I think) find 0.1 and 0.3 but don't know how to get the corresponding values from column B
And then proceed ahead with the second part.
Please help.
Data_1 Data__2
Column A Column B Column C Column D
0 0 180 14.5
0.01 1.5 162 13.05
0.02 3 144 11.6
0.03 4.5 126 10.15
0.04 6 108 8.7
0.05 7.5 90 7.25
0.1 9 72 5.8
0.125 10.5 54 4.35
0.15 12 20 2.9
0.175 13.5 10 1.45
0.2 15 0 0
0.225 16.5 -10 -1.45
0.25 18 -20 -2.9
0.275 19.5 -54 -4.35
0.3 21 -72 -5.8
0.325 22.5 -90 -7.25
0.35 24 -108 -8.7
0.0.375 25.5 -126 -10.15
0.4 27 -144 -11.6
0.425 28.5 -162 -13.05
0.45 30 -180 -14.5
# Open files for reading
set input1 [open "Data_1.dat" r]
set input2 [open "Data_2.dat" r]
#read file
set file_data [read $input1]
#close file
close $input1
#split into lines
set data [split $file_data "\n"]
foreach line $data {
set val1 [lsearch -inline $line 0.1]
set val2 [lsearch -inline $line 0.3]
puts $val1
puts $val2
}

I'd write this:
set min_key 0.1
set max_key 0.3
set fid [open Data_1.dat r]
while {[gets $fid line] != -1} {
lassign $line a b
if {$a == $min_key} {
set min $b
}
if {$a == $max_key} {
set max $b
}
}
close $fid
set fid [open Data_2.dat r]
while {[gets $fid line] != -1} {
lassign $line c d
if {$min <= $d && $d <= $max} {
lappend values $c
}
}
close $fid
puts [join $values \n]
This outputs
180
162
144
126
Notes:
use a while loop to iterate over the lines of a file.
lassign assigns values of a list to variables

I didn't quite follow all of the if/else logic in your post, but there are several ways you can process the files. From your example, you can store the A and B columns as two separate lists.
set acol [list]
set bcol [list]
set data [split $file_data "\n"]
foreach line $data {
lappend acol [lindex $line 0]
lappend bcol [lindex $line 1]
}
# Find the first column A value that is 0.1.
set index [lsearch -real $acol 0.1]
# Get the corresponding B value.
puts "b value: [lindex $bcol $index]"
You can probably also just simplify the foreach-loop to this, without splitting the file data into lines.
foreach {val1 val2} $file_data {
lappend acol $val1
lappend bcol $val2
}

Related

Finding "lsort" indices in .tcl

How can we obtain indices of lsort?
For example:
lsort -real {1 -4 6 0}
how can I obtain indices for the code above as idx = (1, 3, 0, 2)?
The -indices option to lsort does exactly what you want:
set values {1 -4 6 0}
set indices [lsort -indices -real $values]
foreach idx $indices {
puts "[lindex $values $idx] is at $idx"
}
Output:
-4 is at 1
0 is at 3
1 is at 0
6 is at 2

Robust way to pick value from X-Y table in TCL

I would like to know the most robust method for extracting Y Value for a given X Value from column of X-Y data.
I am currently performing this operation with the following code, but is very unreliable/flakey as it keeps falling over with error of can't read or no variable var_01
Please advice.
Iterate based on Column Z
for {set i 0} {$i < [llength $Col_z]} {incr i} {
set Xdata [lindex $Col_x $i]
set Ydata [lindex $Col_y $i]
lappend var $Ydata
if { $Xdata >= 0.9 && $Xdata <= 1.1 } {
set a [lindex $var $i]
lappend var_01 $a
} else {lappend var_01 0
#set var_01 0}
}
It's very hard to work out what you want to do, but maybe it helps to simplify the code a bit:
foreach z $Col_z x $Col_x y $Col_y {
if {$z eq {}} {
break
}
if {$x >= 0.9 && $x <= 1.1} {
lappend var_01 $y
} else {
lappend var_01 0
}
}
Edit according to comment: is this better?
set var_01 {}
foreach z $Col_z x $Col_x y $Col_y {
if {$z eq {}} {
break
}
if {$x >= 0.9 && $x <= 1.1} {
lappend var_01 $y
}
}
Note that var_01 might be empty if no value of x is within the range.
Documentation:
&& (operator),
<= (operator),
>= (operator),
break,
eq (operator),
foreach,
if,
lappend,
set
A very convenient way to represent tables in tcl is by simple array. Here is an example:
array set xy {}
foreach i {1 2 3} {
foreach j {10 20 30} {
set xy($i,$j) [expr $i + $j]
}
}
Now xy is an array whose keys look like table indexes. Here:
% array names xy
3,10 2,20 1,30 3,20 2,30 3,30 1,10 2,10 1,20
Or more clear:
% foreach k [array names xy] {puts $k}
3,10
2,20
1,30
3,20
2,30
3,30
1,10
2,10
1,20
Here is how to access them:
% puts $xy(3,10)
13
The 3,10 inside the parenthesis is a string! The array returns the value associated with that string, which was associated in the above loop. (Therefore there must not be space after the comma).
It's easy to access the values if the indexes are given in variables:
% set x 3
3
% set y 10
10
% puts $x,$y
3,10
The last command is equivalent to explicit quotation marks:
% puts "$x,$y"
3,10
And here is how we access the array element at that key:
% puts $xy($x,$y)
13
And if the key doesn't exist:
% puts $xy(4,10)
can't read "xy(4,10)": no such element in array
Let's conclude with printing the keys and values of the array:
% foreach k [array names xy] {puts "$k: $xy($k)"}
3,10: 13
2,20: 22
1,30: 31
3,20: 23
2,30: 32
3,30: 33
1,10: 11
2,10: 12
1,20: 21
ADDED
Now suppose you have the y and z values, how do you find the x?
set y 20
set z 23
Using the special, powerful tcl property of everything is a string:
Here we find all keys and values matching the key pattern *,20:
set results [array get xy *,$y]
Let's see:
puts $results
% 2,20 22 3,20 23 1,20 21
We got a list of 3 pairs, each contains the key and value.
Now let's extract the key/value that corresponds to outr $z. We will use the powerful regexp tcl command, seeing $results now as a string instead of a list:
regexp "(\\d+),($y) ($z)" $results whole x1 y1 z1
And now x1, y1, z1 hold all the information we want:
puts "$x1 $y1 $z1"
% 3 20 23

Loop through all combinations of arrays (variable size)

In tcl I need to execute a script for each possible combination of values of an unknown number of variables.
Describing it in words:
A goes from a0 -> a1 with steps of "da"
B goes from b0 -> b1 with steps of "db"
C goes from c0 -> c1 with steps of "dc"
....
The number of variables can vary. Note: The names of the variables are not known beforehand, 'A' could also be called 'Ape' or anything else. Same goes for the other variables.
What I have so far is:
array set min_vals {A $a0 B $b0 C $c0 ...} ;# --> These are user-defined
array set max_vals {A $a1 B $b1 C $c1 ...} ;# --> These are user-defined
array set step_vals {A $da B $db C $dc ...} ;# --> These are user-defined
# First I determine the number of variables and the number of values they can have
set nr_vars [array size min_vals] ;# Determine nr of variables
set nr_vals [list] ;# --> Set empty list for nr of values for each variable
foreach var_name [array names min_vals] {
set nr [expr {round( ( $max_vals(${var_name})-$min_vals(${var_name}) ) / $step_vals(${var_names}) )}]
set nr_vals [concat $nr_vals $nr]
}
Now I need to somehow loop through each possible combination:
[A=a0, B=b0, C=c0]
[A=a0+da, B=b0, C=c0]
[A=a0+2*da, B=b0, C=c0]
...
...
[A=a1, B=b0, C=c0]
[A=a0, B=b0+db, C=c0]
[A=a0+da, B=b0+db, C=c0]
...
...
[A=a1, B=b1, C=c1]
I hope there is an easy way to do this. The only way I could think of doing this was by having a single loop with number of iterations containing all combinations and let each iteration-number correspond to a specific combination. But I'm sure there must be a less cumbersome way.
_
Edit:
Maybe I wasn't really clear about what I exactly wanted. I don't care about the actual output. My aim is to set each variable to the correct value and run another script with these variables:
set A $a0
set B $b0
set C $c0
source run/some/script.tcl
And repeat this for each possible combination of values of A, B and C.
Use nested for loops
for {set a $min_vals(A)} {$a <= $max_vals(A)} {incr a $step_vals(A)} {
for {set b $min_vals(B)} {$b <= $max_vals(B)} {incr b $step_vals(B)} {
for {set c $min_vals(C)} {$c <= $max_vals(C)} {incr c $step_vals(C)} {
do something with [list $a $b $c]
}
}
}
Ah, needs to be more dynamic. Hmmm,
set variables {A B C}
array set min_vals {A 1 B 10 C 100}
array set max_vals {A 3 B 30 C 300}
array set step_vals {A 1 B 10 C 100}
proc build_loops {} {
global variables
# create the "seed" code: what to do with the generated tuple
set code "do_something_with \[list "
foreach var $variables {
append code "\$[loop_var $var] "
}
append code "]"
# and wrap layers of for loops around the seed
foreach var [lreverse $variables] {
set loop_var [loop_var $var]
set code [format {for {set %s $min_vals(%s)} {$%s <= $max_vals(%s)} {incr %s $step_vals(%s)} {%s}} \
$loop_var $var \
$loop_var $var \
$loop_var $var \
$code \
]
}
return $code
}
proc loop_var {varname} {
return "loop_[string tolower $varname]"
}
proc do_something_with {args} {
puts $args
}
set code [build_loops]
puts $code
eval $code
for {set loop_a $min_vals(A)} {$loop_a <= $max_vals(A)} {incr loop_a $step_vals(A)} {for {set loop_b $min_vals(B)} {$loop_b <= $max_vals(B)} {incr loop_b $step_vals(B)} {for {set loop_c $min_vals(C)} {$loop_c <= $max_vals(C)} {incr loop_c $step_vals(C)} {do_something_with [list $loop_a $loop_b $loop_c ]}}}
{1 10 100}
{1 10 200}
{1 10 300}
{1 20 100}
{1 20 200}
{1 20 300}
{1 30 100}
{1 30 200}
{1 30 300}
{2 10 100}
{2 10 200}
{2 10 300}
{2 20 100}
{2 20 200}
{2 20 300}
{2 30 100}
{2 30 200}
{2 30 300}
{3 10 100}
{3 10 200}
{3 10 300}
{3 20 100}
{3 20 200}
{3 20 300}
{3 30 100}
{3 30 200}
{3 30 300}
I keep a separate list of the variable names: [array names a] returns an unordered list of names, and (I assume) it is important to know the order of the tuple given to the do_something_with proc

First value from second column with the smallest value from column 1

I have this file
2 1
12 2
34 1
56 1
45 3
33 2
77 1
83 2
62 3
75 3
I want to take the first value from second column with the smallest value from column 1
like this
2 1
12 2
45 3
This can be done with a linear scan and a little bit of use of an associative array, something like this:
set f [open $filename]
foreach line [split [read $f] "\n"] {
# ASSUME: valid Tcl list of numbers
lassign $line col1 col2
if {![info exists minima($col2)] || $minima($col2) > $col1} {
set minima($col2) $col1
}
}
close $f
foreach col2 [array names minima] {
puts "$minima($col2) $col1"
}
Imposing whatever sorts of parsing, sorting and formatting you require are left to you.

TCL sort a file mathematically

I have a file which has multiple lines like :-
A B A 10 20
A B A 10 20
C D A 10 15
A B Q 15 20
A B A 35 45
A B A 15 20
C D A 10 15
A B A 20 25
.
.
.
A A A x1 y1
The first three fileds are some text patterns.
Now I want to write a program in TCL which does BOTH of the following:-
Does a unique sort "sort -u" for the file & reoves the repeated lines & dumps the O/P in new file.
For case where 1st three field is same dump only those lines where the numbers are greater than 10 from each other.
For eg the O/P of above file satisfying both conditions will be:-
A B A 10 20
A B A 35 45
C D A 10 15
A B Q 15 20
The order of lines is not important in file.
##Changed the program
set input [open "data.txt" "r"]
set content [read $input]
set lines [lsort -unique [split $content "\n"]]
set keylist ""
set valuelist ""
foreach line $lines {
if {$line == ""} { continue }
set data [split $line " "]
set key [join [lrange $data 0 2] "_"]
set index [lsearch $keylist $key]
if {$index != -1} {
set value [lindex $valuelist $index]
set diff_a [expr [lindex $data 3] - [lindex $value 0]]
set diff_b [expr [lindex $data 4] - [lindex $value 1]]
if {$diff_a > 10 && $diff_b > 10 } {
puts $line
}
set a [ lreplace valuelist $index $index [lrange $data 3 4]]
set valuelist $a
} else {
lappend keylist $key
lappend valuelist [lrange $data 3 4]
puts $line
}
}
It's not a smart solution, but works.
set input [open "data.txt" "r"]
set content [read $input]
set lines [lsort -unique [split $content "\n"]]
set keylist ""
set valuelist ""
foreach line $lines {
if {$line == ""} { continue }
set data [split $line " "]
set key [join [lrange $data 0 2] "_"]
set index [lsearch $keylist $key]
if {$index != -1} {
set value [lindex $valuelist $index]
set diff_a [expr [lindex $data 3] - [lindex $value 0]]
set diff_b [expr [lindex $data 4] - [lindex $value 1]]
if {$diff_a > 10 && $diff_b > 10 } {
puts $line
}
set valuelist [lreplace valuelist $index $index [lrange $data 3 4]]
} else {
lappend keylist $key
lappend valuelist [lrange $data 3 4]
puts $line
}
}
Output:
A B A 10 20
A B A 35 45
A B Q 15 20
C D A 10 15