split a string at the 4th occurence of a comma in tcl - tcl

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]

Related

Inserting single curly braces to Tcl list elements

I have a report file having multiple lines in this form:
str1 num1 num2 ... numN str2
Given that (N) is not the same across lines. These numbers represent coordinates, so I need to enclose each point with curly braces to be:
{num1 num2} {num3 num4} and so on...
I have tried this piece of code:
set file_r [open file.rpt r]
set lines [split [read $file_r] "\n"]
close $file_r
foreach line $lines {
set items [split $line]
set str1 [lindex $items 0]
set str2 [lindex $items [expr [llength $items] - 1]]
set box [lrange $items 1 [expr [llength $items] - 2]]
foreach coord $box {
set index [lsearch $box $coord]
set index_rem [expr $index % 2]
if {index_rem == 0} {
set box [lreplace $box $index $index "{$coord"]
} else {
set box [lreplace $box $index $index "$coord}"]
}
}
puts "box: $box"
}
This gives me a syntax error that a close-brace is missing. And if I try "\{$coord" the back-slash character gets typed in the $box.
Any ideas to overcome this?
There are a few things you could improve to have better and simpler Tcl style.
You usually don't need to use split to form a list from a line if the line is already space separated. Space separated strings can almost always be used directly in list commands.
The exceptions are when the string contains { or " characters.
lindex and lrange can take end and end-N arguments.
This plus Donal's comment to use lmap will result in this:
set file_r [open file.rpt r]
set lines [split [read $file_r] "\n"]
close $file_r
foreach line $lines {
set str1 [lindex $line 0]
set str2 [lindex $line end]
set numbers [lrange $line 1 end-1]
set boxes [lmap {a b} $numbers {list $a $b}]
foreach box $boxes {
puts "box: {$box}"
}
}

How to split string and store in list via TCL

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.

TCL String Manipulation and Extraction

I have a string xxxxxxx-s12345ab7_0_0_xx2.log and need to have an output like AB700_xx2 in TCL.
ab will be the delimiter and need to extract from ab to . (including ab) and also have to remove only the first two underscores.
Tried string trim, string trimleft and string trimright, but not much use. Is there anything like string split in TCL?
The first stage is to extract the basic relevant substring; the easiest way to do that is actually with a regular expression:
set inputString "xxxxxxx-s12345ab7_0_0_xx2.log"
if {![regexp {ab[^.]+} $inputString extracted]} {
error "didn't match!"
}
puts "got $extracted"
# ===> got ab7_0_0_xx2
Then, we want to get rid of those nasty underscores with string map:
set final [string map {"_" ""} $extracted]
puts "got $final"
# ===> ab700xx2
Hmm, not quite what we wanted! We wanted to keep the last underscore and to up-case the first part.
set pieces [split $extracted "_"]
set final [string toupper [join [lrange $pieces 0 2] ""]]_[join [lrange $pieces 3 end] "_"]
puts "got $final"
# ===> got AB700_xx2
(The split command divides a string up into “records” by an optional record specifier — which defaults to any whitespace character — that we can then manipulate easily with list operations. The join command does the reverse, but here I'm using an empty record specifier on one half which makes everything be concatenated. I think you can guess what the string toupper and lrange commands do…)
set a "xxxxxxx-s12345ab7_0_0_xx2.log"
set a [split $a ""]
set trig 0
set extract ""
for {set i 0} {$i < [llength $a]} {incr i} {
if {"ab" eq "[lindex $a $i][lindex $a [expr $i+1]]"} {
set trig 1
}
if {$trig == 1} {
append extract [lindex $a $i]
}
}
set extract "[string toupper [join [lrange [split [lindex [split $extract .] 0] _] 0 end-1] ""]]_[lindex [split [lindex [split $extract .] 0] _] end]"
puts $extract
Only regexp is enough to do the trick.
Set string "xxxxxxx-s12345ab7_0_0_xx2.log"
regexp {(ab)(.*)_(.*)_(.*)_(.*)\\.} $string -> s1 s2 s3 s4 s5
Set rstring "$s1$s2$s3$s4\_$s5"
Puts $rstring

List manipulation in Tcl

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}}}

TCL Program that Compare String

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).