Posted to tcl by de at Fri Mar 21 15:52:32 GMT 2008view raw

  1.  
  2. # That's the implementation currently in tcllib as
  3. # ::textutil::string::longestCommonPrefixList
  4. proc longestCommonPrefixList {list} {
  5. if {[llength $list] == 0} {
  6. return ""
  7. } elseif {[llength $list] == 1} {
  8. return [lindex $list 0]
  9. }
  10.  
  11. set list [lsort $list]
  12. set min [lindex $list 0]
  13. set max [lindex $list end]
  14.  
  15. # Min and max are the two strings which are most different. If
  16. # they have a common prefix, it will also be the common prefix for
  17. # all of them.
  18.  
  19. # Fast bailouts for common cases.
  20.  
  21. set n [string length $min]
  22. if {$n == 0} {return ""}
  23. if {0 == [string compare $min $max]} {return $min}
  24.  
  25. set prefix ""
  26. for {set i 0} {$i < $n} {incr i} {
  27. if {0 == [string compare [set x [string range $min 0 $i]] [string range $max 0 $i]]} {
  28. set prefix $x
  29. continue
  30. }
  31. break
  32. }
  33. return $prefix
  34. }
  35.  
  36. proc longestCommonPrefix2List {list} {
  37. if {[llength $list] == 0} {
  38. return ""
  39. } elseif {[llength $list] == 1} {
  40. return [lindex $list 0]
  41. }
  42.  
  43. set list [lsort $list]
  44. set min [lindex $list 0]
  45. set max [lindex $list end]
  46.  
  47. # Min and max are the two strings which are most different. If
  48. # they have a common prefix, it will also be the common prefix for
  49. # all of them.
  50.  
  51. # Fast bailouts for common cases.
  52.  
  53. set n [string length $min]
  54. if {$n == 0} {return ""}
  55. if {0 == [string compare $min $max]} {return $min}
  56.  
  57. set prefix ""
  58. for {set i 0} {$i < $n} {incr i} {
  59. # Using eq in the if expr speed up things a little bit more,
  60. # but would require [package require Tcl 8.4]
  61. if {[string index $min $i] == [string index $max $i]} {
  62. append prefix [string index $min $i]
  63. continue
  64. }
  65. break
  66. }
  67. return $prefix
  68. }
  69.  
  70.  
  71. set repeat 1000
  72. foreach input {
  73. {foo bar}
  74. {foo fbar}
  75. {foo fox fubar}
  76. {http://www.foo.com http://www.bar.com http://www.baz.com}
  77. } {
  78. puts "longestCommonPrefixList \
  79. [time {longestCommonPrefixList $input} $repeat]"
  80. puts "longestCommonPrefix2List \
  81. [time {longestCommonPrefix2List $input} $repeat]"
  82. }
  83.  
  84. # longestCommonPrefix2List is faster with 8.4 and 8.5.
  85. # Plus: longestCommonPrefix2List is IMHO a little bit easier to
  86. # understand.
  87. # Though, with 8.3 it is slower than what tcllib has.
  88. # But I'd say, it's better to optimise tcllib for recent tcl versions,
  89. # as long as the code still run with older ones, than the other way
  90. # around.
  91.