I want to know how can I add some list variable to single variable, some thing look like matrix.
llappend to what kind of ... ?!?
set EarthquakesNameForFactorLineNO [list]
set EarthquakesNameForFactor [list]
set FirstRow [list]
set SecondRow [list]
for example :
EarthquakesNameForFactorLineNO = [$a $b $c $d $e]
EarthquakesNameForFactor = [$f $g $h $i $g]
set FirstRow [list] = [$k $l $m $n $o]
set SecondRow [list] = [$p $q $r $s $t]
Now I need single variable like this:
[MATRIX] 4*5
$a $b $c $d $e
$f $g $h $i $j
$k $l $m $n $o
$p $q $r $s $t
and also I want to ask another question...
how can I create the opposite of this matrix, I mean change row to column, I'm not sure, perhaps in English call it inverse or something else :-)
I mean this:
[MATRIX] 5*4
$a $f $k $p
$b $g $l $q
$c $h $m $r
$d $i $n $s
$e $j $o $t
Elaborating on my comment, let's say you have the 4 lists as below, with the contents of the lists some letters instead of variables (that shouldn't pose any issue)
set EarthquakesNameForFactorLineNO [list a b c d e]
set EarthquakesNameForFactor [list f g h i j]
set FirstRow [list k l m n o]
set SecondRow [list p q r s t]
Now, to get the matrix, we will make a list containing all the 4 lists:
set matrix1 [list $EarthquakesNameForFactorLineNO $EarthquakesNameForFactor $FirstRow $SecondRow]
# Equivalent to
# set matrix1 [list [list a b c d e] [list f g h i g] [list k l m n o] [list p q r s t]]
If you want to see that 'matrix' in a 4x5 fashion, you just need to print the list, joined by a newline:
puts [join $matrix1 \n]
# This displays:
# a b c d e
# f g h i g
# k l m n o
# p q r s t
Then you can use some basic looping to get the matrix transposed. The inner loop here is going through the rows, while the outer loops is going through the columns. matrix2 will be the transposed matrix and newrow will have the current row in the transposed matrix. Due to the way the loop was set up, the following will add all the first values in each row first, then take all the second values in each row, and so on.
set matrix2 [list]
for {set column 0} {$column < [llength [lindex $matrix1 0]]} {incr column} {
set newrow [list]
foreach row $matrix1 {
lappend newrow [lindex $row $column]
}
lappend matrix2 $newrow
}
puts [join $matrix2 \n]
For the above, if you want a single loop, you can use the below possibly more complex loop:
for {set a 0; set b 0} {
$a < [llength [lindex $matrix1 0]] && $b <= [llength $matrix1]
} {incr b} {
if {$b == [llength $matrix1]} {
set b -1
incr a
lappend matrix2 $newrow
set newrow [list]
} else {
lappend newrow [lindex $matrix1 $b $a]
}
}
puts [join $matrix2 \n]
Whichever, you choose, if you are using this a lot, you may want to put the above in a proc:
proc transpose_matrix {matrix1} {
for {set a 0; set b 0} {
$a < [llength [lindex $matrix1 0]] && $b <= [llength $matrix1]
} {incr b} {
if {$b == [llength $matrix1]} {
set b -1
incr a
lappend matrix2 $newrow
set newrow [list]
} else {
lappend newrow [lindex $matrix1 $b $a]
}
}
return $matrix2
}
After which you will get the transposed matrix in matrix2 whenever you call
set matrix2 [transpose_matrix $matrix1]
Note that if you have numbers or words that are variable in length, the display might not be too pretty... for instance, with other values, the matrix might look like:
1.45 1 2 310 43
0 2.3 10 20 13
342.04 11.49 87.32 0.987 2.3
3.2 12.45 11.11 43.2 35
Which can be hard to read... but then, that's a different problem :)
package require struct::matrix
struct::matrix xdata
xdata add columns 5
xdata add rows 4
xdata set rect 0 0 {
{a b c d e}
{f g h i g}
{k l m n o}
{p q r s t}
}
join [xdata get rect 0 0 end end] \n
# a b c d e
# f g h i g
# k l m n o
# p q r s t
xdata transpose
join [xdata get rect 0 0 end end] \n
# a f k p
# b g l q
# c h m r
# d i n s
# e g o t
xdata destroy
This achieves the same result but with struct::matrix which also includes a matrix transpose command
I have two lists called hga and bbb. I am using tcl from a software called VMD. Now I would like to compare these lists by finding the common residues and different residues in these lists. How can I do that?
% set hga [atomselect 0 "name CA and within 8 of resname HEM"]
% set bbb [atomselect 1 "name CA and within 8 of resname HEM"]
% $hga get {resname resid}
% $bbb get {resname resid}
resname part is character and resid part is a number.
UPDATE : using package require struct gives me error. And I am not the root user.
I don't have VMD so I made proc from example output. This script finds indexes with the same attribute value. You need to set the attributes and use them in your get. Example:
set attrs {name backbone}
set values [$sel get $attrs]
set answer [same_values $attrs $values]
Test script
#!/usr/bin/tclsh
# http://www.ks.uiuc.edu/Research/vmd/vmd-1.7/ug/node181.html
# $sel get {attr1 attr2}
# is a list of sublists. {attr1 attr2} {attr1 attr2} ...
set attrs {name backbone}
set values "{N 1} {H 0} {CA 1} {CB 0} {C 1} {O 1}"
proc same_values {attrs values} {
set len [llength $values]
set "matches(_ATTRIBUTE VALUE)" INDEXES
set attrs_length [llength $attrs]
for {set i 0} {$i < $len} {incr i} {
set item_a [lindex $values $i]
set search_indexes [list]
for {set k 0} {$k < $attrs_length} {incr k} {
set key [list [lindex $attrs $k] [lindex $item_a $k]]
if {![info exists "matches($key)"]} {
# value hasn't been indexed.
# create index list and add to search list
set "matches($key)" [list $i]
lappend search_indexes $k
}
}
# continue if we don't have anything to search
if {[llength $search_indexes] == 0} {continue}
# search the rest of the list for matches
for {set j [expr $i + 1]} {$j < $len} {incr j} {
set item_b [lindex $values $j]
foreach {k} $search_indexes {
set a [lindex $item_a $k]
set b [lindex $item_b $k]
set attr [lindex $attrs $k]
if {$a == $b} {
set key [list $attr $a]
lappend "matches($key)" $j
}
}
}
}
set result [list]
set keys [lsort [array names matches]]
foreach {key} $keys {
lappend result $key "$matches($key)"
}
return $result
}
set answer [same_values $attrs $values]
foreach {attr_value indexes} $answer {
puts "$attr_value = $indexes"
}
output:
% ./test.tcl
_ATTRIBUTE VALUE = INDEXES
backbone 0 = 1 3
backbone 1 = 0 2 4 5
name C = 4
name CA = 2
name CB = 3
name H = 1
name N = 0
name O = 5
I've got two lists of lists, I match them and print any differences. The two lists are cable connections within a FPGA station. I need to ensure:
All the connections on the $list1 exist on $list2, if not, it should save the error on another list
All the connections on $list2 exist on $list1, so I don't get any 'wrong' connections.
Any connections that don't exist on either list should be saved onto another variable.
The lists are in this format:
{{A.B2} {B.B3}}
and the the $list2 equivalent could be:
{{B.B3} {A.B2}}
^ Even though the connections are swapped around, it is still valid! I save both of these on different variables inside a loop to do this:
if {
$physical == "$project" && $physical2 == "$project2"
|| $physical == "$project2" && $physical2 == "$project"
} then {
lappend verified "$project ($project2) VERIFIED\n"
#incr cablecounter
set h 0
} elseif {
$physical == "$project" && $physical2 != "$project2"
|| $physical != "$project" && $physical2 == "project2"
|| $physical == "$project2" && $physical2 != "project"
|| $physical != "$project2" && $physical2 == "project"
} then {
lappend nonverified "$project to $project2 NOT connected. Please check $physical and $physical2\n"
} else {
set g [expr $g - 1]
incr h
#puts "\n [llength configuredConnections]"
if {
$h > [llength $configuredConnections] && $project != "$physical" && $project2 != "$physical2"
|| $h > [llength $configuredConnections] && $project != "physical2" && $project2 != "$physical"
} {
lappend nonverified "$project to $project2 wrong connection found. Please remove.\n"
set h 0; incr g
}
}
This gives me all the wrong connections etc, BUT instead of telling me that an element on $list1 doesn't exist on $list2, it stores it onto $nonverified, and lists is as a 'wrong connection' rather than listing it as 'NOT' connected.
I am new to TCL idk what to do!
EDIT: $project and $project2 are the two elements in $list1, and $physical $physical2 are elements in $list2.
I'm using Tcl 8.4
The ldiff command can help you (EDIT: I replaced the Tcl 8.6 implementation with a Tcl 8.4-workable (provided you use the lmap replacement below) one):
proc ldiff {a b} {
lmap elem $a {
expr {[lsearch -exact $b $elem] > -1 ? [continue] : $elem}
}
}
The invocation
ldiff $list1 $list2
gives you all elements in list1 that don't occur in list2, and vice versa.
Items that don't exist on either of the lists should presumably be in a list named, say, list0, and you can find them with the invocation
ldiff [ldiff $list0 $list1] $list2
A quick-and-dirty replacement for lmap for Tcl 8.4 users:
proc lmap {varname listval body} {
upvar 1 $varname var
set temp [list]
foreach var $listval {
lappend temp [uplevel 1 $body]
}
set temp
}
It doesn't allow multiple varname-listval pairs, but you don't need that for ldiff.
This ought to provide a working replacement for the full lmap command on Tcl 8.4, unless there are still issues that don't show up when using 8.6:
proc lmap args {
set body [lindex $args end]
set args [lrange $args 0 end-1]
set n 0
set pairs [list]
foreach {varname listval} $args {
upvar 1 $varname var$n
lappend pairs var$n $listval
incr n
}
set temp [list]
eval foreach $pairs [list {
lappend temp [uplevel 1 $body]
}]
set temp
}
I still recommend the first replacement suggestion in this case, though: there's less that can go wrong with it.
This proc will return the intersection and the differences between 2 lists. For Tcl 8.4, call it like
foreach {intersection not_in_list2 not_in_list1} \
[intersect3 $list1 $list2] \
break
if {[llength $not_in_list2] > 0} {
puts "NOT All the connections on the list1 exist on list2"
puts $not_in_list2
}
if {[llength $not_in_list1] > 0} {
puts "NOT All the connections on the list2 exist on list1"
puts $not_in_list1
}
(Tcl 8.5 and above, you would
lassign [intersect3 $list1 $list2] intersection not_in_list2 not_in_list1
)
And the intersect3 proc is:
#
# intersect3 - perform the intersecting of two lists, returning a list
# containing three lists. The first list is everything in the first
# list that wasn't in the second, the second list contains the intersection
# of the two lists, the third list contains everything in the second list
# that wasn't in the first.
#
proc intersect3 {list1 list2} {
array set la1 {}
array set lai {}
array set la2 {}
foreach v $list1 {
set la1($v) {}
}
foreach v $list2 {
set la2($v) {}
}
foreach elem [concat $list1 $list2] {
if {[info exists la1($elem)] && [info exists la2($elem)]} {
unset la1($elem)
unset la2($elem)
set lai($elem) {}
}
}
list [lsort [array names la1]] [lsort [array names lai]] \
[lsort [array names la2]]
}
I belive I stole that from TclX some years ago. You could (should?) use tcllib:
package require struct::set
set l1 {a b c d e f g}
set l2 {c d e f g h i}
puts [struct::set intersect3 $l1 $l2]
{c d e f g} {a b} {h i}
This describes an interleave function that can lzip data:
% interleave {a b c} {1 2 3}
a 1 b 2 c 3
I am looking for the reverse operation. Also I would like to specify into how many sublists the input shall be split. For example:
% lnth {a 1 b 2 c 3} 1
{a 1 b 2 c 3}
% lnth {a 1 b 2 c 3} 2
{a b c} {1 2 3}
% lnth {a 1 b 2 c 3} 3
{a 2} {1 c} {b 3}
% lnth {a 1 b 2 c 3} 6
{a} {1} {b} {2} {c} {3}
For uneven splits, the missing elements shall be just omitted. If you feel like it you could provide a default argument to be filled in, but that's not required. Also I don't mind the exact quotation of the two corner cases where n==1 or n==[llength $L]. Thanks Hai Vu for pointing this out in your earlier answer.
It would be good to have some notion of complexity in time and memory.
I'm on Tcl8.4 (this cannot be changed).
Update
For these kind of benchmark question its always good to have a central summary. All tests ran on the same machine, on the (rather small) example list $L as shown below. It's all highly un-scientific.Good code comes from the answers below, errors are mine.
Test code:
#!/usr/bin/tclsh
proc build_list {len} {
incr len
while {[incr len -1]} {
lappend res {}
}
set res
}
proc lnth3_prebuild_no_modulo {L n} {
# Build empty 2D list to hold result
set iterations [expr {int(ceil(double([llength $L]) / $n))}]
set one [build_list $iterations]
set res [list]
set cnt [expr {$n+1}]
while {[incr cnt -1]} {
lappend res $one
}
# Fill in original/real values
set iteration 0
set subListNumber 0
foreach item $L {
lset res $subListNumber $iteration $item
if {[incr subListNumber] == $n} {
set subListNumber 0
incr iteration
}
}
set res
}
proc lnth3_no_modulo {L n} {
# Create a list of variables: subList0, subList1, subList2, ...
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
set subList$subListNumber {}
}
# Build the sub-lists
set subListNumber 0
foreach item $L {
lappend subList$subListNumber $item
if {[incr subListNumber] == $n} {
set subListNumber 0
}
}
# Build the result from all the sub-lists
set result {}
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
lappend result [set subList$subListNumber]
}
return $result
}
proc lnth {L n} {
set listvars ""
for {set cnt 0} {$cnt < $n} {incr cnt} {
lappend listvars "L$cnt"
}
set iterations [expr {ceil(double([llength $L]) / $n)}]
for {set cnt 0} {$cnt < $iterations} {incr cnt} {
foreach listvar $listvars el [lrange $L [expr {$cnt*$n}] [expr {($cnt+1)*$n-1}] ] {
lappend $listvar $el
}
}
set res [list]
foreach listvar $listvars {
lappend res [eval "join \$$listvar"]
}
set res
}
proc lnth_prebuild {L n} {
set iterations [expr {int(ceil(double([llength $L]) / $n))}]
set one [build_list $iterations]
set listvars ""
for {set cnt 0} {$cnt < $n} {incr cnt} {
lappend listvars L$cnt
set L$cnt $one
}
for {set cnt 0} {$cnt < $iterations} {incr cnt} {
foreach listvar $listvars el [lrange $L [expr {$cnt*$n}] [expr {($cnt+1)*$n-1}] ] {
lset $listvar $cnt $el
}
}
set res [list]
foreach listvar $listvars {
lappend res [eval "join \$$listvar"]
}
set res
}
proc lnth2 {L n} {
set listLen [llength $L]
set subListLen [expr {$listLen / $n}]
if {$listLen % $n != 0} { incr subListLen }
set result {}
for {set iteration 0} {$iteration < $n} {incr iteration} {
set subList {}
for {set i $iteration} {$i < $listLen} {incr i $n} {
lappend subList [lindex $L $i]
}
lappend result $subList
}
return $result
}
proc lnth3 {L n} {
# Create a list of variables: subList0, subList1, subList2, ...
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
set subList$subListNumber {}
}
# Build the sub-lists
set i 0
foreach item $L {
set subListNumber [expr {$i % $n}]
lappend subList$subListNumber $item
incr i
}
# Build the result from all the sub-lists
set result {}
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
lappend result [set subList$subListNumber]
}
return $result
}
# stuff subcommands in a namespace
namespace eval ::unlzip {}
proc unlzip {L n} {
# check if we have the proc already
set name [format "::unlzip::arity%dunlzip" $n]
if {[llength [info commands $name]]} {
return [$name $L]
} else {
# create it
proc $name {V} [::unlzip::createBody $n]
return [$name $L]
}
}
proc ::unlzip::createBody {n} {
for {set i 0} {$i < $n} {incr i} {
lappend names v$i
lappend lnames lv$i
}
set lbody ""
set ret {
return [list }
foreach lname $lnames name $names {
append lbody [format {
lappend %s $%s} $lname $name]
append ret "\$$lname "
}
append ret {]}
return [format {foreach {%s} $V { %s }
%s} $names $lbody $ret]
}
### Tests
set proc_reference lnth
set procs {lnth_prebuild lnth2 lnth3 unlzip lnth3_no_modulo lnth3_prebuild_no_modulo}
set L {a 1 b 2 c 3 d 4 e 5 f 6 g 7 h 8 j 9 i 10 k 11 l 12 m 13 n 14 o 15 p 16 q 17 r 18 s 19 t 20 u 21 v 22 w 23 x 24 y 25 z 26}
set Ns {1 2 3 4 5 6 7 8 9 10 13 26}
# Functional verification
foreach n $Ns {
set expected [$proc_reference $L $n]
foreach p $procs {
set result [$p $L $n]
if {$expected ne $result} {
puts "Wrong result for proc $p, N=$n."
puts " Expected: $expected"
puts " Got: $result"
}
}
}
# Table header
puts -nonewline [format "%30s" {proc_name\N}]
foreach n $Ns {
puts -nonewline [format " %7d" $n]
}
puts ""
# Run benchmarks
foreach proc_name [concat $proc_reference $procs] {
puts -nonewline [format "%30s" $proc_name]
foreach n $Ns {
puts -nonewline [format " %7.2f" [lindex [time "$proc_name \$L $n" 10000] 0]]
}
puts ""
}
The results:
proc_name\N 1 2 3 4 5 6 7 8 9 10 13 26
lnth 33.34 23.73 21.88 20.51 21.33 21.33 22.41 23.07 23.36 25.59 26.09 38.39
lnth_prebuild 41.14 31.00 28.88 27.24 28.48 29.06 30.45 31.46 31.43 34.65 34.45 49.10
lnth2 8.56 8.08 8.35 8.78 9.12 9.29 9.66 9.98 10.29 10.61 11.22 14.94
lnth3 17.15 18.35 18.91 19.55 20.55 21.42 22.24 23.54 23.71 24.27 25.79 33.78
unlzip 5.36 5.25 5.03 4.97 5.27 5.42 5.52 5.43 5.42 5.96 5.51 6.83
lnth3_no_modulo 14.88 16.56 17.20 17.97 18.63 19.42 19.78 20.74 21.53 21.84 23.60 31.29
lnth3_prebuild_no_modulo 14.44 13.30 12.83 12.51 12.51 12.43 12.36 12.41 12.41 12.83 12.70 14.09
One option would be creating specialized procs on the fly:
Not sure how fast it is for larger N or larger sets, but should be quite fast for repeated runs, as you have nearly no overhead than straight calls to foreach and lappend.
package require Tcl 8.4
# stuff subcommands in a namespace
namespace eval ::unlzip {}
proc unlzip {L n} {
# check if we have the proc already
set name [format "::unlzip::arity%dunlzip" $n]
if {[llength [info commands $name]]} {
return [$name $L]
} else {
# create it
proc $name {V} [::unlzip::createBody $n]
return [$name $L]
}
}
proc ::unlzip::createBody {n} {
for {set i 0} {$i < $n} {incr i} {
lappend names v$i
lappend lnames lv$i
}
set lbody ""
set ret {
return [list }
foreach lname $lnames name $names {
append lbody [format {
lappend %s $%s} $lname $name]
append ret "\$$lname "
}
append ret {]}
return [format {foreach {%s} $V { %s }
%s} $names $lbody $ret]
}
proc ::unlzip::arity1unlzip {V} {
return [list $V]
}
# example how the function looks for N=2
proc ::unlzip::arity2unlzip {V} {
foreach {v1 v2} $V {
lappend lv1 $v1
lappend lv2 $v2
}
return [list $lv1 $lv2]
}
The disassambled bytecode for Tcl 8.6 for the N=3 proc would look like this (via Tcl 8.6. ::tcl::unsupported::disassemble proc:
ByteCode 0x00667988, refCt 1, epoch 5, interp 0x005E0B70 (epoch 5)
Source "foreach {v0 v1 v2} $V { \n\t lappend lv0 $v0\n\t "
Cmds 6, src 149, inst 86, litObjs 1, aux 1, stkDepth 3, code/src 0.00
Proc 0x00694368, refCt 1, args 1, compiled locals 9
slot 0, scalar, arg, "V"
slot 1, scalar, temp
slot 2, scalar, temp
slot 3, scalar, "v0"
slot 4, scalar, "v1"
slot 5, scalar, "v2"
slot 6, scalar, "lv0"
slot 7, scalar, "lv1"
slot 8, scalar, "lv2"
Exception ranges 1, depth 1:
0: level 0, loop, pc 17-57, continue 10, break 61
Commands 6:
1: pc 0-63, src 0-94 2: pc 17-30, src 32-46
3: pc 31-44, src 55-69 4: pc 45-57, src 78-93
5: pc 64-84, src 120-148 6: pc 73-83, src 128-147
Command 1: "foreach {v0 v1 v2} $V { \n\t lappend lv0 $v0\n\t "
(0) loadScalar1 %v0 # var "V"
(2) storeScalar1 %v1 # temp var 1
(4) pop
(5) foreach_start4 0
[data=[%v1], loop=%v2
it%v1 [%v3, %v4, %v5]]
(10) foreach_step4 0
[data=[%v1], loop=%v2
it%v1 [%v3, %v4, %v5]]
(15) jumpFalse1 +46 # pc 61
Command 2: "lappend lv0 $v0"
(17) startCommand +13 1 # next cmd at pc 30
(26) loadScalar1 %v3 # var "v0"
(28) lappendScalar1 %v6 # var "lv0"
(30) pop
Command 3: "lappend lv1 $v1"
(31) startCommand +13 1 # next cmd at pc 44
(40) loadScalar1 %v4 # var "v1"
(42) lappendScalar1 %v7 # var "lv1"
(44) pop
Command 4: "lappend lv2 $v2 "
(45) startCommand +13 1 # next cmd at pc 58
(54) loadScalar1 %v5 # var "v2"
(56) lappendScalar1 %v8 # var "lv2"
(58) pop
(59) jump1 -49 # pc 10
(61) push1 0 # ""
(63) pop
Command 5: "return [list $lv0 $lv1 $lv2 ]"
(64) startCommand +21 2 # next cmd at pc 85, 2 cmds start here
Command 6: "list $lv0 $lv1 $lv2 "
(73) loadScalar1 %v6 # var "lv0"
(75) loadScalar1 %v7 # var "lv1"
(77) loadScalar1 %v8 # var "lv2"
(79) list 3
(84) done
(85) done
As straight forward as it gets..., well, if the lists are incomplete (llength $L modulo $n isn't zero) you would need some little extra checks. As long as the lists are balanced, you could als pre populate the lists and use lset instead of lappend, which is faster, as it doesn't reallocate the list array so often.
Here is my approach: build one sub-list at a time, then append to the result before building the next one.
proc lnth2 {L n} {
set listLen [llength $L]
set subListLen [expr {$listLen / $n}]
if {$listLen % $n != 0} { incr subListLen }
set result {}
for {set iteration 0} {$iteration < $n} {incr iteration} {
set subList {}
for {set i $iteration} {$i < $listLen} {incr i $n} {
lappend subList [lindex $L $i]
}
lappend result $subList
}
return $result
}
Let say that L = {a 1 b 2 c 3} and n = 2, then I will build the first sub-list {a b c} by picking out the 0th, 2nd, and 4th items from the original list, append that to the result and move on the the second sub-list. Likewise, the second sub-list will be the 1th, 3rd, and 5th items.
Update
After reviewing my solution, I still don't like the fact that I have to use lindex. I imagine lindex has to travese the list in order to find the list item, and my solution placed lindex right inside a loop; which means we traverse the same list several times. The next attempt is to traverse the list only once. This time, I mimic your algorithm, but avoid using the list functions such as lrange.
proc lnth3 {L n} {
# Create a list of variables: subList0, subList1, subList2, ...
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
set subList$subListNumber {}
}
# Build the sub-lists
set i 0
foreach item $L {
set subListNumber [expr {$i % $n}]
lappend subList$subListNumber $item
incr i
}
# Build the result from all the sub-lists
set result {}
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
lappend result [set subList$subListNumber]
}
return $result
}
Sadly, this attempt performs worse than my first attempt. I still don't understand why.
Got something now - but do not like it because it does not seem to be efficient:
proc lnth {L n} {
set listvars ""
for {set cnt 0} {$cnt < $n} {incr cnt} {
lappend listvars "L$cnt"
}
set iterations [expr {ceil(double([llength $L]) / $n)}]
for {set cnt 0} {$cnt < $iterations} {incr cnt} {
foreach listvar $listvars el [lrange $L [expr {$cnt*$n}] [expr {($cnt+1)*$n-1}] ] {
lappend $listvar $el
}
}
set res [list]
foreach listvar $listvars {
lappend res [eval "join \$$listvar"]
}
set res
}
The trick is to have a couple of sublists, stored in variables L0, L1, L2, and to create those sublists dynamically, depending on how many ($n) are wanted.
The number of iterations then depends on len($L)/$n, using the ceil() here to cover incomplete iterations.
The last loop assembles the overall result list.
I simply do not know how to get around constructing the result list more efficiently during the main work loop. And I know too little about the internal efficiencies of Tcl in lappend or alternatives. Also it may be faster to just iterate over L and dole out elements to those sublists...
Out of curiosity, and inspired by Donal's comment that linsert is actually O(1) because Tcl lists are implemented with C arrays, I tried to improve Hai Vu's answer a little: First be removing the modulo operation with a simple counter and comparison. And second by replacing the lappend with an lset. This latter change requires to prebuild the result array.
Here's the code:
proc lnth3_no_modulo {L n} {
# Create a list of variables: subList0, subList1, subList2, ...
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
set subList$subListNumber {}
}
# Build the sub-lists
set subListNumber 0
foreach item $L {
lappend subList$subListNumber $item
if {[incr subListNumber] == $n} {
set subListNumber 0
}
}
# Build the result from all the sub-lists
set result {}
for {set subListNumber 0} {$subListNumber < $n} {incr subListNumber} {
lappend result [set subList$subListNumber]
}
return $result
}
proc build_list {len} {
incr len
while {[incr len -1]} {
lappend res {}
}
set res
}
proc lnth3_prebuild_no_modulo {L n} {
# Build empty 2D list to hold result
set iterations [expr {int(ceil(double([llength $L]) / $n))}]
set one [build_list $iterations]
set res [list]
set cnt [expr {$n+1}]
while {[incr cnt -1]} {
lappend res $one
}
# Fill in original/real values
set iteration 0
set subListNumber 0
foreach item $L {
lset res $subListNumber $iteration $item
if {[incr subListNumber] == $n} {
set subListNumber 0
incr iteration
}
}
set res
}
These two make small improvements on the run time - but not by much:
proc_name\N 1 2 3 4 5 6 7 8 9 10 13 26
lnth3 17.41 18.62 19.07 19.99 21.39 21.45 23.90 23.58 23.62 24.50 25.67 33.91
lnth3_no_modulo 14.95 16.39 16.95 17.80 18.20 19.17 19.86 20.62 21.23 21.99 23.40 31.71
lnth3_prebuild_no_modulo 14.46 12.90 12.24 11.85 11.80 11.65 11.61 11.61 11.70 11.81 11.96 13.23
It seems the prebuild alternative becomes more effective the more lappend list operations would have to be done otherwise.
A simple and efficient algorithm is something like this:
foreach {a b c} $data {
lappend ra $a
lappend rb $b
lappend rc $c
}
list $ra $rb $rc
The downside is here that you have to specify different variables.
Upside is that it is efficient.
proc Fibonacci {x} {
set n(0) 0; set n(1) 1
set i 2
while {$i <= $x} {
set n($i) [expr n($i-2) + n($i-1)]
incr i
}
return $n($i)
}
set y [Fibonacci 10]
puts "$y"
I am getting the below error while compliling the above program. please correct me
Your problem is twofold in this statement:
set n($i) [expr n($i-2) + n($i-1)]
First of all, you have to get the value of n($i-2), not it's name, so you should change it to this:
set n($i) [expr {$n($i-2) + $n($i-1)}]
I also introduced {} to make expr a bit tidier and less error-prone. However, that still won't work, because $i-2 will not be calculated before trying to index the n array, so you need this:
set n($i) [expr {$n([expr {$i-2}]) + $n([expr {$i-1}])}]
Fixed? Nope, this line is still wrong:
return $n($i)
You see, you index by $i, but in your loop, you write to n($i) and after that immediately increase i, so it will be one higher than the last element. You need to change it to this:
return $n($x)
This gives a working version with your code:
proc Fibonacci {x} {
set n(0) 0
set n(1) 1
set i 2
while {$i <= $x} {
set n($i) [expr {$n([expr {$i-2}]) + $n([expr {$i-1}])}]
incr i
}
return $n($x)
}
set y [Fibonacci 10]
puts "$y"
This can still be done bether however, let's use for instead of while:
proc Fibonacci1 {x} {
set n(0) 0
set n(1) 1
for {set i 2} {$i <= $x} {incr i} {
set n($i) [expr {$n([expr {$i-2}]) + $n([expr {$i-1}])}]
}
return $n($x)
}
And let's replace that array by a list, which semantics work much better here:
proc Fibonacci2 {x} {
set n [list 0 1]
for {set i 2} {$i <= $x} {incr i} {
lappend n [expr {[lindex $n end] + [lindex $n end-1]}]
}
return [lindex $n end]
}
Arrays are quite useless here as they are actually associative containers in tcl, a list is a sequential container, what you obviously use in this algorithm. You can see this in speed, this was what I got on my computer with tcl 8.6:
time {Fibonacci1 100} 10000
64.1805 microseconds per iteration
time {Fibonacci2 100} 10000
23.9295 microseconds per iteration
Here is a working solution based on your code:
proc Fibonacci {x} {
set n(0) 0; set n(1) 1
set i 2
while {$i <= $x} {
set fiboMinus1 $n([expr {$i - 1}])
set fiboMinus2 $n([expr {$i - 2}])
set n($i) [expr {$fiboMinus1 + $fiboMinus2}]
incr i
}
return $n($x)
}
set y [Fibonacci 10]
puts "$y"