tcllibs longestCommonPrefixList

# That's the implementation currently in tcllib as
# ::textutil::string::longestCommonPrefixList
proc longestCommonPrefixList {list} {
    if {[llength $list] == 0} {
        return ""
    } elseif {[llength $list] == 1} {
        return [lindex $list 0]
    }

    set list [lsort  $list]
    set min  [lindex $list 0]
    set max  [lindex $list end]

    # Min and max are the two strings which are most different. If
    # they have a common prefix, it will also be the common prefix for
    # all of them.

    # Fast bailouts for common cases.

    set n [string length $min]
    if {$n == 0}                         {return ""}
    if {0 == [string compare $min $max]} {return $min}

    set prefix ""
    for {set i 0} {$i < $n} {incr i} {
        if {0 == [string compare [set x [string range $min 0 $i]] [string range $max 0 $i]]} {
            set prefix $x
            continue
        }
        break
    }
    return $prefix
}

proc longestCommonPrefix2List {list} {
    if {[llength $list] == 0} {
        return ""
    } elseif {[llength $list] == 1} {
        return [lindex $list 0]
    }

    set list [lsort  $list]
    set min  [lindex $list 0]
    set max  [lindex $list end]

    # Min and max are the two strings which are most different. If
    # they have a common prefix, it will also be the common prefix for
    # all of them.

    # Fast bailouts for common cases.

    set n [string length $min]
    if {$n == 0}                         {return ""}
    if {0 == [string compare $min $max]} {return $min}

    set prefix ""
    for {set i 0} {$i < $n} {incr i} {
        # Using eq in the if expr speed up things a little bit more,
        # but would require [package require Tcl 8.4]
        if {[string index $min $i] == [string index $max $i]} {
            append prefix [string index $min $i]
            continue
        }
        break
    }
    return $prefix
}


set repeat 1000
foreach input {
    {foo bar}
    {foo fbar}
    {foo fox fubar}
    {http://www.foo.com http://www.bar.com http://www.baz.com}
} {
    puts "longestCommonPrefixList  \
          [time {longestCommonPrefixList $input} $repeat]"
    puts "longestCommonPrefix2List \
          [time {longestCommonPrefix2List $input} $repeat]"
}

# longestCommonPrefix2List is faster with 8.4 and 8.5.
# Plus: longestCommonPrefix2List is IMHO a little bit easier to
# understand.
# Though, with 8.3 it is slower than what tcllib has.
# But I'd say, it's better to optimise tcllib for recent tcl versions,
# as long as the code still run with older ones, than the other way
# around.