algotutor-0.8.6.orig/0000755000000000000000000000000010606361777011407 5ustar algotutor-0.8.6.orig/Vertex.pm0000644000000000000000000001124110314773667013222 0ustar # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package Vertex; # Vertex of a Graph use strict; use Carp; use vars qw(@ISA); @ISA = qw(Configurable); use Configurable; use Vector2; use overload '""' => 'stringify', 'fallback' => 1 # 'eq' => '()', # 'fallback' => undef ; sub new { my ($class, $host, $pos, %opts) = @_; $class = ref($class) if ref($class); my ($self) = $class->SUPER::new(%opts); $self->{"#host"} = $host; my ($cv) = $self->host()->cget(-canvas); my ($sh) = $self->cget(-shape); if ("\L$sh" eq "oval") { $self->{shape_id} = $cv->createOval(0,0,2,2); } else { $self->{shape_id} = $cv->createRectangle(0,0,2,2); } $self->{text_id} = $cv->createText(0, 0, -justify=>"center"); $self->set_pos($pos); $self->set_size($self->cget(-size)); $self->configure($self->get_all_opts()); # the following is needed for easier binding statements # $self->{-host}{-canvas}->addtag($self->{-name}, "withtag", $self->{shape_id}); # $self->{-host}{-canvas}->addtag($self->{-name}, "withtag", $self->{text_id}); return $self; } sub destroy { my ($self) = @_; $self->host()->cget(-canvas)->delete(@{$self}{"shape_id","text_id"}); } sub host { return $_[0]->{"#host"}; } sub _get_cv_geom_ { my ($self) = @_; my (@t) = $self->host()->cget(-canvas)->coords($self->{shape_id}); return ( Vector2->new(($t[0] + $t[2]) / 2, ($t[1] + $t[3]) / 2), Vector2->new(abs($t[0] - $t[2]), abs($t[1] - $t[3])), ); } sub pos { my ($self) = @_; croak "you probably wanted to call set_pos()?" if $#_>0; my ($lt) = $self->host()->cget(-linear_transform); my ($pos, undef) = $self->_get_cv_geom_(); return ($pos - $lt->{-offset})->pw_div($lt->{-scale}); } sub size { my ($self) = @_; croak "you probably wanted to call set_size()?" if $#_>0; my ($lt) = $self->host()->cget(-linear_transform); my (undef, $size) = $self->_get_cv_geom_(); return $size->pw_div($lt->{-scale}); } sub set_pos { my ($self, $pos) = @_; my ($lt) = $self->host()->cget(-linear_transform); my (undef, $size) = $self->_get_cv_geom_(); $size = $size->pw_div(2); $pos = $pos->pw_mul($lt->{-scale}) + $lt->{-offset}; my ($cv) = $self->host()->cget(-canvas); $cv->coords($self->{text_id}, @$pos); $cv->coords($self->{shape_id}, @{ $pos-$size }, @{ $pos+$size } ); } sub set_size { my ($self, $size) = @_; my ($lt) = $self->host()->cget(-linear_transform); my ($pos, undef) = $self->_get_cv_geom_(); $size = $lt->{-scale}->pw_mul($size)->pw_div(2); $self->host()->cget(-canvas)->coords($self->{shape_id}, @{ $pos-$size }, @{ $pos+$size } ); } sub configure { my ($self, %opts) = @_; my ($k, %shape_opts, %text_opts); my ($opt_map) = { -text => [undef, "-text"], -fill => ["-fill", undef], -outline => ["-outline", "-fill"], -thick => ["-width", undef], -arrow => ["-arrow", undef], -stipple => ["-stipple", undef], -outlinestipple => [undef, undef], -state => ["-state", "-state"], }; if (exists $opts{-name}) { $self->{-name} = delete $opts{-name}; $opts{-text} = $self->cget(-display)->($self) if ref $self->cget(-display) eq "CODE"; } if (exists $opts{-content}) { $self->{-content} = delete $opts{-content}; $opts{-text} = $self->cget(-display)->($self) if ref $self->cget(-display) eq "CODE"; } if (exists $opts{-status}) { $self->{-status} = delete $opts{-status}; my ($ha) = $self->host()->cget(-appearance); carp "unknown status $self->{-status} ignored" unless exists $ha->{$self->{-status}}; %opts = (%{ $ha->{$self->{-status}} }, %opts); } foreach $k (keys %opts) { carp "unknown option $k ignored" unless exists($opt_map->{$k}); $shape_opts{ $opt_map->{$k}[0] } = $opts{$k} if defined $opt_map->{$k}[0]; $text_opts{ $opt_map->{$k}[1] } = $opts{$k} if defined $opt_map->{$k}[1]; } my ($cv) = $self->host()->cget(-canvas); $cv->itemconfigure($self->{shape_id}, %shape_opts); $cv->itemconfigure($self->{text_id}, %text_opts); } sub display { # serves to print or display a vertex my ($self) = @_; my ($s) = $self->cget(-display)->($self); $s =~ s/\n/ /g; return "V[$s]"; } sub stringify { # serves to identify a vertex, such as key for hash my ($self) = @_; return $self->cget(-name); } sub get_all_opts { my ($self) = @_; my (%opts) = $self->SUPER::get_all_opts(); delete @opts{qw(-display -shape -size)}; return %opts; } $::Config->{Vertex} = { -shape => "oval", -size => Vector2->new(50, 30), -status => "init", -display => sub { return $_[0]->cget(-name); } }; 1; algotutor-0.8.6.orig/graph/0000755000000000000000000000000010247463053012477 5ustar algotutor-0.8.6.orig/graph/pfs0000644000000000000000000000670610243421541013213 0ustar # vim: syntax=perl # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html use strict; sub pfs { my ($gr, $pqcan, %opts) = @_; my ($prio_name, $prio_func, %to_do, $n, $v, %stat, %value, %incoming, $discovery_order, $visit_order); my ($prio_table) = { bfs => '$discovery_order', # Breadth First Search sbs => '$n - $discovery_order', # Stack Based Search prim => '$e->cget(-weight)', # Prim's spanning tree dijk => '$value{$v} + $e->cget(-weight)', # Dijkstra's shorstest path }; $prio_name = ($opts{-priority} or "prim"); croak "unkown priority '$prio_name'" unless exists $prio_table->{$prio_name}; $prio_func = $prio_table->{$prio_name}; %to_do = %{ $gr->cget(-vertices) }; $v = (delete $opts{-start} or (sort keys %to_do)[0]); $v = $to_do{$v}; # my ($print_func) = sub { # my ($x)=@_; # return "$x(" . $self->v_get($x, -value) . " " . $self->v_get($x, -parent) . ")"; # }; $n = [ %to_do ]; $n = ($#$n + 1) / 2; # $self->v_set($v, -value=>0); require Heap; my ($seen) = Heap->new(-canvas=>$pqcan, -compare => sub { my ($v, $w) = @_; return $value{$v} <=> $value{$w}; }, -node_opts=>{ # -shape => "rectangle", -size => [70,50], -display => sub { my ($v) = $_[0]->cget(-content); return "$v\n$value{$v}"; } }, ); $visit_order = $discovery_order = 1; do { $v = $to_do{$v}; $value{$v} = 0; $incoming{$v} = ""; $seen->insert($v); while (not $seen->is_empty()) { $v = $seen->remove(); delete $to_do{$v}; $stat{$v} = "done"; $incoming{$v}->configure(-status=>"done") if ref $incoming{$v}; $opts{-on_vertex}->($v, $value{$v}) if ref $opts{-on_vertex} eq "CODE"; # see comment in graph/dfs $v->configure(-status=>"done"); $v->configure(-text=>"$v\n$visit_order") if $prio_name eq "sbs"; ++$visit_order; $gr->cget(-canvas)->set_mark(0); my ($e, $w); foreach $e ($gr->edges_around($v)) { # if ($incoming{$v} eq $e->twin()) { # # avoid examining the edge pointing back to the parent # $e->configure(-status=>"discard") if $e->cget(-directed); # next; # } $w = $e->target(); my ($new_prio) = eval $prio_func; if (not defined $stat{$w}) { $value{$w} = $new_prio; ++$discovery_order; $stat{$w} = "fringe"; $incoming{$w} = $e; $seen->insert($w); $w->configure(-status=>"pending"); $e->configure(-status=>"pending"); } elsif ($stat{$w} eq "fringe" and $prio_name ne 'sbs' and $new_prio < $value{$w}) { $value{$w} = $new_prio; $incoming{$w}->configure(-status=>"discard"); $incoming{$w} = $e; # fix me! it's O(n) slow... $seen->up(search_heap_for($seen, $w)); $w->configure(-status=>"pending"); $e->configure(-status=>"pending"); } else { # $stat{$w} eq "done" $e->configure(-status=>"discard") unless ($incoming{$v} eq $e->twin() and not $e->cget(-directed)); # avoid painting as back edge the edge pointing # back to the parent } $gr->cget(-canvas)->set_mark(0); } # foreach $e ($gr->edges_around($v)) ... $gr->cget(-canvas)->set_mark(1); } # while (not $seen->is_empty()) ... $v = (keys %to_do)[0]; } while ($v); } sub search_heap_for { my ($h, $v) = @_; my ($i, $n, $t); $n = $h->size(); for ($i=1; $i<=$n; ++$i) { $t = $h->vc($i); return $i if $t eq $v; } croak "internal error: can't find vertex $v"; return 1; } 1; algotutor-0.8.6.orig/graph/flwa0000644000000000000000000000516510123713617013357 0ustar # vim: syntax=perl # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html use strict; my ($min, $via); sub get_path { my ($s, $t) = @_; return () if $s eq $t; my (@a, @b); if (ref $via->{$s}{$t} eq "Vertex") { @a = get_path($s, $via->{$s}{$t}); @b = get_path($via->{$s}{$t}, $t); return (@a,@b); } elsif (ref $via->{$s}{$t}) { # linked directly by an edge return ($via->{$s}{$t}); } else { # unreachable return (); } } sub flwa { my ($gr, %opts) = @_; my ($n2V, @V, $e, $relay, $s, $t, $new_val, $prev, @old_path, @new_path); $n2V = $gr->cget(-vertices); @V = @{ $n2V }{ sort keys %$n2V }; print STDERR "Warning: This algorithm is very slow.\n" . "Please get yourself some exercise while waiting.\n"; foreach $s (@V) { foreach $e ($gr->edges_around($s)) { $t = $e->target(); $min->{$s}{$t} = $e->cget(-weight); $via->{$s}{$t} = $e; } $min->{$s}{$s} = 0; } foreach $relay (@V) { $gr->cget(-canvas)->set_mark(1); print STDERR "[$relay]\n"; foreach $s (@V) { next if $s eq $relay or not defined $min->{$s}{$relay}; foreach $t (@V) { next if $t eq $relay or $t eq $s or not defined $min->{$relay}{$t}; $new_val = $min->{$s}{$relay} + $min->{$relay}{$t}; @old_path = defined $min->{$s}{$t} ? get_path($s,$t) : (); @new_path = (get_path($s,$relay), get_path($relay,$t)); if (ref $prev->{t}) { $prev->{relay}->configure(-status=>"init"); $prev->{s}->configure(-status=>"init"); $prev->{t}->configure(-status=>"init"); map { $_->configure(-status=>"init") } @{ $prev->{path} }; } if (not defined $min->{$s}{$t} or $new_val < $min->{$s}{$t}) { $min->{$s}{$t} = $new_val; $via->{$s}{$t} = $relay; # notice drawing order: both paths may overlap map { $_->configure(-status=>"discard") } @old_path; map { $_->configure(-status=>"pending") } @new_path; } else { map { $_->configure(-status=>"discard") } @new_path; map { $_->configure(-status=>"pending") } @old_path; } $s->configure(-status=>"pending"); $t->configure(-status=>"pending"); $relay->configure(-status=>"focus"); $gr->cget(-canvas)->set_mark(0); $prev = { relay=>$relay, s=>$s, t=>$t, path=>[@old_path, @new_path] }; } } } $prev->{relay}->configure(-status=>"init"); $prev->{s}->configure(-status=>"init"); $prev->{t}->configure(-status=>"init"); map { $_->configure(-status=>"init") } @{ $prev->{path} }; $gr->cget(-canvas)->set_mark(0); #foreach $s (@V) { #foreach $t (@V) { #print "$s=>$t : "; #my (@p) = get_path($s,$t); #print "@p\n"; #} #} } 1; algotutor-0.8.6.orig/BST.pm0000644000000000000000000001173410223724675012376 0ustar # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package BST; # Binary Search Tree use strict; use Carp; use vars qw(@ISA); @ISA = qw(Collection); use Collection; use TreeNode; sub new { my ($class, %opts) = @_; $class = ref($class) if ref($class); my ($t) = delete $opts{-type}; croak "'BST' code does not know how to process '$t' data\n" unless $t eq 'sortable'; my ($self) = $class->SUPER::new(%opts); my ($init_data) = (delete $opts{-init_data} or []); my ($operation) = (delete $opts{-operation} or []); my ($dummy) = TreeNode->new($self, undef, -status=>"hidden"); $self->{rootparent} = $dummy; my ($v); foreach $v (@$init_data) { # -node_opts is taken care of in insert() $self->insert($v); $self->cget(-canvas)->set_mark(1); } while (@$operation) { my ($op) = shift @$operation; my ($data) = shift @$operation; if ($op eq 'remove') { # $data->{area} = 0 unless defined $data->{area}; # $data->{name} = '?' unless defined $data->{name}; $self->remove($data); } elsif ($op eq 'insert') { $self->insert($data); } elsif ($op eq 'rot_cw') { $self->rotate_cw($data); } elsif ($op eq 'rot_ccw') { $self->rotate_ccw($data); } else { carp "unknown operation '$op' ignored\n"; } $self->cget(-canvas)->set_mark(1); } return $self; } sub root { # my ($self, $nv) = @_; my ($self, $nv) = @_; die if defined $nv; return $self->{rootparent}->child(0); } sub search { my ($self) = shift @_; return $self->root()->search(@_); } sub insert { my ($self, $sk_cont, %opts) = @_; # $sk_cont is search key, should have the same structure as -content=>... die "insertion works only for binary trees" unless $self->cget(-ary) == 2; my ($parent, $rank, $r, $c, $nn); if (ref $self->root()) { $parent = $self->search($sk_cont, -to_leaf=>1); $rank = $self->cget(-compare)->( $sk_cont, $parent->cget(-content) ); # skewed!! bad!! please check the case when compare returns 0 $rank = $rank <= 0 ? 0 : 1; } else { $parent = $self->{rootparent}; $rank = 0; } %opts = ( %{ $self->cget(-node_opts) }, %opts ); $nn = TreeNode->new($parent, $rank, -content=>$sk_cont, %opts); # as always, the host should take care of prepending %opts with -node_opts $nn->configure(-status=>"focus"); $self->cget(-canvas)->set_mark(0); $nn->configure(-status=>"done"); return $nn; } sub hide { my ($self, $node) = @_; # $node->configure(-status=>"discard"); $node->configure(-status=>"hidden"); $node->moveto(0,-0.5); } sub remove { my ($self, $node) = @_; die "removal works only for binary trees" unless $self->cget(-ary) == 2; if (not UNIVERSAL::isa($node, "TreeNode")) { $node = $self->search($node); if (not ref $node) { carp "can't find node for removal\n"; return undef; } } $node->configure(-status=>"focus"); $self->cget(-canvas)->set_mark(0); my ($p, $r, $n) = ($node->parent(), $node->rank(), 0); ++$n if ref $node->child(0); ++$n if ref $node->child(1); if ($n == 2) { my ($subst) = $node->child(0)->findmax(); my ($subst_status) = $subst->cget(-status); $self->remove($subst); $p->set_child($r, $subst); $subst->set_child(0, $node->child(0)); $subst->set_child(1, $node->child(1)); $subst->configure(-status=>$subst_status); # $self->cget(-canvas)->set_mark(0); } elsif ($n == 1) { my ($i) = ref $node->child(0) ? 0 : 1; $p->adopt_subtree($r, $node->child($i)); } else { # $n == 0 $p->set_child($r, undef); } $self->hide($node); $self->cget(-canvas)->set_mark(0); return $node; } sub rotate_cw { my ($self, $pivot) = @_; die "removal works only for binary trees" unless $self->cget(-ary) == 2; if (not UNIVERSAL::isa($pivot, "TreeNode")) { $pivot = $self->search($pivot); if (not ref $pivot) { carp "can't find node for rotation\n"; return; } } $pivot->rotate_cw(); } sub rotate_ccw { my ($self, $pivot) = @_; die "removal works only for binary trees" unless $self->cget(-ary) == 2; if (not UNIVERSAL::isa($pivot, "TreeNode")) { $pivot = $self->search($pivot); if (not ref $pivot) { carp "can't find node for rotation\n"; return; } } $pivot->rotate_ccw(); } $::Config->{BST} = { -ary => 2, }; if ($0 =~ /BST.pm$/) { # being tested as a stand-alone program, so run test code. require "utilalgo"; my ($mw, $ctrl, $can); $mw = MainWindow->new(-title=>"main_test"); $can->{main} = gen_can($mw, undef, -elevation=>1, -maxlevel=>2); $ctrl = gen_ctrl($mw, $can); my ($tr) = BST->new(-canvas=>$can->{main}, %{ do "data/countries.gr" }); # $can->{main}->set_mark(1); $ctrl->configure(-recorder=>0); # If the canvas refuses to show any change, remember to verify that: # - set_mark() was called at least once # - -recorder is set to zero before entering MainLoop # Failing to do either of the above will result in a mysterious bug # that takes days to figure out !@#$% Tk::MainLoop(); } 1; algotutor-0.8.6.orig/basic.pl0000644000000000000000000000337210314773634013025 0ustar package main; use Vector2; use Carp; sub deep_copy { my ($x) = @_; my ($type) = ref $x; if (not $type) { return $x; } elsif ($type eq "ARRAY") { if (grep { /[^\d\.e+-]/i } @$x) { return [ map { deep_copy($_) } @$x ]; } else { return Vector2->new(@$x); } } elsif ($type eq "HASH") { return { map { $_=>deep_copy($x->{$_}) } keys %$x }; } elsif (grep { $type eq $_ } qw(CODE) ){ # shallow copy return $x; } elsif (grep { $type eq $_ } qw(SCALAR REF GLOB LVALUE) ){ carp "don't know how to deep copy a $type. shallow copying\n"; return $x; } else { # Objects (blessed references): do shallow copy # Also, Vector's are processed by this case, but it has a clone # operator "=" which in fact performs deep copying. return $x; } } sub po2 { my ($n) = @_; my ($r) = 1; while ($n > 0) { $r += $r; --$n; } while ($n < 0) { $r /= 2; ++$n; } return $r; } sub parent_class { my ($CLASS) = @_; my (@PAR) = eval "@" . $CLASS . "::ISA"; die "sorry, can't deal with multiple inheritance: \@${CLASS}::ISA=(@PAR)" if $#PAR > 0; return $PAR[0]; } sub print_hash { my ($h) = @_; my ($k); print "{"; foreach $k (keys %$h) { print " $k:$h->{$k}"; } print " }\n"; } ### these are used in Heap and BST sub rc2xy { my ($host, $VC, $r, $c) = @_; # $VC is the class name of vertices in $host my ($lv, $x, $size, $t); $lv = $host->cget(-dispheight); $x = ($c+0.5) * po2($lv-$r+1); $x = Vector2->new( $x+0.5, $r+0.5 ); # $x->[1] += ($c % 2) ? -0.2 : 0.2 if ($r >= $lv); $t = $host->cget(-node_opts); $size = ( ref $t and $t->{-size} ) ? $t->{-size} : Configurable::cget($VC, -size); return $x->pw_mul($size)->pw_mul($host->cget(-skip) + 1); } 1; algotutor-0.8.6.orig/DCEdge.pm0000644000000000000000000000203110223151023012764 0ustar # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package DCEdge; # Edge in a Doubly-Connected Edge List use strict; use Carp; use vars qw(@ISA); @ISA = qw(Edge); use Edge; # sub new { my ($self) = shift; $self->SUPER::new(@_); } sub phantomize { my ($self) = @_; $self->{"#is_phantom"} = 1; $self->configure(-status=>"hidden"); } sub is_phantom { return $_[0]->{"#is_phantom"}; } sub twin { my ($self, $nv) = @_; my ($r) = $self->{adj}{twin}; $self->{adj}{twin} = $nv if $#_ >= 1; return $r; } sub prev { my ($self, $nv) = @_; my ($r) = $self->{adj}{prev}; $self->{adj}{prev} = $nv if $#_ >= 1; return $r; } sub next { my ($self, $nv) = @_; my ($r) = $self->{adj}{next}; $self->{adj}{next} = $nv if $#_ >= 1; return $r; } sub configure { my ($self, %opts) = @_; $self->SUPER::configure(%opts); $self->twin()->SUPER::configure(%opts) if (not $self->cget(-directed) and ref $self->twin()); } $::Config->{DCEdge} = { }; 1; algotutor-0.8.6.orig/Vector.pm0000644000000000000000000000660510405421027013174 0ustar # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package Vector; # Mathematical Vector use strict; use Carp; use vars qw(@ISA); @ISA = qw(); my (%generated); BEGIN { my ($functemplate) = q{ sub { my ($self, $that) = @_; my ($r) = bless [], ref($self); my ($i); if (ref $that) { croak "dimension mismatch (", $#$self+1, " vs ", $#$that+1, ") in " unless $#$self == $#$that; for ($i=0; $i<=$#$self; ++$i) { $r->[$i] = $self->[$i] $that->[$i]; } } else { for ($i=0; $i<=$#$self; ++$i) { $r->[$i] = $self->[$i] $that; } } return $r; } }; my (%functab) = ( add => '+', sbt => '-', mul => '*', div => '/', ); my ($name, $op); while (($name, $op) = each %functab) { my ($t) = $functemplate; $t =~ s//$op/g; $generated{$name} = eval $t; } } # see perldoc overload, especially the "MAGIC AUTOGENERATION" section use overload '=' => '_clone', '""' => 'stringify', '+' => $generated{add}, '-' => $generated{sbt}, 'neg'=> 'negate', '*' => $generated{mul}, '/' => $generated{div}, 'fallback' => undef ; sub pw_mul { return $generated{mul}->(@_); } sub pw_div { return $generated{div}->(@_); } # Different from "Perl Cookbook", chap 13.6, p.461 "cloning objects" # See Randal Schwartz's "Constructing Objects" at # http://www.stonehenge.com/merlyn/UnixReview/col52.html # (search for "three camps") sub new { my ($proto, @data) = @_; my ($class) = ref $proto || $proto; # if (ref $data[0] eq "Vector") { if (ref $proto) { return bless [ @$proto ], $class; } else { return bless [@data], $class; } } # Copy constructor is very tricky. It is _not_ called until # just before a mutator is applied to one of the reference # variables sharing the same copy. See perldoc overload, # especially the "Copy Constructor" section. sub _clone { my ($a, $b, $switch) = @_; print STDERR "Vector::_clone : switch is undef!\n" unless defined $switch; # print STDERR $switch ? "+" : "-"; # always prints "-" return $switch ? bless([@$a],"Vector") : bless([@$b],"Vector"); } sub stringify { my ($self) = @_; my ($r) = sprintf "[ %8g", $self->[0]; foreach (@{$self}[1..$#$self]) { $r .= sprintf(", %8g", $_); } return $r . " ]"; } sub negate { my ($self) = @_; return bless [map { -$_ } @$self], ref $self; } sub x { return $_[0]->[0]; } sub y { return $_[0]->[1]; } sub z { return $_[0]->[2]; } sub dot { # dot product my ($t) = $_[0]->pw_mul($_[1]); my ($s, $i); for ($i=0; $i<=$#$t; ++$i) { $s += $t->[$i]; } return $s; } sub norm { my ($self) = @_; return sqrt($self->dot($self)); } sub angle_cos { my ($self, $b) = @_; return $self->dot($b)/$self->norm()/$b->norm(); } sub cob { # change of basis my ($self, $b) = @_; die unless ($#$b == $#$self and $#$b == $#{$b->[0]}); my ($r) = $self->new(); map { $_ = 0; } @$r; my ($i); for ($i=0; $i<=$#$self; ++$i) { $r += $b->[$i]->pw_mul($self->[$i]); } return $r; } if ($0 =~ /Vector.pm$/) { # being tested as a stand-alone program, so run test code. my ($p, $q, $r); $p = Vector->new(4,-3); $q = Vector->new(5,12); print $p+$q, ",", $p-$q, "\n"; $r = $p; $r += $q; $q = $q->pw_div(2); print $p, ",", $q, ",", $r, ",", $p->pw_mul(3), ",", -$p, "\n"; } 1; algotutor-0.8.6.orig/dependency.txt0000644000000000000000000000010210224236112014233 0ustar Configurable.pm: basic.pl PQueue.pm: Configurable.pm # incomplete algotutor-0.8.6.orig/Makefile0000644000000000000000000000254710606361661013047 0ustar SRCDIR = ~/active/algotutor DOCDIR = ~/public_html/p/algotutor DSTDIR = ~/algotutor PODSRC = algotutor gen_at_graph # DATADIR=/usr/share/algotutor/data # BINDIR=/usr/bin DATADIR = ./data BINDIR = . # .deb and .rpm packagers please note: Please run # make test DATADIR=/usr/share/algotutor/data BINDIR=/usr/bin # or something the like after installing your algotutor package # so as to make sure that most algorithms run correctly. dist: test rm red-black-tree.ps rm -rf $(DSTDIR) cp -LpR . $(DSTDIR) for f in $(PODSRC) ; do pod2html $$f > $(DOCDIR)/$$f.shtml ; done ; rm -f *.tmp *.x~~ cp -LpR $(DOCDIR) $(DSTDIR)/doc (cd $(DSTDIR); for f in $(PODSRC) ; do pod2man $$f > doc/$$f.1 ; done ; rm -f *.tmp *.x~~) test: $(BINDIR)/algotutor -a rbt -i 75 -d red-black-tree.ps $(DATADIR)/countries.gr $(BINDIR)/algotutor -a graham $(DATADIR)/pts1.gr $(BINDIR)/algotutor -a dom $(DATADIR)/pts1.gr $(BINDIR)/algotutor -a heap $(DATADIR)/countries.gr $(BINDIR)/algotutor -a bst $(DATADIR)/countries.gr $(BINDIR)/algotutor -a rbt $(DATADIR)/countries.gr $(BINDIR)/algotutor -a sbs $(DATADIR)/trc.gr $(BINDIR)/algotutor -a prim $(DATADIR)/randgrid.gr $(BINDIR)/algotutor -a dijk $(DATADIR)/tt.gr $(BINDIR)/algotutor -a flwa $(DATADIR)/lv.gr $(BINDIR)/algotutor -a lcs AGCTATACGATGACT GTCAGTATAGTCATATG $(BINDIR)/algotutor -a matc 32 A 35 B 24 C 30 D 36 E 25 F 40 G 34 H 35 algotutor-0.8.6.orig/Graph.pm0000644000000000000000000001723710315257363013010 0ustar # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package Graph; # Graph use strict; use Carp; use vars qw(@ISA); @ISA = qw(Collection); use Collection; use Vertex; use DCEdge; # { package main; require "graph/dfs"; } # use Data::Dumper; # We don't distinguish abstract graphs from geometric graphs. # Every graph is given the DCEL structure. This makes the logic # of coding easier (at the cost of slight increase in running time). # Every graph is directed, and every edge is paired. Artificial # edges are hidden. sub new { my ($class, %opts) = @_; $class = ref($class) if ref($class); my ($init_data) = delete $opts{-init_data}; my ($operation) = delete $opts{-operation}; my ($t) = delete $opts{-type}; croak "'Graph' code does not know how to process '$t' data\n" unless ($t eq 'graph' or $t eq 'points'); my ($self) = $class->SUPER::new(%opts); my (@v_names, $k, $s); if ($t eq 'points') { my ($n, $i, $name) = $#$init_data; $name = ($n < 26) ? sub { return chr(ord('A')+$_[0]); } : sub { 'V' . $_[0] } ; $k = 0; $init_data = { map { $name->($k++) => {-pos=>$_} } @$init_data }; } # When vertices and edges are refered to in a text file, names are # used. Inside a program, however, they seem to be more naturally # refered to as objects (blessed references). But don't go too far # and use objects as hash keys. You would get strings as return # values when using operator "keys" on such a hash. It does not help # reducing indirection (even if one manages to get eval work) and it # makes debugging less convenient. So we decide to make -name an # option instead of making it the key, and create a temporary table # mapping names to objects during Graph creation. # create vertices my ($n2V); # table of (vertex) names to vertex objects @v_names = sort keys %{ $init_data }; # $self->{"#Vertices"} = []; foreach $s (@v_names) { my (%v_opt) = map { /^-\w+$/ ? ($_=>$init_data->{$s}{$_}) : () } keys %{$init_data->{$s}}; $n2V->{$s} = $self->v_new($s, %v_opt); # push @{ $self->{"#Vertices"} }, $n2V->{$s}; } $self->{-vertices} = $n2V; # convenience, read-only configuration variable # create edges my ($n2E); # table of (vertex) names to edge objects my (@nbr); foreach $s (@v_names) { @nbr = sort grep { not /\W/ } keys %{$init_data->{$s}}; foreach $t (@nbr) { $n2E->{$s}{$t} = DCEdge->new($n2V->{$s}, $n2V->{$t}, -weight=>$init_data->{$s}{$t}, -text=>$init_data->{$s}{$t}, -directed=>$self->cget(-directed) ); } $self->{"#OneEdge"} = $n2V->{$s}->{"#OneEdge"} = $n2E->{$s}{$nbr[0]} if $#nbr>=0; } $self->dcelify($n2V, $n2E); # End of naming scheme conversion. From now on, vertices and # edges are refered to as objects (blessed references). Code # readers are reminded to think in object terms. return $self; } sub dcelify { # build Doubly Connected Edge List pointers my ($self, $n2V, $n2E) = @_; my ($s, $t); # pass one: verify symmetry and identify twins foreach $s (keys %$n2E) { foreach $t (keys %{ $n2E->{$s} }) { if (not exists $n2E->{$t}{$s}) { $n2E->{$t}{$s} = DCEdge->new($n2V->{$t}, $n2V->{$s}, -arrow=>"last"); if ($self->cget(-directed)) { $n2E->{$t}{$s}->phantomize(); } else { warn "one way edge detected"; $n2E->{$t}{$s}->configure(-status=>"alert", -directed=>1); } } $n2E->{$s}{$t}->twin($n2E->{$t}{$s}); $n2E->{$t}{$s}->twin($n2E->{$s}{$t}); my ($w) = $n2E->{$t}{$s}->cget(-weight); if (not $self->cget(-directed)) { if (not defined $w or $w != $n2E->{$s}{$t}->cget(-weight)) { warn "$s-$t is different from $t-$s in an undirected graph"; $n2E->{$t}{$s}->configure(-status=>"alert", -arrow=>"last", -directed=>1); } } } } # pass two: sort edges around each vertex foreach $s (keys %$n2V) { my ($neighbor); my ($src_pos) = $n2V->{$s}->pos(); foreach $t (keys %{ $n2E->{$s} }) { my ($tgt_pos) = $n2V->{$t}->pos(); my ($a) = $tgt_pos - $src_pos; push @$neighbor, {name=>$t, angle=>atan2($a->[1], $a->[0])}; } next unless $#$neighbor >= 0; $neighbor = [ map { $_->{name} } sort { $a->{angle} <=> $b->{angle} } @$neighbor ]; push @$neighbor, $neighbor->[0]; my ($i); for ($i=0; $i<$#$neighbor; ++$i) { my ($edge) = $n2E->{$s}{$neighbor->[$i]}; my ($prev) = $n2E->{$neighbor->[$i+1]}{$s}; $edge->prev($prev); $prev->next($edge); } } #my ($e, $k); #foreach $e ( @{ $self->{"#EdgeList"} } ) { # print "[$e]\n"; # foreach $k (keys %{ $e->{adj} }) { # print " $k: $e->{adj}{$k}\n"; # } #} } sub v_new { my ($self, $name, %opts) = @_; %opts = ( %{ $self->cget(-node_opts) }, %opts ); # as always, the host should take care of prepending %opts with -node_opts my ($pos) = Vector2->new(@{ delete $opts{-pos} }); my ($v) = Vertex->new($self, $pos, -name=>$name, %opts); # $v->configure(-text=>$v->cget(-display)->($v)) unless defined $opts{-text}; return $v; } # sub e_new { # my ($self, $src, $tgt, %opts) = @_; # my ($e1, $e2); # $e1 = DCEdge->new($src, $tgt, -host=>$self, -arrow=>"last", %opts); # return $e1 if $self->{-directed}; # $e2 = DCEdge->new($tgt, $src, -host=>$self, -arrow=>"last", %opts); # return wantarray ? ($e1, $e2) : $e1; # } sub one_edge { my ($self, $v) = @_; return $#_ >= 1 ? $v->{"#OneEdge"} : $self->{"#OneEdge"}; } sub edges_around { my ($self, $v) = @_; my ($e, @s, $start); $e = $self->one_edge($v); return () unless $e; croak "broken 'OneEdge' on vertex $v" unless $e->source() eq $v; $start = $e; do { push @s, $e unless $e->is_phantom(); $e = $e->prev()->twin(); } while ($e ne $start); return @s; } sub destroy { my ($self) = @_; ::pfs($self, $self->cget(-canvas), -priority=>"sbs", -on_vertex=>sub { $_[0]->destroy(); }, -on_edge=>sub { $_[0]->destroy(); }, ); undef $self; } if ($0 =~ /Graph.pm$/) { # being tested as a stand-alone program, so run test code. require "utilalgo"; my ($mw, $ctrl, $can); $mw = MainWindow->new(-title=>"main_test"); # $can->{main} = gen_can($mw, undef, -elevation=>1, -maxlevel=>3); $can->{main} = gen_can($mw, undef, -elevation=>2, -maxlevel=>3); $can->{pq} = gen_can($mw, "Fringe (Frontier)", -elevation=>1, -maxlevel=>3); $ctrl = gen_ctrl($mw, $can); my ($g) = Graph->new(-canvas=>$can->{main}, %{ do "data/trc.gr" }); sub disp_vert_val { my ($v, $val) = @_; $v->configure(-text=>"$v\n$val"); } $::Config->{Graph} = { }; #::dfs($g); # Theoretically, Dijkstra's single-source-shortest path algorithm should # not be applied to graphs like trc.gr which has edges with negative weights. # But we are lucky with this particular example :-) { package main; require "graph/pfs"; } ::pfs($g, $can->{pq}, -start=>"lin", -priority=>"dijk", -on_vertex=>\&disp_vert_val); #{ package main; require "graph/flwa"; } #::flwa($g); $ctrl->configure(-recorder=>0); my ($v); $v = $g->one_edge->source(); print "$v: ", join(",", map {$_->target()} $g->edges_around($v)), "\n"; #my ($rc, $s); #$rc = $can->{pq}{SubWidget}{scrolled}; #foreach $s (@{ $rc->{"#history"} }) { # foreach my $l (@{ $s->{mark} }) { # printf "%4d", $l; # } # print " | "; # foreach my $l ($rc->relative_mark($s->{mark})) { # printf "%4d", $l; # } # print "\n"; #} # $can->{main}->set_mark(1); $ctrl->configure(-recorder=>0); # If the canvas refuses to show any change, remember to verify that: # - set_mark() was called at least once # - -recorder is set to zero before entering MainLoop # Failing to do either of the above will result in a mysterious bug # that takes days to figure out !@#$% Tk::MainLoop(); } 1; algotutor-0.8.6.orig/Board.pm0000644000000000000000000000444110314773330012763 0ustar # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package Board; # Rectangular board of grids use strict; use Carp; use vars qw(@ISA); @ISA = qw(Collection); use Collection; use Vertex; sub new { my ($class, %opts) = @_; $class = ref($class) if ref($class); my ($self) = $class->SUPER::new(%opts); my ($i, $j); %opts = %{ $self->cget(-node_opts) }; # as always, the host should take care of prepending %opts with -node_opts for ($i=0; $i<$self->cget(-height); ++$i) { for ($j=0; $j<$self->cget(-width); ++$j) { $self->{"#grid"}[$i][$j] = Vertex->new($self, $self->rc2xy($i, $j), %opts); } } return $self; } sub rc2xy { my ($self, $r, $c) = @_; my ($t, $size); $t = $self->cget(-node_opts); $size = ( ref $t and $t->{-size} ) ? $t->{-size} : Configurable::cget("Vertex", -size); return Vector2->new($c+0.6, $r+0.6)->pw_mul($size)->pw_mul($self->cget(-skip) + 1); } sub cell { my ($self, $i, $j) = @_; return $self->{"#grid"}[$i][$j]; } #sub v_configure { # my ($self, $k, %opts) = @_; ##print " \n"; # $self->{"#vertex_reservoir"}[$k]->configure(%opts); # return if ($k <= 1); # delete @opts{ qw(-shape -size -text -display -content) }; # $self->{"#edge_reservoir"}[$k]->configure(%opts); #} # ## content of $k-th vertex #sub vc { # my ($self, $k) = @_; # return $self->{"#vertex_reservoir"}[$k]->cget(-content); #} $::Config->{Board} = { -skip => Vector2->new(0, 0), -node_opts => { -shape => "rectangle", } }; if ($0 =~ /Board.pm$/) { # being tested as a stand-alone program, so run test code. require "utilalgo"; my ($mw, $ctrl, $can); $mw = MainWindow->new(-title=>"main_test"); $can->{main} = gen_can($mw, undef, -elevation=>1, -maxlevel=>3); $ctrl = gen_ctrl($mw, $can); { package main; require "dp/lcs"; } ::lcs("AGCTATACGATGACT", "GTCAGTATAGTCATATG", $can->{main}); # $can->{main}->set_mark(1); $ctrl->configure(-recorder=>0); # If the canvas refuses to show any change, remember to verify that: # - set_mark() was called at least once # - -recorder is set to zero before entering MainLoop # Failing to do either of the above will result in a mysterious bug # that takes days to figure out !@#$% Tk::MainLoop(); } 1; algotutor-0.8.6.orig/algotutor0000755000000000000000000001575110606361610013350 0ustar #!/usr/bin/perl -w # Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html use strict; use Getopt::Std; use lib '/usr/share/perl5/algotutor'; BEGIN { my ($path) = $0 =~ m#(.*/)#; $path = "." unless defined $path; push @INC, $path; } my ( %opts, # command line options $wd, # tk widgets $dfn, # data file name $mds, # main data structure ); %opts = ( a => undef, # which algorithm to run? s => undef, # start vertex (for some graph algos) i => 0, # step # of initial image d => undef, # dump ps file and exit immediately ); require "utilalgo"; require "basic.pl"; $wd->{main} = MainWindow->new(-title=>"algotutor"); getopts('a:s:i:d:', \%opts); if (grep { $opts{a} eq $_ } qw(lcs matc flwa)) { # dynamic programming my ($algo) = $opts{a}; my ($tab) = { lcs => { maxlvl => 3, run => sub { require "dp/lcs"; lcs(@ARGV[0,1], $wd->{can}{main}); }, }, matc => { maxlvl => 3, run => sub { require "dp/matrixchain"; matrixchain(\@ARGV, $wd->{can}{main}); }, }, flwa => { maxlvl => 3, run => sub { require "dp/flwa"; flwa($ARGV[0], $wd->{can}{main}); }, } }; require Board; $wd->{can}{main} = gen_can($wd->{main}, undef, -elevation=>1, -maxlevel=>$tab->{$algo}{maxlvl} ); $wd->{ctrl} = gen_ctrl($wd->{main}, $wd->{can}); $tab->{$algo}{run}(); } else { # algorithms other than dynamic programming die "need exactly one data file. Example:\n\talgotutor -a bst /usr/share/algotutor/data/countries.gr\n" unless $#ARGV == 0; $dfn = $ARGV[0]; die "cannot read data file '$dfn'.\nDoes it exist and do you have read permissions?\n" unless -r $dfn; die "please specify an algorithm to run using -a. Example:\n\t-a bst\n\t-a heap\n\t-a sbs\n\t-a bfs\n\t-a prim\n\t-a dijk\n\t-a flwa\n" unless defined $opts{a}; $mds = eval { do $dfn }; die "'$dfn' does not look like a valid algotutor data file\n" unless ($mds and ref $mds eq "HASH"); if (grep { $opts{a} eq $_ } qw(bst rbt heap graham dom)) { usual_algo($opts{a}); } elsif (grep { $opts{a} eq $_ } qw(bfs sbs dijk prim)) { $mds = prio_first($wd, $mds, $opts{a}); } else { die "unknown algorithm '$opts{a}'\n"; } } $wd->{ctrl}->configure(-recorder=>0); my ($steps) = $wd->{ctrl}->{"#lowest_canvas"}->total_marks( $wd->{ctrl}->{"#slevel"} ); printf "total marks: %d\n", $steps; if (defined $opts{i}) { if ($opts{i} < 0 or $opts{i} >= $steps) { print STDERR "illegal request to display step $opts{i} (out of range)\n"; } else { print "seeking to step $opts{i}...\n"; $wd->{ctrl}->timeknob_seek($opts{i}); } } if ($opts{d}) { dump_image($wd->{can}, $opts{d}); } else { Tk::MainLoop(); } exit(); # end of main program sub disp_vert_val { my ($v, $val) = @_; $v->configure(-text=>"$v\n$val"); } sub prio_first { my ($wd, $mds, $prio) = @_; require Graph; $wd->{can}{main} = gen_can($wd->{main}, undef, -elevation=>2, -maxlevel=>3); $wd->{can}{fr} = gen_can($wd->{main}, "Fringe", -elevation=>1, -maxlevel=>3); $wd->{ctrl} = gen_ctrl($wd->{main}, $wd->{can}); $mds = Graph->new(-canvas=>$wd->{can}{main}, %$mds); require "graph/pfs"; pfs($mds, $wd->{can}{fr}, -start=>$opts{s}, -priority=>$prio, -on_vertex=>\&disp_vert_val); return $mds; } sub usual_algo { my ($algo) = @_; my ($tab) = { bst => { ds => "BST", maxlvl => 2 }, rbt => { ds => "RBTree", maxlvl => 2 }, heap => { ds => "Heap", maxlvl => 3 }, graham=> { ds => "Graph", maxlvl => 2, post=> sub { require "cgeom/graham"; graham($mds); } }, dom => { ds => "Graph", maxlvl => 2, post=> sub { require "cgeom/dom"; dom($mds); } }, # dfs => { ds => "Graph", maxlvl => 2, post=> sub { # require "graph/dfs"; # dfs($mds, -start=>$opts{s}, -on_vertex=>\&disp_vert_val); # } }, flwa => { ds => "Graph", maxlvl => 2, post=> sub { require "graph/flwa"; flwa($mds); } }, }; require $tab->{$algo}{ds} . ".pm"; $wd->{can}{main} = gen_can($wd->{main}, undef, -elevation=>1, -maxlevel=>$tab->{$algo}{maxlvl} ); $wd->{ctrl} = gen_ctrl($wd->{main}, $wd->{can}); $mds = eval($tab->{$algo}{ds} . '->new(-canvas=>$wd->{can}{main}, %$mds)'); $tab->{$algo}{post}->() if ref $tab->{$algo}{post}; } __END__ =head1 NAME algotutor - an interactive program for observing the intermediate steps of algorithms. =head1 SYNOPSIS B [I