tcl add counter to identical list values

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?

Peter Lewerin · Accepted Answer · 2017-10-17T11:44:20.250

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

glenn jackman · Answer 2 · 2017-10-16T13:32:45.390

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

Good solution, but doesn't help if one wants to keep singleton numbers unindexed. — Peter Lewerin, Oct 16 '17 at 13:03

Jerry · Answer 3 · 2017-10-17T09:14:44.577

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

tcl add counter to identical list values

3 Answers3