if 0 {Richard Suchenwirth - 2004-06-04 - In the Tcl chatroom I saw a request for finding the position of a sublist in a list, so that
lsubl {a b c a d e} {a d}
would return 3. A number of famous algorithms (only not to me) were mentioned: Knuth-Morris-Pratt, Rabin-Karp, Boyer-Moore-Gosper. I'm more the practical kind of guy, so I decided just to give it a try, like this:
Here's my code: }
proc lsubl {list sublist} { set sl [llength $sublist] if {!$sl} {return 0} foreach i [lsearch -all $list [lindex $sublist 0]] { if {[lrange $list $i [expr {$i+$sl-1}]] eq $sublist} { return $i } } return -1 }
#Tests:
proc ? {c e} {catch $c r; if {$r ne $e} {puts "$c->$r, expected $e"}} ? {lsubl {a b c a d e} {a d}} 3 ? {lsubl {a b c a d e} {a b}} 0 ? {lsubl {a b c a d e} {a f}} -1 ? {lsubl {a b c a d e} {}} 0 ;# empty list is everybody's sublist
if 0 {Could some algorithm-knowers comment, please? :)
FW: Hmm, algorithms for this task are probably so many many because it's pretty much the same idea as finding the index of a substring, which of course is very common. For your one-char items
proc lsubs {list sublist} {string first [[join $sublist ""]] [[join $list ""]]}
works. - RS Clever indeed - thanks! (But the question was of course for general list elements...)
03jun04 jcw - Here's a Boyer-Moore version:
proc lsame {a b {o 0}} { set n [llength $a] while {[incr n -1] >= 0} { if {[lindex $a $n] ne [lindex $b [expr {$n+$o}]]} { return 0 } } return 1 } proc lsubl {l s} { set n [llength $s] if {$n == 0} { return 0 } for {set i 0} {$i < $n} {incr i} { set o([lindex $s $i]) [expr {$n-$i-1}] } set i 0 set m [llength $l] while {$i < $m} { set c [lindex $l $i] if {![info exists o($c)]} { incr i $n } elseif {$o($c) > 0} { incr i $o($c) } else { set k [expr {$i-$n+1}] if {[lsame $s $l $k]} { return $k } incr i } } return -1 }