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}}}
Related
I have two files and I want the output like below. Please help by providing me with a TCL script.
File1:
Name1: F * F F F
Name2: F F *
Name3: F F F F
File2:
Name1: AA, BB, CC, DD, EE,
Name2: AA, BB, CC,
Name3: AA, BB, CC, DD,
Output1:
Name1
AA - FAIL
BB - *
CC - FAIL
<cont>
Name2
AA - FAIL
BB - FAIL
CC - *
<cont>
Output2:
Name1
FAIL - AA CC DD EE
* - BB
Name2
FAIL - AA BB
* - CC
Name3
FAIL - AA BB CC DD
Try this following tested on tclsh8.5
set fd1 [open "input_file_1.txt" r]
set fd2 [open "input_file_2.txt" r]
set opfd [open "output_file.txt" w]
while {[gets $fd1 line] > 0 && [gets $fd2 line2] > 0} {
set line1 [split $line ":"]
set line2 [split $line2 ":"]
puts $opfd [lindex $line1 0]
set last_part_1 [string trim [lindex $line1 1] " "]
set last_part_2 [string trim [lindex $line2 1] " "]
set space_split [split $last_part_1 " "]
set comma_split [split $last_part_2 ","]
for {set i 0} {$i < [llength $space_split]} {incr i} {
puts $opfd "[string trim [lindex $comma_split $i] " "] = [string trim [lindex $space_split $i] " "]"
}
}
close $fd1
close $fd2
close $opfd
There will be file named as output_file.txt created inside current directory which contains your output.
Another way to do it:
package require fileutil
proc getInput filename {
set contents [string trim [::fileutil::cat $filename]]
set rows [split $contents \n]
concat {*}[lmap item $rows {
split $item :
}]
}
set d1 [string map {F Fail} [getInput file1.txt]]
set d2 [string map {, {}} [getInput file2.txt]]
dict for {key values} $d1 {
puts $key
foreach v1 $values v2 [dict get $d2 $key] {
puts " $v2 - $v1"
}
}
This works by recognizing the dictionary-like structure of the data files. If every piece of data is a word without spaces, this version of getInput will coerce the contents of each file to a usable dict. From there, it's just a matter of replacing the F strings with Fail strings and removing the commas, and then doing dictionary iteration over either one of the dicts and pulling in the corresponding values from the other one.
If the values in the second file may contain spaces, getInput should look like this:
proc getInput filename {
set contents [string trim [::fileutil::cat $filename]]
set rows [split $contents \n]
set res {}
foreach item $rows {
lassign [split $item :] key values
if {[string match *,* $values]} {
set values [split [string trimright $values {, }] ,]
}
lappend res $key $values
}
return $res
}
Documentation: concat, dict, foreach, if, lassign, lmap, lmap replacement, package, proc, puts, return, set, split, string
I have a list
set list "abc,def,ghi,jkl,mno,pqr,stu,vwx"
Now I want to split this list on the 4th occurence of the comma.
I want the list to be divided into two lists:
A = abc,def,ghi,jkl
B = mno,pqr,stu,vwx
How about simply using the list operators to split and re-join:
puts [set A [join [lrange [split $list ,] 0 3] ,]]
puts [set B [join [lrange [split $list ,] 4 end] ,]]
Or, if you wanted to go the regexp route, do it in one operation:
regexp -- {((?:\w+,){3}\w+),(.*)} $list --> A B
puts $A
puts $B
set list "abc,def,ghi,jkl,mno,pqr,stu,vwx"
regexp -- {(\w+,){3}\w+} $list A
regsub -- "${A}," $list {} B
puts $A
puts $B
A rather complicated example :)
set occurence 4
set slice_position 0
set list "abc,def,ghi,jkl,mno,pqr,stu,vwx"
for {set i 0} {$i < $occurence} {incr i} {
set slice_position [string first "," $list [expr $slice_position + 1]]
if {$slice_position == -1} {
break
}
}
puts [string range $list 0 $slice_position-1]
puts [string range $list $slice_position+1 end]
Is there a way to split strings and save in a list ?
How to split string and save in two list
For example, I have a string where I split several string with =:
a=1
b=2
c=3
d=4
and then I want to create two list like this [a,b,c,d] and [1,2,3,4]:
Following is a simple tcl code
set s "a=1\nb=2\nc=3\nd=4"
set s [split $s "\n"]
foreach e $s {
set e [split $e "="]
lappend l1 [lindex $e 0]
lappend l2 [lindex $e 1]
}
Now you have list l1 with [a b c d] and l2 has [1 2 3 4]
The simplest way is to read all the data in, split into lines, and then use regexp with each line to extract the pieces.
set f [open "theFile.txt"]
set lines [split [read $f] "\n"]
close $f
set keys [set values {}]
foreach line $lines {
if {[regexp {^([^=]*)=(.*)$} $line -> key value]} {
lappend keys $key
lappend values $value
} else {
# No '=' in the line!!!
}
}
# keys in $keys, values in $values
puts "keys = \[[join $keys ,]\]"
puts "values = \[[join $values ,]\]"
Run that (assuming that the filename is right) and you'll get output like:
keys = [a,b,c,d]
values = [1,2,3,4]
Collecting two lists like that might not be the best thing to do with such stuff. Often, it is better to instead to store in an array:
# Guarded by that [regexp] inside the foreach
set myArray($key) $value
Like that, you can do lookups by name rather than having to manually search. Assuming that keys are unique and order doesn't matter.
A simple way might be using a loop:
% set lines "a=1\nb=2\nc=3\nd=4"
a=1
b=2
c=3
d=4
% set expressionList [split $lines "\n"]
a=1 b=2 c=3 d=4
% set var [list]
% set val [list]
% foreach i $expressionList {
set variable [lindex [split $i "="] 0]
set value [lindex [split $i "="] 1]
lappend val $value
lappend var $variable
}
% puts $var
a b c d
% puts $val
1 2 3 4
If you don't mind a regex, you might try something like this:
% set lines "a=1\nb=2\nc=3\nd=4"
a=1
b=2
c=3
d=4
% set var [regexp -inline -lineanchor -all -- {^[^=\n\r]+} $lines]
a b c d
% set val [regexp -inline -lineanchor -all -- {[^=\n\r]+$} $lines]
1 2 3 4
If replacing the equals sign characters in $data with blanks always leaves a proper, even-valued list (as in the example) it can be done a lot simpler:
set dict [string map {= { }} $data]
set keys [dict keys $dict]
set values [dict values $dict]
Documentation: dict, set, string
Let say your strings placed in file abc.txt in the following order
a=1
b=2
c=3
d=4
You need to create 2 lists, one for numbers and one for characters:
set number_list [list]
set char_list [list]
set fh [open "abc.txt" "r"]
while {[gets $fh line] != -1} {
regexp -- {(\S+)=(\S+)} $line foo char number
lappend char_list $char
lappend number_list $number
}
close $fh
puts $char_list
puts $number_list
This is pretty old, but I would actually go about it differently... Something like the following, considering that the string is [a=1\nb=1\n ... etc.] with variable name "str":
# determine num entries in string
set max [llength $str]
#create new strings (alph & num) based on split string
set i 0
set str [split $str \n]
set alph []
set num []
while {$i < $max} {
set alph "$alph [lindex [split [lindex $str $i] "="] 0]
set num "$num [lindex [split [lindex $str $i] "="] 1]
incr i}
Maybe just personal preference, but seems simplest to me; code was not tested, but it's similar to something I was just working on.
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
I'm trying to create a program that the First and last characters are compared, Second and second to the last are compared, Third and third to the last are compared, and so on, and if any of these characters match, the two will be converted to the uppercase of that character.
Example:
Please enter a text: Hello Philippines
finals: HEllo PhIlippinEs
I can't create any piece of code, I'm stuck with
puts "Please enter text:"
set myText [gets stdin]
string index $myText 4
Can someone help me please?
This procedure will also capitalize the first i in Phillipines because it's equidistant from the start and the end of the string.
proc compare_chars {str} {
set letters [split $str ""]
for {set i [expr {[llength $letters] / 2}]} {$i >= 0} {incr i -1} {
set a [lindex $letters $i]
set b [lindex $letters end-$i]
if {$a eq $b} {
lset letters $i [set L [string toupper $a]]
lset letters end-$i $L
}
}
join $letters ""
}
puts [compare_chars "Hello Phillipines"]
# outputs => HEllo PhIllipinEs
The simplest way to code this is to use foreach over the split-up characters. (It's formally not the most efficient, but it's very easy to code correctly.)
puts "Please enter text:"
set myText [gets stdin]
set chars [split $myText ""]
set idx 0
foreach a $chars b [lreverse $chars] {
if {[string equals -nocase $a $b]} {
lset chars $idx [string toupper $a]
}
incr idx
}
set output [join $chars ""]
puts $output
Note that the foreach is iterating over a copy of the list; there are no problems with concurrent modification. In fact, the only vaguely-tricky part from a coding perspective is actually that we need to keep track of the index to modify, in the idx variable above.
With Tcl 8.6 you could write:
set chars [split $myText ""]
set output [join [lmap a $chars b [lreverse $chars] {
expr {[string equals -nocase $a $b] ? [string toupper $a] : $a}
}] ""]
That does depend on having the new lmap command though.
If you're really stuck with 8.3 (it's unsupported and has been so for years, so you should be prioritizing upgrading to something more recent) then try this:
set chars [split $myText ""]
set idx [llength $chars]
set output {}
foreach ch $chars {
if {[string equals -nocase $ch [lindex $chars [incr idx -1]]]} {
append output [string toupper $ch]
} else {
append output [string tolower $ch]
}
}
All the features this uses were present in 8.3 (though some were considerably slower than in later versions).