How to sum coordinates in TCL - tcl

I have a data file (*.dat) containing x, y, z coordinates. As following:
{26.3612117767334 40.19668960571289 54.13957977294922}
{27.351043701171875 40.57518768310547 54.05387496948242}
{29.48208999633789 42.08218765258789 56.42238235473633}
For this file I need to do a math operation as follow:
Xi + (Xf-Xi/4) ; Yi + (Yf-Yi/4) ; Zi + (Zf-Zi/4)
where "i" is the initial position and "f" the final, meaning that Xi,Yi,Zi are the data on the first line and Xf,Yf,Zf the data on the second.
I need to do these calculation for all the lines in a loop and then stored in a separate file, but I do not have idea how to do it in TCL. Thanks in advance for your help.

Since the contents of your file can be treated as a bunch of tcl lists, one per line (so basically a list of lists), parsing it is dead simple.
Something like:
set f [open file.dat]
set coords [read -nonewline $f]
close $f
for {set i 0} {$i < [llength $coords] - 1} {incr i} {
lassign [lindex $coords $i] xi yi zi
lassign [lindex $coords $i+1] xf yf zf
set xn [expr {$xi + ($xf - $xi/4.0)}]
set yn [expr {$yi + ($yf - $yi/4.0)}]
set zn [expr {$zi + ($zf - $zi/4.0)}]
puts "{$xn $yn $zn}"
}
This skips treating the last line as an initial set of coordinates because there is no next set for it.

This is a good opportunity to write a mathfunc:
proc tcl::mathfunc::f {ai af} {
expr {$ai * 0.75 + $af}
}
proc transform {file} {
set fh [open $file]
# read the first line, aka the initial "previous line"
gets $fh line
scan $line {{%f %f %f}} xi yi zi
# process the rest of the file
while {[gets $fh line] != -1} {
scan $line {{%f %f %f}} xf yf zf
puts "{[expr {f($xi, $xf)}] [expr {f($yi, $yf)}] [expr {f($zi, $zf)}]}"
lassign [list $xf $yf $zf] xi yi zi
}
close $fh
}
transform file.dat
outputs
{47.121952533721924 70.72270488739014 94.65855979919434]}
{49.9953727722168 72.51357841491699 96.96278858184814]}

I present an alternate method that uses lrange to pick the overlapping ranges of sublists that participate (so we can then process them element-wise) and then lmap to apply the same transformation expression to each coordinate axis.
# Same read-in code as Shawn's answer; it's the easiest way
set f [open file.dat]
set coords [read -nonewline $f]
close $f
foreach Ci [lrange $coords 0 end-1] Cf [lrange $coords 1 end] {
# I often like to put expressions on their own line for clarity
puts [list [lmap _i $Ci _f $Cf {expr {
$_i + ($_f - $_i/4.0)
}}]]
}
(The wrapping list call in there puts braces around the result of lmap.)

Related

How to recall a variable within the "string map" option in tcl

I want to sequentially update a series of file, from a tmp file distTmp.RST to sequentially dist1.RST, dist2.RST, etc..
For me, the fileutil package in vmd text interface is not working as follows:
My tcl code (add.tcl):
package require fileutil
set F 20.5
set Ff ""
for {set f 0} {$f < 70} {incr f} {
set F [expr {$F+1}]
lappend Ff $F
}
puts $Ff
for {set f 0} {$f < 70} {incr f} {
set M [lindex $Ff $f]
set N [expr {$f+1}]
package require fileutil
::fileutil::updateInPlace distTmp.RST {string map {WWW $M}}
::fileutil::cat dist$N.RST
}
========
The error occurring is
vmd > source add.tcl
can't find package fileutil
vmd >
========
Moreover, when I do not use "fileutil" package, my script is as follows:
set F 20.5
set Ff ""
for {set f 0} {$f < 70} {incr f} {
set F [expr {$F+1}]
lappend Ff $F
}
puts $Ff
for {set f 0} {$f < 70} {incr f} {
set M [lindex $Ff $f]
set N [expr {$f+1}]
set dat [open "distTmp.RST" r]
set out [open "dist$N.RST" w]
while {[gets $dat line] >= 0} {
set newline [string map {WWW $$M} $line]
puts $out $newline
}
}
======
But, there is a problem in recalling the variable $M within a string, and my required output files are as follows:
(base) [Prathit#master]~/APP/OnlyAPP/AlphaFold2/770_res/Charmm-Gui_Dimer-units/E2-E2_3222212666/charmm-gui-3222212666/amber/RSTfiles_Equil>head -n +4 dist1.RST dist2.RST
=> dist1.RST <==
&rst iat = -1, -1, r2 = $$M, r2a = $$M,
==> dist2.RST <==
&rst iat = -1, -1, r2 = $$M, r2a = $$M,
==========
In the above, $$M should be sequentially 21.5, 22.5, and so on....
Kindly let me know of a possible solution.
The fileutil package is part of tcllib. Check that your variable auto_path includes a path where Tcl can find tcllib and fileutil.
Your list for string map is in curly braces, so it's using a literal dollar sign for $M instead of the value of the variable named M.
Change curlies to double quotes or use the list command, as answered in a comment already.
$$M is usually not okay in Tcl. Are you trying to do double interpolation? If so, I recommend using set with one argument, to retrieve a value instead of to set a value. You can use $$ in a subst command, but that's not my preference.
set name John
set var_name name
puts $$var_name --> $name
puts [set $var_name] --> John
puts [set [set var_name]] --> John
puts [subst $$var_name] --> John

Tcl could not save floating point numbers in binary format

I am trying to save a list of numbers in binary format (floating point single)
but Tcl cant save it correctly and I could not gain to correct number when i read the file from vb.net
set outfile6 [open "btest2.txt" w+]
fconfigure stdout -translation binary -encoding binary
set aa {}
set p 0
for {set i 1} {$i <= 1000 } {incr i} {
lappend aa [expr (1000.0/$i )]
puts -nonewline $outfile6 [binary format "f" [lindex $aa $p]]
incr p
}
close $outfile6
Tcl cant save it correctly
There are two glitches in your snippet:
the missing brackets for nested command evaluation around lindex (see my comment): [lindex $aa $p]
you fconfigured the stdout, rather than your file channel: fconfigure $outfile6 -translation binary
With this fixed, the following works for me:
set outfile6 [open "btest2.txt" w+]
fconfigure $outfile6 -translation binary
set aa {}
set p 0
for {set i 1} {$i <= 1000 } {incr i} {
lappend aa [expr (1000.0/$i )]
puts -nonewline $outfile6 [binary format "f" [lindex $aa $p]]
incr p
}
close $outfile6
Suggestions for improvement
Your snippet seems overly complicated to me, esp. the loop construct. Simplify to:
Better use [scan %f $value] to explicitly turn a value into the floating point representation, rather than [expr]?
[binary format] takes a counter or wildcard, like f*, to process multiple values: [binary format "f*" $aa]
You don't need the loop variables p, use [lindex $aa end]; or better a loop variable to hold the single added element (rather than to collect it from the list again).
-translation binary implies -encoding binary

What is the reason of error "Floating point exception (core dumped)"

I'm trying to save output $result of proc Inverse2 which get scheduled after every one second (it is called inside another procedure,that procedure is rescheduled for 1s that is why Inverse2 procedure)
I want to get output which is {x y now} and assign variable to it for latest two instances
x1-> x location at current time (for example at 8.0)
y1-> y location at current time
x2-> x location at (current time+1) (for example at 9.0)
y2-> y location at (current time+1)
and use for further calculations.
Below is a code I have tried but error I got after two iterations is Floating point exception (core dumped). Where I'm doing wrong?
code:
set result {}
proc Inverse2 {m} {
set op [open output.tr w]
global result
global ns
set now [$ns now]
lassign [lindex $m 0 2] x1
lassign [lindex $m 0 3] y1
lassign [lindex $m 0 6] d1
lassign [lindex $m 1 2] x2
lassign [lindex $m 1 3] y2
lassign [lindex $m 1 6] d2
lassign [lindex $m 2 2] x3
lassign [lindex $m 2 3] y3
lassign [lindex $m 2 6] d3
set mt {{? ?} {? ?}}
lset mt 0 0 [expr 2*($x1-$x2)]
lset mt 0 1 [expr 2*($y1-$y2)]
lset mt 1 0 [expr 2*($x1-$x3)]
lset mt 1 1 [expr 2*($y1-$y3)]
set const {{?} {?}}
lset const 0 [expr {(pow($x1,2)+pow($y1,2)-pow($d1,2))-(pow($x2,2)+pow($y2,2)-pow($d2,2))}]
lset const 1 [expr {(pow($x1,2)+pow($y1,2)-pow($d1,2))-(pow($x3,2)+pow($y3,2)-pow($d3,2))}]
#puts $result "$const"
# puts $result "$mt"
set x [expr {double([lindex [Inverse3 $mt] 0 0] * [lindex $const 0]
+ [lindex [Inverse3 $mt] 0 1] * [lindex $const 1])}]
set y [expr {double([lindex [Inverse3 $mt] 1 0] * [lindex $const 0]
+ [lindex [Inverse3 $mt] 1 1] * [lindex $const 1])}]
lappend result "$x $y $now"
puts $result
for {set i 0} {$i< [llength $result]} {incr i} { #for latest two instances
for {set j 1} {$i< [llength $result]} {incr j} {
set X1 [lindex $result $i 0]
set Y1 [lindex $result $i 1]
if {[llength $result] >1} { #to ensure length of list is greater than 1
set X2 [lindex $result $j 0]
set Y2 [lindex $result $j 1]
set v [expr hypot($X2-$X1,$Y2-$Y1)/ ($now-($now-1))]
set theta [expr acos(($X2-$X1)/(hypot($X2-$X1,$Y2-$Y1)))]
set Xp [expr ($X2+($v*$now*cos($theta)))]
set Yp [expr ($Y2+($v*$now*sin($theta)))]
puts "$Xp $Yp"
}
break
}
}
}
Floating point exceptions can come from a few different things. In general, the main culprit is doing something awful like dividing zero by zero. However, Tcl is usually pretty good at ensuring that such things don't crash your program entirely, and instead just generate errors you can catch. Whatever is going on is therefore either one of the trickier cases, or due to running in ns2 and that turning signalling floating point errors on (Tcl's standard implementation disables them precisely to avoid probably-unwarranted fatal crashes).
If it is the latter, moving the processing out of the process into a standard tclsh is the easiest way forward. We can make stronger guarantees about the correctness of behaviour there as we have more control of tricky things like FPU flags.
But if it is the former… the problem should lie in these lines:
set v [expr hypot($X2-$X1,$Y2-$Y1)/ ($now-($now-1))]
set theta [expr acos(($X2-$X1)/(hypot($X2-$X1,$Y2-$Y1)))]
set Xp [expr ($X2+($v*$now*cos($theta)))]
set Yp [expr ($Y2+($v*$now*sin($theta)))]
Of the lines there, the one that looks most suspicious is the calculation of theta. There's several problems with what you're doing (e.g., it won't handle some quadrants correctly due to trigonometric periodicities) but the big nasty is that you've got a division in there that will be by zero if two successive positions are the same. Given that you're able to use hypot(), computing the angle is by far best computed with atan2(), as that deals with tricky edge cases much better (e.g., it has no problems with awful infinities). Try this:
set theta [expr { atan2($Y2-$Y1, $X2-$X1) }]
Also put your expressions in {braces} as I've done above. It permits Tcl to bytecode-compile the expression and makes your code quite a bit faster. It also lets you put spaces in the expression safely, which aids readability a lot even when you're not splitting over multiple lines, and ensures you get (much!) better error messages if you ever happen to use a variable holding a non-numeric value in your expression. In short, it's easy to do and makes your code much better.
Other minor issues
Do you expect ($now-($now-1)) to ever compute anything other than 1? Or at least a value very close to 1.0, given that you're dealing with floating point numbers for simulation time? I think your calculation of v can be safely simplified down to straight use of hypot().
These two nested loops look odd:
for {set i 0} {$i< [llength $result]} {incr i} {
for {set j 1} {$i< [llength $result]} {incr j} {
I think you either mean to do this:
for {set i 0} {$i< [llength $result]} {incr i} {
for {set j 0} {$j< [llength $result]} {incr j} {
if {$i == $j} continue; # Skip the diagonal in the comparison matrix
or this:
for {set i 0} {$i< [llength $result]} {incr i} {
for {set j [expr {$i + 1}]} {$j< [llength $result]} {incr j} {
# Just the upper triangle of the comparison matrix
depending on whether the rest of the code should compare values from both ways round (but never with itself), or just one way round. The latter does less work, but might be wrong if comparisons aren't symmetric (which depends on the details of what you're up to).

Reading from a CSV file

I have a CSV file containing many rows and columns 2 of which are similar to:
Horizontal-1 Acc. Filename Horizontal-2 Acc. Filename
RSN88_SFERN_FSD172.AT2 RSN88_SFERN_FSD262.AT2
RSN164_IMPVALL.H_H-CPE147.AT2 RSN164_IMPVALL.H_H-CPE237.AT2
RSN755_LOMAP_CYC195.AT2 RSN755_LOMAP_CYC285.AT2
RSN1083_NORTHR_GLE170.AT2 RSN1083_NORTHR_GLE260.AT2
RSN1614_DUZCE_1061-N.AT2 RSN1614_DUZCE_1061-E.AT2
RSN1633_MANJIL_ABBAR--L.AT2 RSN1633_MANJIL_ABBAR--T.AT2
RSN3750_CAPEMEND_LFS270.AT2 RSN3750_CAPEMEND_LFS360.AT2
RSN3757_LANDERS_NPF090.AT2 RSN3757_LANDERS_NPF180.AT2
RSN3759_LANDERS_WWT180.AT2 RSN3759_LANDERS_WWT270.AT2
RSN4013_SANSIMEO_36258021.AT2 RSN4013_SANSIMEO_36258111.AT2
RSN4841_CHUETSU_65004NS.AT2 RSN4841_CHUETSU_65004EW.AT2
RSN4843_CHUETSU_65006NS.AT2 RSN4843_CHUETSU_65006EW.AT2
RSN4844_CHUETSU_65007NS.AT2 RSN4844_CHUETSU_65007EW.AT2
RSN4848_CHUETSU_65011NS.AT2 RSN4848_CHUETSU_65011EW.AT2
In the CSV file I wanna look for the headers "Horizontal-1 Acc. Filename and Horizontal-2 Acc. Filename" and then line by line get the names of each row under these headers one at a time ?
Any suggestion ?
Thanks
RG.
package require csv
package require struct::matrix
::struct::matrix m
m add columns 2
set chan [open data.csv]
::csv::read2matrix $chan m
close $chan
lassign [m get row 0] header1 header2
for {set r 1} {$r < [m rows]} {incr r} {
puts -nonewline [format {%s = %-30s } $header1 [m get cell 0 $r]]
puts [format {%s = %s} $header2 [m get cell 1 $r]]
}
m destroy
I find that the easiest way to deal with csv data sets is by using a matrix. A matrix is sort of a two-dimensional vector with built-ins for searching, sorting and rearranging columns and rows.
First, create a matrix and call it m. It will have two columns from the beginning, but no rows yet.
::struct::matrix m
m add columns 2
Open a channel to read the data file. Pass the channel and the matrix name to the ::csv::read2matrix command. This command will read the csv data and create a matrix row for each data row. The data fields are stored in the columns.
set chan [open data.csv]
::csv::read2matrix $chan m
close $chan
To get the header strings, retrieve row 0.
lassign [m get row 0] header1 header2
To iterate over the data rows, go from 1 (if we didn't have headers, 0) to just under m rows, which is the number of rows in the matrix.
There is a handy report facility that works well with matrices, but I'll just use a for loop here. I'm guessing how you want the data presented:
for {set r 1} {$r < [m rows]} {incr r} {
puts -nonewline [format {%s = %-30s } $header1 [m get cell 0 $r]]
puts [format {%s = %s} $header2 [m get cell 1 $r]]
}
If you're done with the matrix, you might as well destroy it.
m destroy
Solution for the specific problem in the comments.
package require csv
package require struct::matrix
::struct::matrix m
set chan [open foo.csv]
::csv::read2matrix $chan m , auto
close $chan
set f1 [m search column 0 "Result ID"]
set headerRow [lindex $f1 0 1]
set f2 [m search rect 0 $headerRow 0 [expr {[m rows] - 1}] ""]
set f3 [m search row $headerRow "Horizontal-1 Acc. Filename"]
set f4 [m search row $headerRow "Horizontal-2 Acc. Filename"]
set top [expr {$headerRow + 1}]
set bottom [expr {[lindex $f2 0 1] - 1}]
set left [lindex $f3 0 0]
set right [lindex $f4 0 0]
puts [format {Vector=[ %s ]} [concat {*}[m get rect $left $top $right $bottom]]]
m destroy
Obviously, you need to change the filename to the correct name. There is no error handling: in such a simple script it's better to just have the script fail and correct whatever went wrong.
Solution to the second problem, comments below:
package require csv
package require struct::matrix
::struct::matrix m
set chan [open _SearchResults.csv]
::csv::read2matrix $chan m , auto
close $chan
set f1 [m search column 0 {Result ID}]
set headerRow [lindex $f1 0 1]
set f2 [m search -glob rect 0 $headerRow 0 [expr {[m rows] - 1}] { These*}]
set numofRow [lindex $f2 0 1]
set headercol1 [m search row $headerRow { Horizontal-1 Acc. Filename}]
set headercol2 [m search row $headerRow { Horizontal-2 Acc. Filename}]
set indexheaderH1col [lindex $headercol1 0 0]
set indexheaderH2col [lindex $headercol2 0 0]
set rows [m get rect $indexheaderH1col [expr {$headerRow+1}] $indexheaderH2col [expr {$numofRow-1}]]
set rows [lmap row $rows {
lassign $row a b
list [string trim $a] [string trim $b]
}]
foreach row $rows {
puts [format {%-30s %s} {*}$row]
}
puts [format {Vector=[ %s ]} [concat {*}$rows]]
Comments:
You don't need to set the number of columns if you use read2matrix with auto
In this file, there is no empty cell after the table. Instead, we need to search for a string beginning with " These"
Since each cell holds a space character followed by the value, we need to trim off space around the value, otherwise the concatenation will go wrong. The part with the lmap command fixes that
Always brace your expressions
Documentation:
+ (operator),
- (operator),
< (operator),
chan,
close,
concat,
csv (package),
expr,
for,
format,
incr,
lassign,
lindex,
lmap (for Tcl 8.5),
lmap,
open,
package,
puts,
set,
struct::matrix (package),
{*} (syntax)
wipe all
package require csv
package require struct::matrix
::struct::matrix m
m add columns 2
set chan [open _SearchResults.csv]
::csv::read2matrix $chan m , auto
close $chan
set f1 [m search column 0 {Result ID}]
set headerRow [lindex $f1 0 1]
set f2 [m search rect 0 $headerRow 0 [expr {[m rows] - 1}] {}]
set numofRow [lindex [lindex $f2 0 1]]
set headercol1 [m search row $headerRow { Horizontal-1 Acc. Filename}]
set headercol2 [m search row $headerRow { Horizontal-2 Acc. Filename}]
set indexheaderH1col [lindex $headercol1 0 0]
set indexheaderH2col [lindex $headercol2 0 0]
set header1 [m get cell $indexheaderH1col $headerRow]
set header2 [m get cell $indexheaderH2col $headerRow]
for {set r [expr $headerRow+1]} {$r < [expr $numofRow-1]} {incr r} {
puts [format {%-30s %s} [m get cell $indexheaderH1col $r] [m get cell $indexheaderH2col $r]]
}
set vector [concat {*}[m get rect $indexheaderH1col [expr $headerRow+1] $indexheaderH2col [expr $numofRow-1]]]
puts [format {Vector=[ %s ]} [concat {*}[m get rect $indexheaderH1col [expr $headerRow+1] $indexheaderH2col [expr $numofRow-1]]]]

How to read number count of words?

How to read number count of words?
Lines has this format:
vertices_count
X, Y
X, Y
X, Y
(X, Y pair can be in the same line)
for example:
3
12.5, 56.8
12.5, 56.8
12.5, 56.8
I would like to read vertices_count number of words(escaping comma):
So for above example reading words should be:
12.5 56.8 12.5 56.8 12.5 56.8
set fh [open f r]
gets $fh num
read $fh data
close $fh
set number_re {-?\d+(?:\.\d*)?|-?\d*\.\d+}
set vertices {}
foreach {_ x y} [regexp -inline -all "($number_re),\\s*($number_re)" $data] {
lappend vertices $x $y
if {[llength $vertices] == $num * 2} break
}
puts $vertices
# => 12.5 56.8 12.5 56.8 12.5 56.8
while {[llength $vertices] < $num * 2} {
gets $fh line
foreach {_ x y} [regexp -inline -all "($number_re),\\s*($number_re)" $line] {
lappend vertices $x $y
if {[llength $vertices] == $num * 2} break
}
}
close $fh
I'm still not clear exactly what you are after. Here is some code to read data from a named file. Judging from your other question, you can have several sets of data in your input stream and this code returns them all as a list. Each element of the list is one set of coordinates
# Read the input from file
set fil [open filename.file]
set input [read $fil]
close $fil
set data [list]; # No output so for
set seekCount yes; # Next token is a vertex count
foreach token [string map {, " "} $input] {
# Convert commas to spaces
if {$seekCount} {
set nCoords [expr $token * 2];
# Save number of coordinates
set datum [list]; # Clean out vertex buffer
} else {
lappend datum $token; # Save coordinate
incr nCoords -1
if {$nCoords <= 0} {
# That was the last coordinate
lappend data $datum; # Append the list of coordinates
set seekCount yes; # and look for anopther count
}
}
}
This is a very quick-and-dirty solution, which makes no attempt to handle errors. One thing, however that it will cope with is variable amounds of whitespace and missing whitespace after the commas.
Good luck, I hope this helps.
This procedure first reads a count line, then reads that number of lines and puts as a list into $varName. It returns the number of elements in $varName, or -1 if EOF occured before a count was read.
proc getNLines {stream varName} {
upvar 1 $varName lines
set lines {}
if {[gets $stream n] < 0} {
return -1
}
while {$n > 0} {
if {[gets $stream line] < 0} {
error "bad data format"
}
lappend lines $line
incr n -1
}
return [llength $lines]
}
while {[getNLines stdin lines] >= 0} {
# ...
}