i have a list of unique id, sublist of associates' id, like this:
5 {9 6}
6 {9 5}
14 {}
1 {8 2}
17 18
18 17
2 {8 1}
8 {2 1}
27 {}
4 {11 3}
3 {11 4}
7 11
11 {3 4 7}
9 {6 5}
22 {}
i am trying to group them by connection like this:
{3 4 7 11}
{5 6 9}
{1 2 8}
{17 18}
14
27
22
do not know how to do it at all. hope someone can help.
You should traverse over the source list and perform the needed actions. For example:
set dest [list]
foreach { id sub_ids } $src_list {
set found -1
set ids [concat $sub_ids [list $id]]
for { set i 0 } { $i < [llength $dest] } { incr i } {
set dest_rec [lindex $dest $i]
foreach { dest_id } $dest_rec {
if { $dest_id in $ids } {
set found $i
break
}
}
if { $found != -1 } {
break
}
}
if { $found == -1 } {
lappend dest [lsort -unique $ids]
} else {
set dest [lreplace $dest $found $found [lsort -unique [concat [lindex $dest $found] $ids]]]
}
}
Related
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 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
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
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
I am rephrasing my earlier question as the output requirement is changed.
two lists
fruit_type={apple, apple, orange, orange, pineapple, pineapple, pineapple}
num_type = {2, 1, 1, 2, 3, 1, 2}
Output Expected
apple 2
apple 1
orange 1 2
pineapple 3
pineapple 1 2
proc debugityourself-or-maybe-even-port-to-tcl8.4 {fruit_type num_type} {
foreach fruit $fruit_type num $num_type {
if {[info exists result]&&
([lindex $result end-1 0] eq $fruit)&&
([lindex $result end end] <= $num)} {
lset result end [list {*}[lindex $result end] $num]
} else {
lappend result [list $fruit] [list $num]
}
}
if {[info exists result]} {
return [concat {*}$result]
}
}
UPD: as requirements has changed again, here is a new version:
proc fruits-of-labour-for-new-requirements {fruit_type num_type} {
foreach fruit $fruit_type num $num_type {
if {[info exists resultF]&&
([lindex $resultF end] eq $fruit)&&
([lindex $resultN end end] <= $num)} {
lset resultN end [list {*}[lindex $resultN end] $num]
} else {
lappend resultF $fruit
lappend resultN [list $num]
}
}
if {[info exists resultF]} {
# $resultF is a list of fruits, $resultN is a list of
# lists with corresponding numbers.
return [list $resultF $resultN]
}
}