package A2B::Tools;

use A2B::Table;
use Heap::Fibonacci;
use A2B::Path;
use A2B::PartialPath;
use A2B::Tool;

use strict;
use vars qw(@ISA $ELEMENT_TYPE $DEBUG);

@ISA = qw(A2B::Table);

$ELEMENT_TYPE = "A2B::Tool";

$DEBUG = 0;

#my $c = 0; # this is an `efficiency measure'

sub add_row {
	my $self = shift;
	my $row = shift;
	$self->SUPER::add_row($row);
	my ($from, $to) = ($row->from, $row->to); # this should happen before `bind foreign keys' - but doesn't matter?

	# all this hashing is going to hurt a bit! TODO should probably use
	# some sensible bitmapped method? or at least sets of numbers instead
	# of mime types!

	# update transitive closure of from -> to
	# This is better than the stupid V^3 Floyd-Warshall algorithm!
	# (well, for sparse graphs, e.g. with disjoint sub-graphs, it is)

	# this `transitive closure' does not include A->A mappings at the moment.

	if (!$self->{from_to_closure}{$from}{$to}) {
		for my $f ($from, keys %{$self->{to_from_closure}{$from}}) {
			for my $t ($to, keys %{$self->{from_to_closure}{$to}}) {
	#			$c++;
				$self->{from_to_closure}{$f}{$t} = 1;
				$self->{to_from_closure}{$t}{$f} = 1;
			}
		}
	}

	# keep hashes/sets of direct maps also.  not used yet?

	$self->{from_to_direct}{$from}{$to} = 1;
	$self->{to_from_direct}{$to}{$from} = 1;
}

# efficiency measure getter

#sub c {
#	print $c;
#}

# get all the paths from A to B
# this includes a different paths for each tool that can do the job, and an
# overall `goodness' factor for each path.  The paths are returned sorted by
# the `goodness' factor.  You can specify a limit to the number of paths to be
# returned, which should make things a bit faster.

# it would be nice to abstract this algorithm... not now (or in Perl)

# note: $to is now an array ref

sub grep_paths {
	my ($self, $paths, $grep, $nogrep) = @_;
	$grep ||= [];
	$nogrep ||= [];
	my @out;
	for my $p (@$paths) {
		my $s = $p->as_string(2);
		my $ok = 1;
		for my $g (@$grep) {
			if ($s !~ $g) {
				$ok = 0;
				last;
			}
		}
		if ($ok) {
			for my $g (@$nogrep) {
				if ($s =~ $g) {
					$ok = 0;
					last;
				}
			}
		}
		if ($ok) {
			push @out, $p;
		}
	}
	$paths = \@out;
	return $paths;
}

sub paths {
	my ($self, $from, $to, $number, $grep, $nogrep) = @_;

	my %to_set = map {$_->type, 1} @$to;

	my $from_to_closure = $self->{from_to_closure};

	# < "can we get from here to there?" worker outer and cacher!
	my %cgfhtt_cache;
	my $can_get_from_here_to_there = sub {
		my $from = $_[0]->type;
		$cgfhtt_cache{$from} ||= do {
			my $ans = 0;
			for my $t (@$to) {
				if ($from_to_closure->{$from}{$t->type}) {
					$ans = 1;
					last;
				}
			}
			$ans;
		}
	};
	# >

	unless (&$can_get_from_here_to_there($from)) {
		return [];
	}

	# TODO make the path computer a separate object?  only if going to generalise it

	my $to_types = join "\0", map {$_->type} @$to;

	my $path_computer = $self->{path_computers_from_to}{$from->type}{$to_types} ||= do {
		# this is a priority queue for incomplete paths
		my $pq = Heap::Fibonacci->new;
		$pq->add(A2B::PartialPath->new($from));
		{ paths => [],
		  priority_queue => $pq	# remaining incomplete paths
		};
	};

	# methinks this should be written in Lisp!

	my $pq = $path_computer->{priority_queue};

	my $paths = $path_computer->{paths};
	my $grepped_paths;

	while (1) {
		# get the next partial path off the priority queue¸
		# and deal with it
		my $ppath = $pq->extract_minimum;
		if (!defined $ppath || defined $number) {
			$grepped_paths = $self->grep_paths($paths, $grep, $nogrep);
		}
		if (!defined $ppath || defined $number && @$grepped_paths >= $number) {
			last;
		}
#		print "popped ", $ppath->goodness, "\n" if $DEBUG;

		# is this path at the goal already?

		if ($to_set{$ppath->node->type}) {
#			print "done\n" if $DEBUG;
			# we made it!
			push @$paths, $ppath->path;
		} else {
#			print "not done\n" if $DEBUG;
			# not there yet...
			# get all steps from this node

			my $steps = $self->query(from => $ppath->node);

			# exclude steps that go back to a previous node, and steps that
			# won't lead to the goal (thanks, mr. closure!)

			for my $step (@$steps) {
				my $step_to = $step->to;
				if (! $ppath->contains_node($step_to) and
					$to_set{$step_to->[0]} || &$can_get_from_here_to_there($step_to)) {
						# the closure excludes A->A (null paths), hence the first clause

					# the step is okay - make a new path for it
					my $new_ppath = $ppath->new_step($step);

#					warn "adding ", $step->tool, " ", $new_ppath->goodness, "\n" if $DEBUG;
					$pq->add($new_ppath);
				}
			}
		}
	}

	$paths = $grepped_paths;

	if (!defined $number || @$paths < $number) {
		return $paths;
	}

	return [ @{$paths}[0..$number-1] ];
}

1