how to split a file to list of lists TCL - tcl

I'm coding TCL and I would like to split a file into two lists of lists,
the file contain:
(1,2) (3,4) (5,6)
(7,8) (9,10) (11,12)
and I would like to get two list
one for each line, that contain lists that each one contain to two number
for example:
puts $list1 #-> {1 2} {3 4} {5 6}
puts [lindex $list1 0] #-> 1 2
puts [lindex $list2 2] #-> 11 12
I tried to use regexp and split but no success

The idea of using regexp is good, but you'll need to do some post-processing on its output.
# This is what you'd read from a file
set inputdata "(1,2) (3,4) (5,6)\n(7,8) (9,10) (11,12)\n"
foreach line [split $inputdata "\n"] {
# Skip empty lines.
# (I often put a comment format in my data files too; this is where I'd handle it.)
if {$line eq ""} continue
# Parse the line.
set bits [regexp -all -inline {\(\s*(\d+)\s*,\s*(\d+)\s*\)} $line]
# Example results of regexp:
# (1,2) 1 2 (3,4) 3 4 (5,6) 5 6
# Post-process to build the lists you really want
set list([incr idx]) [lmap {- a b} $bits {list $a $b}]
}
Note that this is building up an array; long experience says that calling variables list1, list2, …, when you're building them in a loop is a bad idea, and that an array should be used, effectively giving variables like list(1), list(2), …, as that yields a much lower bug rate.
An alternate approach is to use a simpler regexp and then have scan parse the results. This can be more effective when the numbers aren't just digit strings.
foreach line [split $inputdata "\n"] {
if {$line eq ""} continue
set bits [regexp -all -inline {\([^()]+\)} $line]
set list([incr idx]) [lmap substr $bits {scan $substr "(%d,%d)"}]
}
If you're not using Tcl 8.6, you won't have lmap yet. In that case you'd do something like this instead:
foreach line [split $inputdata "\n"] {
if {$line eq ""} continue
set bits [regexp -all -inline {\(\s*(\d+)\s*,\s*(\d+)\s*\)} $line]
set list([incr idx]) {}
foreach {- a b} $bits {
lappend list($idx) [list $a b]
}
}
foreach line [split $inputdata "\n"] {
if {$line eq ""} continue
set bits [regexp -all -inline {\([^()]+\)} $line]
set list([incr idx]) {}
foreach substr $bits {
lappend list($idx) [scan $substr "(%d,%d)"]
# In *very* old Tcl you'd need this:
# scan $substr "(%d,%d)" a b
# lappend list($idx) [list $a $b]
}
}

You have an answer already, but it can actually be done a little bit simpler (or at least without regexp, which is usually a good thing).
Like Donal, I'll assume this to be the text read from a file:
set lines "(1,2) (3,4) (5,6)\n(7,8) (9,10) (11,12)\n"
Clean it up a bit, removing the parentheses and any white space before and after the data:
% set lines [string map {( {} ) {}} [string trim $lines]]
1,2 3,4 5,6
7,8 9,10 11,12
One way to do it with good old-fashioned Tcl, resulting in a cluster of variables named lineN, where N is an integer 1, 2, 3...:
set idx 0
foreach lin [split $lines \n] {
set res {}
foreach li [split $lin] {
lappend res [split $li ,]
}
set line[incr idx] $res
}
A doubly iterative structure like this (a number of lines, each having a number of pairs of numbers separated by a single comma) is easy to process using one foreach within the other. The variable res is used for storing result lines as they are assembled. At the innermost level, the pairs are split and list-appended to the result. For each completed line, a variable is created to store the result: its name consists of the string "line" and an increasing index.
As Donal says, it's not a good idea to use clusters of variables. It's much better to collect them into an array (same code, except for how the result variable is named):
set idx 0
foreach lin [split $lines \n] {
set res {}
foreach li [split $lin] {
lappend res [split $li ,]
}
set line([incr idx]) $res
}
If you have the results in an array, you can use the parray utility command to list them in one fell swoop:
% parray line
line(1) = {1 2} {3 4} {5 6}
line(2) = {7 8} {9 10} {11 12}
(Note that this is printed output, not a function return value.)
You can get whole lines from this result:
% set line(1)
{1 2} {3 4} {5 6}
Or you can access pairs:
% lindex $line(1) 0
1 2
% lindex $line(2) 2
11 12
If you have the lmap command (or the replacement linked to below), you can simplify the solution somewhat (you don't need the res variable):
set idx 0
foreach lin [split $lines \n] {
set line([incr idx]) [lmap li [split $lin] {
split $li ,
}]
}
Still simpler is to let the result be a nested list:
set lineList [lmap lin [split $lines \n] {
lmap li [split $lin] {
split $li ,
}
}]
You can access parts of the result similar to above:
% lindex $lineList 0
{1 2} {3 4} {5 6}
% lindex $lineList 0 0
1 2
% lindex $lineList 1 2
11 12
Documentation:
array,
foreach,
incr,
lappend,
lindex,
lmap (for Tcl 8.5),
lmap,
parray,
set,
split,
string

The code works for windows :
TCL file code is :
proc captureImage {} {
#open the image config file.
set configFile [open "C:/main/image_config.txt" r]
#To retrive the values from the config file.
while {![eof $configFile]} {
set part [split [gets $configFile] "="]
set props([string trimright [lindex $part 0]]) [string trimleft [lindex $part 1]]
}
close $configFile
set time [clock format [clock seconds] -format %Y%m%d_%H%M%S]
set date [clock format [clock seconds] -format %Y%m%d]
#create the folder with the current date
set folderPath $props(folderPath)
append folderDate $folderPath "" $date "/"
set FolderCreation [file mkdir $folderDate]
while {0} {
if { [file exists $date] == 1} {
}
break
}
#camera selection to capture image.
set camera "video"
append cctv $camera "=" $props(cctv)
#set the image resolution (XxY).
set resolutionX $props(resolutionX)
set resolutionY $props(resolutionY)
append resolution $resolutionX "x" $resolutionY
#set the name to the save image
set imagePrefix $props(imagePrefix)
set imageFormat $props(imageFormat)
append filename $folderDate "" $imagePrefix "_" $time "." $imageFormat
set logPrefix "Image_log"
append logFile $folderDate "" $logPrefix "" $date ".txt"
#ffmpeg command to capture image in background
exec ffmpeg -f dshow -benchmark -i $cctv -s $resolution $filename >& $logFile &
after 3000
}
}
captureImage
thext file code is :
cctv=Integrated Webcam
resolutionX=1920
resolutionY=1080
imagePrefix=ImageCapture
imageFormat=jpg
folderPath=c:/test/
//camera=video=Integrated Webcam,Logitech HD Webcam C525
This code works for me me accept the code from text file were list of parameters are passed.

Related

Include line nr in search result

I'm trying to figure out how to search a log file for "word" and also include on what line the "word" was found at.
Also if one can read from bottom to top?
Any ideas?
thanks!
set seen_trigger2 ".foo"
bind pub -|- $seen_trigger2 seen2:main
proc number {list} {
lmap item $list {list [incr number] $item}
}
proc seen2:main {nick uhost hand chan text} {
set f [open /home/mydir/eggdrop/logs/mylog.txt]
set lines [split [read $f] "\n"]
close $f
set pattern $text
set reverseNumberedLines [lreverse [number $lines]]
foreach lineInfo [lsearch -all -inline -index 1 $lines $pattern] {
lassign $lineInfo lineNumber lineContent
putlog "$lineNumber : $lineContent"
}
}
...
Thank you glenn jackman!
Thank you Donal Fellows!
Reading from bottom to top is fairly expensive except in the degenerate case where all lines are exactly the same length. It's easier to read the whole lot in, split into lines, and reverse.
# Some features used aren't in 8.5 and before
package require Tcl 8.6
# Generates “line” numbers
proc number {list} {
lmap item $list {list [incr number] $item}
}
# Classic get-all-the-lines code snippet
set f [open theFile.txt]
set lines [split [read $f] "\n"]
close $f
# Number and reverse
set reverseNumberedLines [lreverse [number $lines]]
# Find the matching lines
foreach lineInfo [lsearch -all -inline -index 1 $lines $pattern] {
lassign $lineInfo lineNumber lineContent
puts "$lineNumber : $lineContent"
}
Note that I'm using the -index 1 option, which basically applies lindex $item 1 to each item in the list (the first sub-item is the line number, the second is the line text) before doing the search. Since we already have all the line numbers applied, we don't care about the actual indices we found them at, and can -inline the results.

Tcl: how to print one set

My file to be parsed is like this
Name : John
Pin : 5400
Age : 40
Place: Korea
Amount : 4000
Name : Peter
Pin : 6700
Age : 10
Place : Japan
Amount : 3600
My tcl code is
set start "Name"
set pn "Pin"
set ag "Age"
set ag_cutoff 15
set amnt "Amount"
foreach line [split $content "\n"] {
if {[regexp $start $line]} {
set count 1
set l1 $line
}
if {[regexp $pn $line] && $count ==1} {
set pin_val [lindex $line 2]
set l2 $line
}
if {[regexp $ag $line] && $count ==1} {
set ag [lindex $line 2]
if { $ag > $ag_cutoff} {
set rep_taken 1
set l3 $line
}
if {[regexp $amnt $line] && $count ==1 && $rep_taken == 1} {
set age_val [lindex $line 2]
puts $op1 "$ag $age_val "
puts $op2 "$l1\n$l2\n$l3\n"
}
This code is fine for plots.
However, I also want to o/p a file with complete set where $ag>$ag_cutoff.
Now with puts $op3 "$l1\n$l2\n$l3\n" ---> Able to print to a file. But how to print line Place which is not evaluated. Any better way to accomplish this.
Name : John
Pin : 5400
Age : 40
Place : Korea
Amount : 4000
It would be a lot simpler to let the parsing loop just create a dictionary (this replaces your code above):
set data {}
set count 0
foreach line [split $content \n] {
if {[lindex $line 0] eq "Name"} {
incr count
}
dict set data $count [lindex $line 0] [lindex $line 2]
}
This will blow up if the first line doesn't start with "Name", or if there is a missing blank between a colon and a word, and also if a value consists of several words. All of these are easy to fix.
Here, for instance, is an expanded version that takes care of the last two problems, should they occur:
set data {}
set count 0
foreach line [split $content \n] {
set keyword [string trimright [lindex $line 0] :]
set value [string trimleft [lrange $line 1 end] {: }]
if {$keyword eq "Name"} {
incr count
}
dict set data $count $keyword $value
}
When all records are stored, one can output selected records using dictionary iteration:
set ag_cutoff 15
dict for {count record} $data {
if {[dict get $record Age] > $ag_cutoff} {
dict for {k v} $record {
puts "$k : $v"
}
}
}
This also means that you can keep adding fields to the records, and the code will still work without change.
Precautions
If the data in content has empty lines at the beginning or end, or between some lines, these methods won't work. A simple way to guard against empty or blank lines at the beginning or the end is to replace
foreach line [split $content \n] {
with
foreach line [split [string trim $content] \n] {
If empty / blank lines may occur within the data, one can use this to skip them:
foreach line [split $content \n] {
if {[string is space $line]} continue
If one is 100% sure that all data is in proper list form, it is possible (but a bit code-smelly) to use list commands like lindex on it directly. If one is less sure, or if one wants to be more correct, one should convert each line to a list before working on it:
foreach line [split $content \n] {
set line [split $line]
Documentation: dict, foreach, if, incr, lindex, lrange, puts, set, split, string

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

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