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]
}
}
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} ..... )
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]]]
}
}
I'm trying to parse an ascii text file that looks like this.
KEY1 VAL1
KEY2 VAL2
KEY3 VAL3
KEY4 VAL4
KEY5 VAL5
KEY6 VAL6
KEY7 VAL7
KEY8 VAL8
KEY9 VAL9
I would like to convert this to a flat table of values from KEYs 1,5,7. I have a very ugly brute force algorithm that loops through the file and sets flags to read values, but that doesn't appear most efficient.
something like:
set f [open $filename]
set data [split [read $f] "\n"]
foreach line $data {
if {[string match KEY1* $line] ==1} {set key1match 1}
if {($keymatch1==1) && ([string match KEY5* $line] ==1} {set key5match 1}
...
Is there a more elegant way to generate this mapping?
Is this what you wanted?
set keylist {}
set keyset {KEY1 KEY5 KEY7}
set flatDict {}
foreach line [split [string trim $input] \n] {
if {[regexp {(\s*)(\w+)\s*(.*)} $line -> indent key val] && $key in $keyset} {
set level [expr {[string length $indent] / 2}]
set keylist [lrange $keylist 0 $level]
lappend keylist $key
dict set flatDict $keylist $val
}
}
% set flatDict
KEY1 VAL1 {KEY1 KEY5} VAL5 {KEY1 KEY5 KEY7} VAL7
This code keeps a list of keys, keylist, that grows (by lappend) and contracts (by lrange) according to indentation (and is completely dependent on indentation being correct). Only keys in a given set, keyset are considered. For each value added to the dictionary, the current $keylist is used as a key (the dict command can deal with key hierarchies, but then the keys must be separate and not inside a list (e.g. dict set myDict foo bar 123).
Documentation:
&& (operator),
/ (operator),
dict,
expr,
foreach,
if,
in (operator),
lappend,
lrange,
regexp,
set,
split,
string,
Syntax of Tcl regular expressions
Afterthought: with your selection of keys there is actually no need to contract the key list. If you only use keys that follow a single line of descent from the root, you could use this code:
set keylist {}
set flatDict {}
foreach line [split [string trim $input] \n] {
set val [lassign [split [string trim $line]] key]
if {$key in $keyset} {
lappend keylist $key
dict set flatDict $keylist $val
}
}
% set flatDict
KEY1 VAL1 {KEY1 KEY5} VAL5 {KEY1 KEY5 KEY7} VAL7
Note that in both examples, I have provided for values that might contain whitespace. The code can be made a little more regular if the value is always atomic.
Here's some code to parse that data into a dictionary:
set indent_width 2
set d [dict create]
set fh [open [lindex $argv 0] r]
while {[gets $fh line] != -1} {
regexp {^(\s*)(\S+)\s*(.*)} $line -> indent key value
if {$key eq ""} continue
set level [expr {[string length $indent] / $indent_width}]
dict set d $key level $level
dict set d $key value $value
dict set d $key children [list]
dict set d $key parent ""
dict set d last $level $key
set prev_level [expr {$level - 1}]
if {$prev_level >= 0} {
set parent_key [dict get $d last $prev_level]
dict update d $parent_key item {
dict lappend item children $key
}
dict set d $key parent $parent_key
}
}
dict unset d last
dict for {key value} $d {puts [list $key $value]}
outputs
KEY1 {level 0 value VAL1 children {KEY2 KEY5} parent {}}
KEY2 {level 1 value VAL2 children KEY3 parent KEY1}
KEY3 {level 2 value VAL3 children KEY4 parent KEY2}
KEY4 {level 3 value VAL4 children {} parent KEY3}
KEY5 {level 1 value VAL5 children KEY6 parent KEY1}
KEY6 {level 2 value VAL6 children KEY7 parent KEY5}
KEY7 {level 3 value VAL7 children {} parent KEY6}
KEY8 {level 0 value VAL8 children KEY9 parent {}}
KEY9 {level 1 value VAL9 children {} parent KEY8}
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
How do I create and iterate through a hash of hashes in TCL?
If I have data like:
foo = {
a => {
aa => { aa1 aa2 aa3 }
ab => { ab1 ab2 ab3 }
ac => { ac1 ac2 ac3 }
}
b => {
ba => { ba1 ba2 ba3 }
bb => { bb1 bb2 bb3 }
bc => { bc1 bc2 bc3 }
}
c => {
ca => { ca1 ca2 ca3 }
cb => { cb1 cb2 cb3 }
cc => { cc1 cc2 cc3 }
}
}
How do I create such a hash by inserting one leaf-node data item at a time. Something like:
lappend foo(a)(ab) "ab1"
Then how do I iterate over all data elements? like:
foreach key in foo {
foreach sub_key in foo($key) {
foreach elem in foo($key)($sub_key) {
puts "foo\($key\)\($sub_key\) is $elem"
}
}
}
Edit :
Unfortunately, I do not have access to the newer 'dict' construct.
Assuming you're using Tcl 8.5+, dictionaries are the way to go:
Define the dictionary is simply done:
set foo {
a {
aa { aa1 aa2 aa3 }
ab { ab1 ab2 ab3 }
ac { ac1 ac2 ac3 }
}
b {
ba { ba1 ba2 ba3 }
bb { bb1 bb2 bb3 }
bc { bc1 bc2 bc3 }
}
c {
ca { ca1 ca2 ca3 }
cb { cb1 cb2 cb3 }
cc { cc1 cc2 cc3 }
}
}
Or define it programmatically:
set foo [dict create]
foreach first {a b c} {
dict update foo $first subdict {
foreach second {a b c} {
foreach third {1 2 3} {
dict lappend subdict "$first$second" "$first$second$third"
}
}
}
}
And output it:
dict for {key1 subdict} $foo {
dict for {key2 list} $subdict {
foreach elem $list {
puts "$key1\t$key2\t$elem"
}
}
}
edit: moved the array solution (non-dict) to a separate answer.
If you're not using Tcl 8.5, then you can use arrays. Note that arrays are one-dimensional, but the key is an arbitrary string that can be used to fake multi-dimensionality:
array set foo {}
foreach first {a b c} {
foreach second {a b c} {
foreach third {1 2 3} {
lappend foo($first,$first$second) "$first$second$third"
}
}
}
parray data
and output it -- note: array keys, unlike dictionary keys, are unordered:
foreach key [array names foo] {
foreach elem $foo($key) {
puts "$key\t$elem"
}
}
If you are given the keys (example 'b' and 'bc') you can get the value thusly:
set key1 b
set key2 bc
foreach elem $foo($key1,$key2) {puts $elem}
If you just want to iterate through a dict (which is simply a key-value pair list) without the dict command then you can simply use the awesomeness of foreach:
set foo {
a {
aa { aa1 aa2 aa3 }
ab { ab1 ab2 ab3 }
ac { ac1 ac2 ac3 }
}
b {
ba { ba1 ba2 ba3 }
bb { bb1 bb2 bb3 }
bc { bc1 bc2 bc3 }
}
c {
ca { ca1 ca2 ca3 }
cb { cb1 cb2 cb3 }
cc { cc1 cc2 cc3 }
}
}
foreach {key value} $foo {
foreach {sub_key sub_value} $value {
foreach elem $sub_value {
puts "foo\($key\)\($sub_key\) is $elem"
}
}
}
on the other hand, inserting elements one at a time is painful without the dict command:
set foo {}
lappend foo a {}
set a_index [lsearch $foo a]
set a_value_index [expr {$a_index+1}]
set a_value [lindex $foo $a_value_index]
lappend a_value aa {}
lset foo $a_value_index $a_value
# it is now too painful for me to continue :-(
fortunately you can use a pure-tcl implementation of the dict command: forward-compatible dict
If you don't have the luxury of the Tcl 8.5 dictionary, use the keyed list commands to get the job done. You can google for one of these terms: keylget, keylset.
package require Tclx
# Create the nested structure
catch {unset foo}
foreach key1 {a b c} {
foreach key2 {a b c} {
catch {unset element}
foreach key3 {1 2 3} {
lappend element "$key1$key2$key3"
}
keylset foo $key1.$key1$key2 $element
}
}
# Access the nested structure
foreach key1 {a b c} {
foreach key2 {a b c} {
set elementList [keylget foo $key1.$key1$key2]
foreach element $elementList {
puts "foo\\$key1\\$key1$key2\\$key3 = $element"
}
}
}
#
# Access examples
#
# Access a block of data
puts "foo\\a = [keylget foo a]"
# Access a nested block of data
puts "foo\\b\\ba = [keylget foo b.ba]"
# Access an individual element, remember that Tcl's list index is 0 based
puts "foo\\c\\cb\\1 = [lindex [keylget foo c.cb] 0]"