I am trying to uniquify the file content. The game and score is repeated sometimes, I am trying to write out to file1
Input:
game score
a 1
a 1
a 2
b 1
b 2
b 2
Output:
Uniq1 a 1
Uniq2 a 2
Uniq3 b 1
Uniq4 b 2
Code:
while {[gets $inputfile] > 0} {
set g1 [lindex $token end]
set g2 [lindex $token end-1]
incr gcount
puts $file1 "Uniq$gcount =$g1 $g2"
}
Just store the lines as keys in a dict and iterate over the keys after reading all the input to print the values (In the order they appear in the input) without including duplicates. Example:
#!/usr/bin/env tclsh
proc main {} {
# Discard header line
gets stdin
while {[gets stdin line] > 0} {
dict set lines $line 1
}
set i 1
dict for {line _} $lines {
puts "Uniq$i $line"
incr i
}
}
main
Running this produces:
Uniq1 a 1
Uniq2 a 2
Uniq3 b 1
Uniq4 b 2
I think there are a few options, depending on the complexity. If the duplicates for example always occur one after the other, then I would just save the current row as previous row and when I get to the next row, I compare it to the previous row:
set previous(g1) ""
set previous(g2) ""
while {[gets $inputfile] > 0} {
set g1 [lindex $token end]
set g2 [lindex $token end-1]
if {$previous(g1) != $g1 && $previous(g2) != $g2} {
incr gcount
puts $file1 "Uniq$gcount $g1 $g2"
set previous(g1) $g1
set previous(g2) $g2
}
}
If the duplicate could happen anywhere, then I'd do it like this:
array set previous {}
while {[gets $inputfile] > 0} {
set g1 [lindex $token end]
set g2 [lindex $token end-1]
if {![info exists previous($g1,$g2)]} {
incr gcount
puts $file1 "Uniq$gcount $g1 $g2"
set previous($g1,$g2) ""
}
}
Related
My test file contains :
2 server[0]/asm
3 server[1]/asm
5 server[1]/pst
6 server[0]/pst
3 server[2]/qrf
5 server[1]/qrf
.
.
and so on
I need results something as :
3 asm
6 pst
5 qrf
I have tried something like this till now:
set fp [open ./txt r]
set fw [open ./txt w]
while {[gets $fp line] >= 0} {
if {[regexp {\[0\]} $line]} {
puts $fw [string map {server\[0\]/ ""} $line]
} eslsif {[regexp {\[1\]} $line]} {
puts $fw [string map {server\[1\]/ ""} $line]
} elseif {[regexp {\[2\]} $line]} {
puts $fw [string map {server\[2\]/ ""} $line]
}
}
close $fp
close $fw
The output till now is:
2 asm
3 asm
5 pst
6 pst
3 qrf
5 qrf
There are only 3 servers. server[0], server [1] and server[2].
So i want maximum value from column 1 for the same last name in column 2 in tcl.
Please guide me through it.
I'd use a regular expression to pick out the parts of each line
set names [dict create]
while {[gets $f line] != -1} {
if {[regexp {^(\d+).*/(.*)$} $line -> num name]} {
dict lappend names $name $num
}
}
dict for {name nums} $names {
puts [list [tcl::mathfunc::max {*}$nums] $name]
}
I have a file as below:
a, b, c, d, e
S, 1.0, 100, F, fast
T, 2.0, 200, S, slow
First ROW is header only (a, b, c, d, e) and 2nd, 3rd row is the value (S, 1.0, 100, F, fast) correspond to the header.
I would like to read the file below into tcl and puts out the values (ie: row 2, column 5 -> fast)
I wrote the below script but doesnt seem to work:
proc game {name infile outfile} {
set csv [open $infile r]
set csv_lines [read $csv]
set out [open $outfile w]
set info [split $csv "\n"]
set infocount [llength $info]
set line 1
foreach line $info {
set values [split $line ","]
set firstline [lindex $values 0]
set secondline [lindex $values 1]
### HOW DO I PUTS OUT ROW2 COL5 or ROW1 COL3 ###
puts $outfile "$firstline"
}
close $infile
close $outfile
}
Want outfile to be as below:
a: S b: 1.0 c: 100 d: F e: fast
a: T b: 2.0 c: 200 d: S e: slow
or
a: T b: 2.0 c: 100 d: F e: slow
a: S b: 1.0 c: 200 d: F e: fast
Using the csv package from tcllib is the way to go for robustness, but on trivial data like this, split will work.
#!/usr/bin/env tclsh
proc game {name infile outfile} {
set in [open $infile r]
set out [open $outfile w]
set header [split [gets $in] ,]
while {[gets $in line] > 0} {
foreach col $header val [split $line ,] {
puts -nonewline $out "$col: $val "
}
puts $out ""
}
close $in
close $out
}
game foo input.csv output.txt
You might do:
package require csv
proc splitline {fh} {
if {[gets $fh line] != -1} {
set fields [csv::split $line]
return [lmap field $fields {string trimleft $field}]
}
}
proc transform {file} {
set fh [open $file r]
set head [splitline $fh]
while {[set fields [splitline $fh]] ne ""} {
puts [join [lmap h $head f $fields {string cat $h ":" $f}]]
}
close $fh
}
transform "file.csv"
a:S b:1.0 c:100 d:F e:fast
a:T b:2.0 c:200 d:S e:slow
You could use a dict to store the data of the csv file:
proc game {name inFile} {
upvar csv_data csv_data
set csv [open $inFile r]
set csv_lines [read $csv]
set row 0
foreach line [split $csv_lines "\n"] {
set values [split $line ","]
for {set col 0} {$col < [llength $values]} {incr col} {
dict set csv_data $row [expr {$col+1}] [string trim [lindex $values $col]]
}
incr row
}
close $csv
}
set csv_data {}
game foo input.csv
Now you can read from the dict like the below, where row 0 contains the headers, and col 1 is the one with a as header:
# To get row 2 col 5:
puts [dict get $csv_data 2 5]
# => slow
# To get row 1 col 3:
puts [dict get $csv_data 1 3]
# => 100
To print in the other format you asked, you'll need to do a little more work:
set outFile [open output.txt w]
for {set row 1} {$row < [llength [dict keys $csv_data]]} {incr row} {
set lineOut ""
foreach {- header} [dict get $csv_data 0] {- value} [dict get $csv_data $row] {
lappend lineOut "$header: $value"
}
puts $outFile [join $lineOut " "]
}
close $outFile
output.txt:
a: S b: 1.0 c: 100 d: F e: fast
a: T b: 2.0 c: 200 d: S e: slow
I have a list which I am trying to modify and make a new list based on what I am trying to achieve.
Original List
$> set a {123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4:mno}
$> puts $a
$> 123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4:mno
I want my new list to contain following elements
$> puts $a
$> xyz pqr xyz abc mno
I tried split $a : but it did not work out for me. Please suggest what can be done.
set b [list]
foreach item $a {
catch {
regexp {\:(.*)} $item match tail
lappend b $tail
}
}
puts $b
It's possible to do above with split instead of regexp; I prefer regexp because you can extract arbitrary patterns this way.
If you've got Tcl 8.6:
set a [lmap x $x {regsub {^[^:]*:} $x ""}]
In 8.5, it's easier if you store in another variable:
set b {}
foreach x $a {
lappend b [regsub {^[^:]*:} $x ""]
}
In 8.4 and before, you also need a slightly different syntax for regsub:
set b {}
foreach x $a {
# Mandatory write back to a variable...
regsub {^[^:]*:} $x "" x
# Store the value; it isn't reflected back into the source list by [foreach]
lappend b $x
}
One Liner:
% set a {123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4:mno}
% 123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4:mno
set b [regexp -inline -all {[a-z]+} $a]
% xyz pqr xyz abc mno
Taddaaaa... No split required, if you have regex.
set a {123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4:mno}
for {set i 0} {$i < [llength $a]} {incr i} {
lset a $i [lindex [split [lindex $a $i] ":"] 1]
}
puts $a
By making use of split command:
set a { 123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4 :mno }
set c [list]
foreach ele $a {
lappend c [lindex [split $ele ":"] 1]
}
puts $c
output : xyz pqr xyz abc mno
set input {123.4:xyz 123.4:pqr 123.4:xyz 123.4:abc 123.4:mno}
set a ""
for {set i 0} {$i<[llength $input]} {incr i} {
set a "$a [string trim [lindex $input $i] {0,1,2,3,4,5,6,7,8,9,.,:}]"
}
This will trim the input.
If you have 8.5 and tcllib:
struct::list map $a {apply {{elem} {lindex [split $elem :] end}}}
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} {
# ...
}
I have a list like
set val [ list Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 ]
now i want to put it in a loop and execute some commands over each range
like
set number 0
set pattern 0
foreach n $val {
if {$pattern == 0} {
set current $n
regexp {(.*/)(\d+)} $n - pattern number
continue
}
regexp {(.*/)(\d+)} $n - match1 match2
if {$match1 == $pattern} {
#puts "someproc $current - match2"
}
}
I am unable to get this work the output should be like for ech pair or singular value found
someproc Fa2/0/1 - 24
someproc Gi1/0/13 - 23
someproc Gi1/1/1 - 1 #for singular values
someproc Gi2/0/1 - 1
EDIT : i have a list of such data like :
Gi3/0/1 Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 Te1/0/1
where you can say each data can be of type Gi3/0/ or Gi2/0/ or Fa2/0/ these reperesent some range of ports on cisco swicth.Now for every type i need to execute some command for a range.Again taking the above list i can get.
somecommand Gi3/0/1 - 1 # there is only one `Gi3/0/` with number 1.
somecommand Fa2/0/1 - 24 # range of `Fa2/0/` is 1 to 24
similarly,
somecommand Gi1/0/13 - 23
somecommand Gi1/1/1 - 1
and so on
#!/usr/bin/tcl
## Assumptions:
## The pattern will always be X/X/X
## The values are given in list
set val_list [list Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1]
array set pattern {}
foreach item $val_list {
set parent [file dir $item]
set val [file tail $item]
if {[info exists pattern($parent,L)] && [info exists pattern($parent,H)] } {
if {$pattern($parent,L) > $val } {
set pattern($parent,L) $val
} elseif { $pattern($parent,H) < $val} {
set pattern($parent,H) $val
}
} else {
set pattern($parent,L) $val
set pattern($parent,H) $val
}
}
array set count {}
foreach pat [array names pattern] {
set pat [lindex [split $pat ,] 0]
if {![info exists count($pat)] } {
puts "$pat $pattern($pat,L) - $pattern($pat,H)"
set count($pat) 1
}
}
/*The output will be
Gi1/0 13 - 23
Fa2/0 1 - 24
Gi2/0 1 - 1
Gi1/1 1 - 1
*/
Hope this is what you are requesting for. I used array "count" to remove duplicate entries in output, which needs to be avoided. Hope if someone can suggest any better way. And FYI I am using 8.4 version of TCL.
If you are not sure how arrays, work, you can edit the code you posted as an answer to this code:
set number 0
set pattern 0
set current 0
set result [list Gi3/0/1 Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 Te1/0/1]
foreach n [lsort $result] {
if {$pattern == 0} {
set current $n
regexp {(.*/)(\d+)} $n - pattern number
continue
}
regexp {(.*/)(\d+)} $n - match1 match2
if {$match1 == $pattern} {
set number $match2
} else {
puts "$current - $number"
set pattern $match1
set number $match2
set current $n
}
}
That works for me :)
The output (note that I sorted the list first so you only have to worry about the increasing $number or $match2 while not having to bother too much about the $pattern):
Fa2/0/1 - 24
Gi1/0/13 - 23
Gi1/1/1 - 1
Gi2/0/1 - 1
Gi3/0/1 - 1
Here is my solution, which does not use array (nothing is wrong with array, my solution just don't need it), and it does it in one pass (i.e. only one loop).
set val [ list Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 ]
set lastPattern ""
set lastNumber 0
lappend val x/1/1; # Add a trailer to ease processing
foreach item $val {
# If item=Fa2/0/1, then pattern=Fa2/0 and number=1
set pattern [file dirname $item]
set number [file tail $item]
if {$pattern == $lastPattern} {
# We have seen this pattern before
puts "$pattern/$lastNumber - $number"
set lastPattern ""
} else {
# This is a new pattern, print the old one if applicable then
# save the pattern and number for later processing
if {$lastPattern != ""} {
puts "$lastPattern/$lastNumber - $lastNumber"
}
set lastPattern $pattern
set lastNumber $number
}
}
set val [lrange $val end-1]; # Remove the trailer
If you want to compare adjacent list elements, it might be cleaner to use a C-style for loop:
for {set i 0} {$i < [llength $val] - 1} {incr i} {
set current [lindex $val $i]
set next [lindex $val [expr {$i+1}]]
# ...
}
Or, a bit more esoteric
set l {a b c d e f g}
foreach current [lrange $l 0 end-1] \
next [lrange $l 1 end] {
puts "$current $next"
}
outputs
a b
b c
c d
d e
e f
f g
You could even write a new control structure, similar to Ruby's each_cons
proc foreach_cons {vars list body} {
foreach varname $vars {upvar 1 $varname $varname}
set numvars [llength $vars]
for {set i 0} {$i <= [llength $list]-$numvars} {incr i} {
lassign [lrange $list $i [expr {$i + $numvars}]] {*}$vars
uplevel 1 $body
}
}
foreach_cons {a b c} $l {puts "$a $b $c"}
a b c
b c d
c d e
d e f
e f g
Why don't you loop over pairs of the list?
foreach {v1 v2} $val {
someproc $v1 $v2
}
You might check if both values are similar, extract the parts that you need etc.
I came up with a awkward solution of my own :
where reslut is the list :
Gi3/0/1 Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 Te1/0/1
#
set number 0
set pattern 0
set last_element [lindex $result end]
set first_element [lindex $result 0]
foreach n $result {
if {$pattern == 0} {
set current $n
set count 0
regexp {(.*/)(\d+)} $n - pattern number
continue
}
regexp {(.*/)(\d+)} $n - match1 match2
if {$match1 == $pattern} {
set count 0
puts " $current - $match2"
continue
} else {
if {"$last_element" == "$n"} {
puts "$last_element"
}
if {"$first_element" == "$current"} {
puts "$first_element"
}
incr count
if {"$count" == 1} {
set pattern $match1
set current $n
continue
} else {
if {$match1 != $pattern} {
puts "$current"
}
}
set pattern $match1
}
set current $n
}
This solution is a little shorter, but requires Tcl 8.5.
First, create a dictionary structure with the first two fields as key and subkey, and collect lists of values from the third field as dictionary values:
set data {}
foreach v $val {
lassign [split $v /] a b c
if {![dict exists $data $a $b]} {
dict set data $a $b {}
}
dict with data $a {
lappend $b $c
set b [lsort –integer $b]
}
}
Then iterate over this dictionary structure, calling the someproc command for each combination of key, subkey, first and last value.
dict for {a v} $data {
dict for {b v} $v {
someproc $a/$b/[lindex $v 0] - [lindex $v end]
}
}
Documentation: dict, foreach, if, lappend, lassign, lindex, set, split