LinkedList in XOTcl

コメントを残す

いわゆる双方向連結リストというデータ構造ですが、かつてはリチャードストールマンに、Tclには構造体がないからlinked listを作れないと指摘されていました。今ではいくつもあるオブジェクト指向拡張を使い、クラスを導入すればTclでも他の言語と同じような形で実装できます。

arrayでもできますが、あまり使いやすくならないと思うので、僕はXOTclでLinkedList::ContainerとLinkedList::Elementというクラスを作っていて、これらを継承するか、mixinしたクラスは、連結リストの管理オブジェクト、リスト要素として扱えるようにしています。

通常のリストに比べると、要素が少ないうちは遅いですが、数千数万の要素数になってくるとかなり効率が違ってきます。

テストスクリプト

package require -exact linkedlist 3.0
 
Class ListContainer -instmixin {LinkedList::Container}
Class ListElement -instmixin {LinkedList::Element}
 
proc test_linkedlist {size} {
	set container [ListContainer new]
	for {set i 0} {$i < $size} {incr i} {
		$container push [ListElement new]
	}
	foreach e [$container rlist] {
		$container delete $e
	}
	return {}
}
 
proc test_nativelist {size} {
	set l {}
	for {set i 0} {$i < $size} {incr i} {
		lappend l $i
	}
	for {set i 0} {$i < $size} {incr i} {
		set l [lreplace $l end end]
	}
	return {}
}
 
foreach size {1000 10000 15000 20000 30000} {
	puts "size=$size"
	puts "linkedlist [time {test_linkedlist $size} 2]"
	puts "nativelist [time {test_nativelist $size} 2]"
	puts ""
}

結果

C:\Tcl\lib\linkedlist3>
tclsh test2.tcl
size=1000
linkedlist 30047.5 microseconds per iteration
nativelist 2168.5 microseconds per iteration
 
size=10000
linkedlist 307218.5 microseconds per iteration
nativelist 215719.0 microseconds per iteration
 
size=15000
linkedlist 491008.5 microseconds per iteration
nativelist 469101.5 microseconds per iteration
 
size=20000
linkedlist 627835.0 microseconds per iteration
nativelist 900121.5 microseconds per iteration
 
size=30000
linkedlist 962158.5 microseconds per iteration
nativelist 1995813.5 microseconds per iteration

tktableなんかもarrayをデータソースにすると高速なんですが、arrayを直接操作するよりも、データの順序などを安全に扱うことができる連結リストでデータ管理するのがいいと思います。

package require XOTcl
namespace import xotcl::*
 
namespace eval LinkedList {}
 
Class LinkedList::Container
 
LinkedList::Container instproc init {} {
	my set first {}
	my set last {}
	my set size 0
	next
}
 
LinkedList::Container instproc destroy {} {
	set es [my list]
	foreach e $es {
		my drop $e
	}
	next
	return $es
}
 
LinkedList::Container instproc clear {} {
	set es [my list]
	foreach e $es {
		$e destroy
	}
	return {}
}
 
LinkedList::Container instproc first {} {
	my instvar first
	return $first
}
 
LinkedList::Container instproc last {} {
	my instvar last
	return $last
}
 
LinkedList::Container instproc size {} {
	my instvar size
	return $size
}
 
LinkedList::Container instproc unlink {element} {
	my instvar size first last
 
	if {![Object isobject $element]} {return -1}
	if {[$element container] != [self]} {return -1}
 
	set prev [$element prev_p]
	set next [$element next_p]
 
	$element prev_p {}
	$element next_p {}
	$element container {}
 
	if {$prev eq {}} {
		set first $next
	} else {
		$prev next_p $next
	}
	if {$next eq {}} {
		set last $prev
	} else {
		$next prev_p $prev
	}
 
	incr size -1
}

# private
LinkedList::Container instproc add {element} {
	my instvar size first last
	if {[$element next_p] == $first} {
		set first $element
	}
	if {[$element prev_p] == $last} {
		set last $element
	}
	$element container [self]
	incr size
	return $element
}
 
LinkedList::Container instproc scan {key value} {
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		if {[$e $key] == $value} {return $e}
	}
}
 
LinkedList::Container instproc at {index} {
	if {$index == "end"} {return [my last]}
	if {$index < 0 || [my size] <= $index} {return {}}
	set i 0
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		if {$i == $index} {return $e}
		incr i
	}
	return {}; # not found
}
 
LinkedList::Container instproc list {} {
	set es {}
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		lappend es $e
	}
	return $es
}
 
LinkedList::Container instproc rlist {} {
	set es {}
	for {set e [my last]} {$e != {}} {set e [$e prev_p]} {
		lappend es $e
	}
	return $es
}
 
LinkedList::Container instproc index {element} {
	set i 0
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		if {$e == $element} {return $i}
		incr i
	}
	return -1; # not found
}
 
LinkedList::Container instproc pop {} {
	set last [my last]
	my drop $last
}
 
LinkedList::Container instproc push {element} {
	set last [my last]
	if {$last == {}} {
		my add $element
	} else {
		$last append $element
	}
	return $element
}
 
LinkedList::Container instproc shift {} {
	my drop [my first]
}
 
LinkedList::Container instproc unshift {element} {
	set first [my first]
	if {$first == {}} {
		my add $element
	} else {
		$first prepend $element
	}
	return $element
}
 
LinkedList::Container instproc drop {element} {
	if {[my unlink $element] >= 0} {
		return $element
	}
}
 
LinkedList::Container instproc delete {element} {
	if {![Object isobject $element]} {
		$element destroy
	}
}

# InstMixin this class into element class to use container
Class LinkedList::Element -parameter {
	{prev_p {}}
	{next_p {}}
	{container {}}
}
 
LinkedList::Element instproc destroy {} {
	my drop
	next
	return [self]
}
 
LinkedList::Element instproc drop {} {
	if {[my container] != {}} {
		[my container] drop [self]
	}
}
 
LinkedList::Element instproc index {} {
	if {[my container] != {}} {
		[my container] index [self]
	}
}
 
LinkedList::Element instproc append {element} {
	if {[my container] != {}} {
		$element prev_p [self]
		$element next_p [my next_p]
		if {[my next_p] != {}} {
			[my next_p] prev_p $element
		}
		my next_p $element
		[my container] add $element
	}
}
 
LinkedList::Element instproc prepend {element} {
	if {[my container] != {}} {
		$element prev_p [my prev_p]
		$element next_p [self]
		if {[my prev_p] != {}} {
			[my prev_p] next_p $element
		}
		my prev_p $element
		[my container] add $element
	}
}
 
LinkedList::Element instproc status {} {
	append stat "  container = [my container]\n"
	append stat "  index     = [my index]\n"
	append stat "  element   = [self]\n"
	append stat "  neighbors = ([my prev_p]) => ([self]) => ([my next_p])\n"
}
 
package provide linkedlist 3.0

パッケージにしておきました。
linkedlist.3.0.120823

コメントを残す

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください。