How to append output of rescheduled procedure in a list - tcl

In below code proc processDistance gives sorted list which is used by proc Inverse2.Proc Inverse2 gives list which contains {x,y,current time}.This is executed after every 1s.but the problem is when I write puts $results inside proc Inverse2 ,in terminal I can only see $result at current time only.Though I have used lappend when I check length of $result it shows length of list is 1.I want to access previously generated values also. How to do it.
code:
proc distance {n1 n2 nd1 nd2} {
global ns
set now [$ns now]
set x1 [expr int([$n1 set X_])]
set y1 [expr int([$n1 set Y_])]
set x2 [expr int([$n2 set X_])]
set y2 [expr int([$n2 set Y_])]
set d [expr hypot($x2-$x1,$y2-$y1)]
return [list $nd1 $nd2 $x1 $y1 $x2 $y2 $d $now]
}
proc processDistances {count threshold {filter ""}} {
global node_
global ns
set now [$ns now]
set t 1.0
set distances {}
for {set i 1} {$i < $count} {incr i} {
for {set j 1} {$j < $count} {incr j} {
# Skip self comparisons
if {$i == $j} continue
# Apply target filter
if {$filter ne "" && $j != $filter} continue
# Get the distance information
set thisDistance [distance $node_($i) $node_($j) $i $j]
# Check that the nodes are close enough
if {[lindex $thisDistance 6] < $threshold} {
lappend distances $thisDistance
}
}
}
# Sort the pairs, by distances
set distances [lsort -real -increasing -index 6 $distances]
puts $distances
$ns at [expr $now+$t] [list processDistances $count $threshold $filter]
Inverse2 $distances
}
$ns at 8.0 [list processDistances $val(nn) 200 41]
proc Inverse2 {m} {
set result {}
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))}]
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
}

Related

FATAL ERROR: can't use non-numeric floating-point value as operand of "-"

I am performing SMD simulation using NAMD with TCL. However I get FATAL ERROR: can't use non-numeric floating-point value as operand of "-"; why?
I am doing steered molecular dynamics and the code below is to introduce a virtual spring to produce an external force.I am constraining multiple atom positions for the spring to move towards the position.
The constant velocity method can be used to pull multiple atoms.
Details of the code is below;
# Atoms selected for force application
set id1 [atomid AP1 10 CA]
set grp1 {}
lappend grp1 $id1
set a1 [addgroup $grp1]
set id2 [atomid AP1 14 CA]
set grp2 {}
lappend grp2 $id2
set a2 [addgroup $grp2]
set id3 [atomid AP1 19 CA]
set grp3 {}
lappend grp3 $id3
set a3 [addgroup $grp3]
set id4 [atomid AP1 22 CA]
set grp4 {}
lappend grp2 $id4
set a4 [addgroup $grp4]
set id5 [atomid AP1 25 CA]
set grp5 {}
lappend grp5 $id5
set a5 [addgroup $grp5]
set id6 [atomid AP1 28 CA]
set grp6 {}
lappend grp6 $id6
set a6 [addgroup $grp6]
set id7 [atomid AP1 32 CA]
set grp7 {}
lappend grp7 $id7
set a7 [addgroup $grp7]
set id8 [atomid AP1 36 CA]
set grp8 {}
lappend grp8 $id8
set a8 [addgroup $grp8]
set id9 [atomid AP1 42 CA]
set grp9 {}
lappend grp9 $id9
set a9 [addgroup $grp9]
# set the output frequency, initialize the time counter
set Tclfreq 50
set t 0
# contraint points
set c1x -19.450
set c1y -3.791
set c1z 12.790
set c2x -7.811
set c2y -8.997
set c2z 11.372
set c3x 9.267
set c3y -12.502
set c3z 13.258
set c4x 16.102
set c4y -20.086
set c4z 11.251
set c5x 24.674
set c5y -13.698
set c5z 9.676
set c6x 22.147
set c6y -3.551
set c6z 13.986
set c7x 8.271
set c7y -2.899
set c7z 18.747
set c8x 8.827
set c8y 8.698
set c8z 15.017
set c9x 22.774
set c9y 1.488
set c9z 16.176
# force constant (kcal/mol/A^2) #7.2
set k 1.0
# pulling velocity (A/timestep)
set v 0.002
set outfilename da_smd_tcl.out
open $outfilename w
proc calcforces {} {
global Tclfreq t k v a1 a2 a3 a4 a5 a6 a7 a8 a9 c1x c1y c1z c2x c2y c2z c3x c3y c3z c4x c4y c4z c5x c5y c5z c6x c6y c6z c7x c7y c7z c8x c8y c8z c9x c9y c9z outfilename
# get coordinates
loadcoords coordinate
set r1 $coordinate($a1)
set r1x [lindex $r1 0]
set r1y [lindex $r1 1]
set r1z [lindex $r1 2]
set r2 $coordinate($a2)
set r2x [lindex $r2 0]
set r2y [lindex $r2 1]
set r2z [lindex $r2 2]
set r3 $coordinate($a3)
set r3x [lindex $r3 0]
set r3y [lindex $r3 1]
set r3z [lindex $r3 2]
set r4 $coordinate($a4)
set r4x [lindex $r4 0]
set r4y [lindex $r4 1]
set r4z [lindex $r4 2]
set r5 $coordinate($a5)
set r5x [lindex $r5 0]
set r5y [lindex $r5 1]
set r5z [lindex $r5 2]
set r6 $coordinate($a6)
set r6x [lindex $r6 0]
set r6y [lindex $r6 1]
set r6z [lindex $r6 2]
set r7 $coordinate($a7)
set r7x [lindex $r7 0]
set r7y [lindex $r7 1]
set r7z [lindex $r7 2]
set r8 $coordinate($a8)
set r8x [lindex $r8 0]
set r8y [lindex $r8 1]
set r8z [lindex $r8 2]
set r9 $coordinate($a9)
set r9x [lindex $r9 0]
set r9y [lindex $r9 1]
set r9z [lindex $r9 2]
# calculate forces
set f1x [expr $k*($c1x-$r1x)]
set f1y [expr $k*($c1y-$r1y)]
set f1z [expr $k*($c1z+$v*$t-$r1z)]
lappend f1 $f1x $f1y $f1z
set f2x [expr $k*($c2x-$r2x)]
set f2y [expr $k*($c2y-$r2y)]
set f2z [expr $k*($c2z+$v*$t-$r2z)]
lappend f2 $f2x $f2y $f2z
set f3x [expr $k*($c3x-$r3x)]
set f3y [expr $k*($c3y-$r3y)]
set f3z [expr $k*($c3z+$v*$t-$r3z)]
lappend f3 $f3x $f3y $f3z
set f4x [expr $k*($c4x-$r4x)]
set f4y [expr $k*($c4y-$r4y)]
set f4z [expr $k*($c4z+$v*$t-$r4z)]
lappend f4 $f4x $f4y $f4z
set f5x [expr $k*($c5x-$r5x)]
set f5y [expr $k*($c5y-$r5y)]
set f5z [expr $k*($c5z+$v*$t-$r5z)]
lappend f5 $f5x $f5y $f5z
set f6x [expr $k*($c6x-$r6x)]
set f6y [expr $k*($c6y-$r6y)]
set f6z [expr $k*($c6z+$v*$t-$r6z)]
lappend f6 $f6x $f6y $f6z
set f7x [expr $k*($c7x-$r7x)]
set f7y [expr $k*($c7y-$r7y)]
set f7z [expr $k*($c7z+$v*$t-$r7z)]
lappend f7 $f7x $f7y $f7z
set f8x [expr $k*($c8x-$r8x)]
set f8y [expr $k*($c8y-$r8y)]
set f8z [expr $k*($c8z+$v*$t-$r8z)]
lappend f8 $f8x $f8y $f8z
set f9x [expr $k*($c9x-$r9x)]
set f9y [expr $k*($c9y-$r9y)]
set f9z [expr $k*($c9z+$v*$t-$r9z)]
lappend f9 $f9x $f9y $f9z
# apply forces
addforce $a1 $f1
addforce $a2 $f2
addforce $a3 $f3
addforce $a4 $f4
addforce $a5 $f5
addforce $a6 $f6
addforce $a7 $f7
addforce $a8 $f8
addforce $a9 $f9
# output
set foo [expr $t % $Tclfreq]
if { $foo == 0 } {
set outfile [open $outfilename a]
set time [expr $t*2/1000.0]
puts $outfile "$time $r2z $f2z"
close $outfile
}
incr t
return
}
There's something unexpected (non-numeric) in one of your variables.
Which one is the tricky bit. You don't say which line has the error (the errorInfo global will contain this) and because you don't put your expressions in braces, even the errorInfo will be not 100% informative. (Putting expressions in braces allows Tcl to compile the expressions — making them faster and safer — and makes the error message on a bad value rather more informative as the runtime engine has more information available.)
Given what error message you're receiving, it's probably not an empty string.
As a side note, you can shorten sequences like this:
set r1 $coordinate($a1)
set r1x [lindex $r1 0]
set r1y [lindex $r1 1]
set r1z [lindex $r1 2]
to this:
lassign $coordinate($a1) r1x r1y r1z

extract variables from proc using upvar

I want to return some value from proc.. but It didn't work because of pointer..
So I tried to use upvar to return $sofar. but It didn't work..
Could you help me to extarct list of $sofar to return??
I need to grep $test_output as list of list.
thanks :)
proc combinationSum {sum sofar want numbers output } {
if {$sum == $want} {
puts $sofar
#upvar $output tmp
#set tmp $output
}
if {($sum < $want) && ([lindex $numbers 0] > 0) && ([llength $numbers] > 0)} {
combinationSum [expr $sum + [lindex $numbers 0]] [concat $sofar [lindex $numbers 0]] $want $numbers $output]
combinationSum $sum $sofar $want [lrange $numbers 1 end] $output]
}
}
set test_input [list 2 3 4 7 8 ]
set test_target 15
set test_output [ combinationSum 0 [] $test_target $test_input [] ]
puts $test_output
I expand the test_output is list ( {2 2 2 2 2 2 3} { 2 2 2 2 3 4 } { 2 2 2 2 7} ..... )

How to pass output of one procedure as an argument to another procedure in tcl

I want pass output of one procedure which is a list as an argument to another procedure.Below is a code which I have tried.
proc distance {n1 n2 nd1 nd2} {
set x1 [expr int([$n1 set X_])]
set y1 [expr int([$n1 set Y_])]
set x2 [expr int([$n2 set X_])]
set y2 [expr int([$n2 set Y_])]
set d [expr hypot($x2-$x1,$y2-$y1)]
return [list $nd1 $nd2 $x1 $y1 $x2 $y2 $d]
}
proc processDistances {count threshold {filter ""}} {
global node_
set distances {}
for {set i 1} {$i < $count} {incr i} {
for {set j 1} {$j < $count} {incr j} {
# Skip self comparisons
if {$i == $j} continue
# Apply target filter
if {$filter ne "" && $j != $filter} continue
# Get the distance information
set thisDistance [distance $node_($i) $node_($j) $i $j]
# Check that the nodes are close enough
if {[lindex $thisDistance 6] < $threshold} {
lappend distances $thisDistance
}
}
}
# Sort the pairs, by distances
set distances [lsort -real -increasing -index 6 $distances]
Inverse2 {*}$distances
}
$ns at 8.5 [list processDistances $val(nn) 200 41]
proc Inverse2 {m} {
set result [open R.tr w]
lassign [lindex $m 0 2] x1
lassign [lindex $m 0 3] y1
lassign [lindex $m 0 4] d1
lassign [lindex $m 1 2] x2
lassign [lindex $m 1 3] y2
lassign [lindex $m 1 4] d2
lassign [lindex $m 2 2] x3
lassign [lindex $m 2 3] y3
lassign [lindex $m 2 4] 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))}]
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])}]
puts $result "x location of object is: $x \ny location of object is: $y"
}
Error:
ns: processDistances 42 200 41: wrong # args: should be "Inverse2 m"
while executing
"Inverse2 {*} $distances"
(procedure "processDistances" line 32)
invoked from within
"processDistances 42 200 41"
I'm getting output of proc processDistances successfully which is a sorted list but when I pass this output to procedure Inverse2 using command Inverse2 {*}$distances written in processDistances (I have tcl8.5).I'm getting above error.Where I'm dong wrong.please help me out.
I am suggesting you run it just as I replaced it. If this does not work, I'm not sure what you're asking for.
proc distance {n1 n2 nd1 nd2} {
set x1 [expr int([$n1 set X_])]
set y1 [expr int([$n1 set Y_])]
set x2 [expr int([$n2 set X_])]
set y2 [expr int([$n2 set Y_])]
set d [expr hypot($x2-$x1,$y2-$y1)]
return [list $nd1 $nd2 $x1 $y1 $x2 $y2 $d]
}
proc processDistances {count threshold {filter ""}} {
global node_
set distances {}
for {set i 1} {$i < $count} {incr i} {
for {set j 1} {$j < $count} {incr j} {
# Skip self comparisons
if {$i == $j} continue
# Apply target filter
if {$filter ne "" && $j != $filter} continue
# Get the distance information
set thisDistance [distance $node_($i) $node_($j) $i $j]
# Check that the nodes are close enough
if {[lindex $thisDistance 6] < $threshold} {
lappend distances $thisDistance
}
}
}
# Sort the pairs, by distances
set distances [lsort -real -increasing -index 6 $distances]
#Inverse2 {*}$distances
Inverse2 $distances
}
$ns at 8.5 [list processDistances $val(nn) 200 41]
proc Inverse2 {m} {
set result [open R.tr w]
lassign [lindex $m 0 2] x1
lassign [lindex $m 0 3] y1
lassign [lindex $m 0 4] d1
lassign [lindex $m 1 2] x2
lassign [lindex $m 1 3] y2
lassign [lindex $m 1 4] d2
lassign [lindex $m 2 2] x3
lassign [lindex $m 2 3] y3
lassign [lindex $m 2 4] 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))}]
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])}]
puts $result "x location of object is: $x \ny location of object is: $y"
}

Print Cartesian product of two list, without nested foreach

I need to calculate a Cartesian product of two lists.
My list contains large number of elements, so nested foreach is not a good idea in my case.
Anything else, that can be used there?
You might be able to work on the values while it's being put together. It's hard to say without at least a snapshot of the structure you're working with. Here's a simple example.
The proc doesn't return a matrix it does work on points in the matrix.
proc my_cartesian {a b} {
set len_a [llength $a]
set len_b [llength $b]
set len [expr $len_a * $len_b]
set y 0
for {set i 0} {$i < $len} {incr i} {
set x [expr $i % $len_a]
if {$x == 0 && $i != 0} {
incr y
}
set px [lindex $a $x]
set py [lindex $b $y]
# Your code
puts "$px, $py"
}
}
my_cartesian {a b c} {1 2 3}
output:
a, 1
b, 1
c, 1
a, 2
b, 2
c, 2
a, 3
b, 3
c, 3

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