How to remove duplicate element from Tcl list say:
list is like [this,that,when,what,when,how]
I have Googled and have found lsort unique but same is not working for me. I want to remove when from list.
The following works for me
set myList [list this that when what when how]
lsort -unique $myList
this returns
how that this what when
which you could store in a new list
set uniqueList [lsort -unique $myList]
You could also use an dictionary, where the keys must be unique:
set l {this that when what when how}
foreach element $l {dict set tmp $element 1}
set unique [dict keys $tmp]
puts $unique
this that when what how
That will preserve the order of the elements.
glenn jackman's answer work perfectly on Tcl 8.6 and above.
For Tcl 8.4 and below (No dict command). You can use:
proc list_unique {list} {
array set included_arr [list]
set unique_list [list]
foreach item $list {
if { ![info exists included_arr($item)] } {
set included_arr($item) ""
lappend unique_list $item
}
}
unset included_arr
return $unique_list
}
set list [list this that when what when how]
set unique [list_unique $list]
This will also preserve the order of the elements
and this is the result:
this that when what how
Another way, if do not wanna use native lsort function.This is what the interviewer asks :)
`set a "this that when what when how"
for {set i 0} {$i < [llength $a]} {incr i} {
set indices [lsearch -all $a [lindex $a $i]]
foreach index $indices {
if {$index != $i} {
set a [lreplace $a $index $index]
}
}
}
`
Related
My goal is to find the next key in an array... below my data :
# Index increment may change, there is not necessarily continuity like this example.
# My $index can be 1,2,3,4,8,12,25,32...
# but the size of my array is about 100,000 elements.
for {set index 1} {$index < 100000} {incr index} {
set refdata($index,Pt,X) [expr {10 + $index}]
}
I need to know the next key to be able to build a geometric line... I did not find in the help a command that allows me to find the next key of my array so I created my own function below :
proc SearchNextKeyArrayElement {dataarray mykey} {
upvar $dataarray myarray
set mydata [lsort -dictionary [array names myarray]]
set index [lsearch $mydata $mykey]
if {$index > -1} {
return [lindex $mydata [expr {$index + 1}]]
}
return ""
}
foreach k [lsort -dictionary [array names refdata]] {
if {[string match "*,Pt,*" $k]} {
set nextkey [SearchNextKeyArrayElement refdata $k]
}
}
And it takes a long time...array nextelement command is maybe the solution...But I do not understand how to use it ?
Here's an example:
start a search with array startsearch
loop while array anymore is true
get the next key with array nextelement
tidy up with array donesearch
use try {} catch {} finally for safety
# array foreach
# to be subsumed in Tcl 8.7 by `array for`
# https://core.tcl.tk/tips/doc/trunk/tip/421.md
#
# example:
# array set A {foo bar baz qux}
# array foreach {key val} A {puts "name=$key, value=$val"}
#
# A note on performance: we're not saving any time with this approach.
# This is essentially `foreach name [array names ary] {...}
# We are saving memory: iterating over the names versus extracting
# them all at the beginning.
#
proc array_foreach {vars arrayName body} {
if {[llength $vars] != 2} {
error {array foreach: "vars" must be a 2 element list}
}
lassign $vars keyVar valueVar
# Using the complicated `upvar 1 $arrayName $arrayName` so that any
# error messages propagate up with the user's array name
upvar 1 $arrayName $arrayName \
$keyVar key \
$valueVar value
set sid [array startsearch $arrayName]
# If the array is modified while a search is ongoing, the searchID will
# be invalidated: wrap the commands that use $sid in a try block.
try {
while {[array anymore $arrayName $sid]} {
set key [array nextelement $arrayName $sid]
set value [set "${arrayName}($key)"]
uplevel 1 $body
}
} trap {TCL LOOKUP ARRAYSEARCH} {"" e} {
puts stderr [list $e]
dict set e -errorinfo "detected attempt to add/delete array keys while iterating"
return -options $e
} finally {
array donesearch $arrayName $sid
}
return
}
Generally speaking, Tcl arrays have no order at all; they can change their order on any modification to the array or any of its elements. The commands that iterate over the array (array for, array get, array names, and the iteration commands array startsearch/array nextelement/array anymore) only work with the current order. However, you can use array names to get the element names into a Tcl list (which is order preserving), sort those to get the order that you're going to iterate over, and then use foreach over that. As long as you're not adding or removing elements, it'll be fine. (Adding elements is sort-of OK too; you'll just not see them in your iteration.)
foreach key [lsort -dictionary [array names myarray]] {
ProcessElement $key $myarray($key)
}
By contrast, trying to just go from one element to the next will hurt a lot; that operation is not exposed.
Using the iteration commands is done like this:
set s [array startsearch myarray]
while {[array anymore myarray $s]} {
set key [array nextelement myarray $s]
ProcessElement $key $myarray($key)
}
Note that you don't get an option to sort the search. You won't see these used much in production code; doing array names or array get is usually better. And now (well, 8.7 is still in alpha) you've also got array for:
array for {key value} myarray {
ProcessElement $key $value
}
Efficient for large arrays, but still doesn't permit sorting; supporting direct sorting would require a different sort of storage engine on the back of the array.
This is why it's slow: You're sorting the array names once for the foreach command and then again for each element. Sort once and cache it, then you can iterate over it much more efficiently
set sorted_names [lsort -dictionary [array names refdata -glob {*,Pt,*}]]
set len [llength $sorted_names]
for {set i 0; set j 1} {$i < $len} {incr i; incr j} {
set this_name [lindex $sorted_names $i]
set next_name [lindex $sorted_names $j]
# ...
}
I have following code to print string which appears more than once in the list
set a [list str1/str2 str3/str4 str3/str4 str5/str6]
foreach x $a {
set search_return [lsearch -all $a $x]
if {[llength $search_return] > 1} {
puts "search_return : $search_return"
}
}
I need to print str3/str4 which appears more than once in the list
The canonical methods of doing this are with arrays or dictionaries, both of which are associative maps. Here's a version with a single loop over the data using a dictionary (it doesn't know the total number of times an item appears when it prints, but sometimes just knowing you've got a multiple is enough).
set a [list str1/str2 str3/str4 str3/str4 str5/str6]
# Make sure that the dictionary doesn't exist ahead of time!
unset -nocomplain counters
foreach item $a {
if {[dict incr counters $item] == 2} {
puts "$item appears several times"
}
}
I guess you could use an array to do something like that, since arrays have unique keys:
set a [list str1/str2 str3/str4 str3/str4 str5/str6]
foreach x $a {
incr arr($x) ;# basically counting each occurrence
}
foreach {key val} [array get arr] {
if {$val > 1} {puts "$key appears $val times"}
}
How to get the result of a tcl exec command into an array of strings where each item is a line of my exec output?
Example:
exec ls -la
How to capture that result into an array and print it in a foreach?
Can I advise you to use list instead of array? If so...
set output [exec ls]
set output_list [split $output \n]
foreach line $output_list {
puts $line
}
List is much more useful collection in this situation, because all you need is to store lines one by one. On the other hand, array in Tcl was made to store named collection (without order).
I can make it with array, but it would be ugly.
set output [exec ls]
set output_list [split $output \n]
set i 0
foreach line $output_list {
set arr($i) $line
incr i
}
foreach index [array names arr] {
puts $arr($index)
}
As you can see, foreach for arrays can't guaranty order of records. For example I've got this
% foreach index [array names arr] {
puts arr($index)
}
arr(8)
arr(4)
arr(0)
arr(10)
arr(9)
arr(5)
arr(1)
arr(6)
arr(2)
arr(7)
arr(3)
So if you want to work with array as it is ordered collection, you need to use counter.
for {set i 0} {$i < [array size arr]} {incr i} {
puts $arr($i)
}
I suspect there is a one liner that takes an array into a string which looks like x=1;y=2;z=3. How can I do that? I am currently using
set vals [join [array names a] \;]
to get x;y;z but would like the values in there. If there happens not to be a value, I would like to skip the = sign, e.g., x=1;y;z=3. Maybe with array get?
This gets all the info in there, but the result looks like x;1;y;2;z;3;q;3
set vals [join [array get a] \;]
some how I'm thinking there is a slice we can take here
Update. Yes, I know that you could do a foreach, but I wonder if there is a one-liner. For example this seems to work
foreach { k v } [array get a] {
if {$v ne ""} {
lappend valList $k=$v
} else {
lappend valList $k
}
}
set vals [join $valList \;]
join [lmap {k v} [array get a] {if {$v ne {}} {join [list $k $v] =} {set k}}] \;
If your Tcl doesn't have lmap, there's a handy replacement.
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).