How to generate a summary from a list? - tcl

Question

I have a list:
set aList {aa aa aa bb bb cc cc cc cc aa aa bb cc cc cc cc}
I would like to generate a summary that looks something like:
3 aa 2 bb 4 cc 2 aa 1 bb 4 cc
I am able to generate the summary by using a foreach loop, but am looking for a better solution.

Answer 1

What you are asking for is basically an RLE encoding command. I don't know of any, but there might be one somewhere -- whether it fits your format is another matter. There is a page called RLE on the wiki, but that's just a user signature.
Otherwise, it's hard to avoid iterating commands when processing an iterative structure. You could try recursion:
set aList {aa aa aa bb bb cc cc cc cc aa aa bb cc cc cc cc}
proc summarize {result theList} {
if {[llength $theList] eq 0} {
return $result
} else {
summarize {*}[count $result $theList 1]
}
}
proc count {result theList theCount} {
set theList [lassign $theList theToken]
if {$theToken eq [lindex $theList 0]} {
count $result $theList [incr theCount]
} else {
list [lappend result $theCount $theToken] $theList
}
}
summarize [list] $aList
Brief commentary: the summarize function works with two lists, an even-sized (initially empty) list of counts and tokens (result) and a list of unprocessed tokens (theList). If theList is empty, the result list is the result of the operation. If there is at least one token in theList, we prepare a new pair of similar lists by counting how many identical tokens we have in the head of theList, and summarize those two lists instead. For every application, result will be longer by one pair, and theList will be shorter by some number of tokens ≥1.
It could be expressed symbolically (with quasi-ML notation) as
 summarize (R, Ø) → R
 summarize (R, L) → summarize count (R, L, 1)
The count function takes the same two lists, and also a count (initially 1: if theList wasn't empty, we will always have at least one token to count). It breaks off one token at the head of theList and compares it to the (now shortened) theList. If theToken is identical to the first token in theList, we increment theCount and apply count again. If it isn't, we extend result with theCount and theToken, having finished counting one kind of token (execution then passes back through the layers of calls back to summarize).
Note that calling count with an empty list for theList will result in an infinite loop: summarize will never call it unless there are tokens in theList.
 count (R, (T :: (T :: L)), N) → count (R, (T :: L), N+1)
 count (R, (a :: L), N) → ((R # (N :: (a :: Ø))), L)

Answer 2

Following function which runs through the list and maintains count of current item works:
proc group_identical {slist} {
set newlist {}
set current [lindex $slist 0]
set count 0
foreach ele $slist {
if { ![string compare $ele $current] } { ;# same as current;
incr count
} else { ;# new element
lappend newlist $count $current
set current $ele
set count 1
}
}
lappend newlist $count $current
return $newlist
}
set aList {aa aa aa bb bb cc cc cc cc aa aa bb cc cc cc cc}
puts [group_identical $aList]
Output:
3 aa 2 bb 4 cc 2 aa 1 bb 4 cc