tcl add counter to identical list values - list

Question

I have a list with values:
set unnumbered [list 101 101 101 102 102 103 104 105 105 105 106]
I want to add a counter to subsequent identical values like this:
numbered [ 101.1 101.2 101.3 102.1 102.2 103 104 105.1 105.2 105.3 106]
So far I have tried the following:
set unnumbered [list 101 101 101 102 102 103 104 105 105 105 106]
set numbered [list ]
set previous [lindex $unnumbered 0]
set subcounter 1
foreach current $unnumbered {
if { $current eq $previous } {
lappend numbered $current.$counter
set previous $current
incr subcounter
} else {
lappend numbered $current
set previous $current
set subcounter 1
}
}
The result is almost what I need.
101.1 101.2 101.3 102 102.1 103 104 105 105.1 105.2 106
For all but the first value, the Counter starts to Count to late. The first 102 laks the ".1"
How can I fix this?

Answer 1

The problem is that your code doesn't have enough information at the point where a number is added to numbered. Get the information first, and then apply it.
First, create a list where each item is a list consisting of one of the unique numbers in $unnumbered and the indices in $unnumbered where that number occurs:
lmap n [lsort -unique $unnumbered] {
list $n [lsearch -all $unnumbered $n]
}
# => {101 {0 1 2}} {102 {3 4}} {103 5} {104 6} {105 {7 8 9}} {106 10}
For each of those items, split up the item into n = the number and indices = the indices. Check how many indices you have. For more than one index, add enumerated numbers like this:
set i 0
foreach index $indices {
lappend numbered $n.[incr i]
}
For single indices, just add the number:
lappend numbered $n
The whole program looks like this:
set unnumbered [list 101 101 101 102 102 103 104 105 105 105 106]
set numbered [list]
foreach item [lmap n [lsort -unique $unnumbered] {
list $n [lsearch -all $unnumbered $n]
}] {
lassign $item n indices
if {[llength $indices] > 1} {
set i 0
foreach index $indices {
lappend numbered $n.[incr i]
}
} else {
lappend numbered $n
}
}
Documentation:
> (operator),
foreach,
if,
incr,
lappend,
lassign,
list,
llength,
lmap (for Tcl 8.5),
lmap,
lsearch,
lsort,
set
If you don’t have lmap, see the link above. If you don’t have lassign, use
foreach {n indices} $item break
instead.
ETA If the "no index on singleton numbers" requirement can be relaxed, one could do it this way:
set previous {}
lmap num $unnumbered {
if {$num ne $previous} {
set i 0
}
set previous $num
format %d.%d $num [incr i]
}
Another variant. It’s very similar to Jerry’s second suggestion, but I didn’t see that one until I was going to submit this, honest. This one assumes that no element in $unnumbered is the empty string.
set numbered [list]
set rest [lassign $unnumbered current next]
set i 0
while 1 {
if {$current eq $next} {
lappend numbered $current.[incr i]
} else {
if {$i > 0} {
lappend numbered $current.[incr i]
set i 0
} else {
lappend numbered $current
}
set current $next
}
if {$next eq {}} break
set rest [lassign $rest next]
}

Answer 2

Another approach: maintain a dict to keep the count of what you've seen so far
set unnumbered [list 101 101 101 102 102 103 104 105 105 105 106]
set count [dict create]
set numbered {}
foreach num $unnumbered {
dict incr count $num
lappend numbered "$num.[dict get $count $num]"
}
puts $numbered
101.1 101.2 101.3 102.1 102.2 103.1 104.1 105.1 105.2 105.3 106.1
Using an array is a little simpler: taking advantage of the fact that incr returns the new count
set numbered {}
array set count {}
foreach num $unnumbered {lappend numbered "$num.[incr count($num)]"}
OK, I missed the requirement that singleton entries should not have a suffix. There's this, but it may re-order the initial list:
set count [dict create]
foreach num $unnumbered {dict incr count $num}
set numbered {}
foreach num [dict keys $count] {
set c [dict get $count $num]
if {$c == 1} {
lappend numbered $num
} else {
for {set i 1} {$i <= $c} {incr i} {
lappend numbered "$num.$i"
}
}
}
puts $numbered
101.1 101.2 101.3 102.1 102.2 103 104 105.1 105.2 105.3 106
Or, this maintains the original order
set count [dict create]
foreach num $unnumbered {dict incr count $num}
foreach key [dict keys $count] {
if {[dict get $count $key] == 1} {
set count [dict remove $count $key]
}
}
set numbered {}
foreach num [lreverse $unnumbered] {
if {![dict exists $count $num]} {
lappend numbered $num
} else {
lappend numbered "$num.[dict get $count $num]"
dict incr count $num -1
}
}
set numbered [lreverse $numbered]
puts $numbered
101.1 101.2 101.3 102.1 102.2 103 104 105.1 105.2 105.3 106

Answer 3

An O(n) solution (single loop), and which I believe looks a bit more like how you initially wanted to implement it:
set unnumbered [list 101 101 101 102 102 103 104 105 105 105 106]
set numbered [list]
set previous ""
set subcounter 1
foreach current $unnumbered {
if {$previous == ""} {
# First, do nothing except set $current to $previous later below
} elseif {$previous == $current} {
lappend numbered $previous.$subcounter
incr subcounter
} else {
if {$subcounter > 1} {
lappend numbered $previous.$subcounter
} else {
lappend numbered $previous
}
set subcounter 1
}
set previous $current
}
if {$subcounter > 1} {
lappend numbered $current.$subcounter
} else {
lappend numbered $current
}
The loop basically adds one number late to the numbered list, so that the last if is required for the last number. Of course, this only works if you know that unnumbered is sorted.
EDIT: Actually this is even closer! Since you can already get $previous, you can loop starting from the next element of the list, and one last time after the last element (note that we get a blank if the lindex is supplied with an out of range index, which makes things easier here).
set unnumbered [list 101 101 101 102 102 103 104 105 105 105 106]
set numbered [list]
set previous [lindex $unnumbered 0]
set subcounter 1
for {set i 1} {$i <= [llength $unnumbered]} {incr i} {
if {$previous == [lindex $unnumbered $i]} {
lappend numbered $previous.$subcounter
incr subcounter
} else {
if {$subcounter > 1} {
lappend numbered $previous.$subcounter
} else {
lappend numbered $previous
}
set subcounter 1
}
set previous [lindex $unnumbered $i]
}