#!/usr/local/ActivePerl-5.6/bin/perl -w
#
# doublet.pl - B. Blackmoor (bblackmoor@blackgate.net) - 2009-03-08
#
# Doublet solver for Perl
# Finds a path of valid words between two other words

use strict;
use warnings;
use Time::HiRes qw(gettimeofday tv_interval);
use Getopt::Long;

my $about = qq(Doublet solver for Perl

Finds a path of valid words between two other words

Usage: doublet.pl [-h] [-v] [-d DICTIONARY] START END 

Options:
  -d ..., --dictionary=...  use specified dictionary file or URL
  -h, --help                show this help
  -v, --verbose             show debugging information while parsing

Examples:
  doublet.pl flower flour
  doublet.pl love hate
  doublet.pl -v dogs wolves
  doublet.pl -d scrabble_dictionary.txt begin end
  doublet.pl -v -d scrabble_dictionary.txt man woman
  doublet.pl -v -d scrabble_dictionary.txt mouse elephant
);
my $end_stopwatch = 0;
my $start_stopwatch = 0;
my $found = 0; # FALSE
my @dictionary = ();
my $verbose = 0; # FALSE
my $head_word;
my $tail_word;
my @search_paths = ();
my @dead_paths = ();
my @already_used = ();


sub usage 
{
    print ($about);
}

sub find_path
{
	my $path_found = 0; # FALSE
	my $path_not_found = 0; # FALSE
	my $path_id;

	for(my $parent_path_id = 0; $parent_path_id < scalar(@search_paths); $parent_path_id++)
	{
		if (!grep $_ eq $parent_path_id, @dead_paths)
		{
			my @search_path = split(' ', $search_paths[$parent_path_id]);
			my $parent = $search_path[$#search_path];

			my $word_length = length($parent);
			my @children = ();
			my @regex_variations = ();

			push(@dead_paths, $parent_path_id);

			for (my $j = 0; $j < $word_length; $j++)
			{
				my $regex = '\b' . substr($parent, 0, $j) . '[^' . substr($parent, $j, 1) . ']?' . substr($parent, $j + 1) .  '\b';
				push(@regex_variations, $regex);
			}

			for (my $j = 0; $j < $word_length+1; $j++)
			{
				my $regex = '\b' . substr($parent, 0, $j) . '[\w]' . substr($parent, $j) . '\b';
				push(@regex_variations, $regex);
			}

			my $joined_regex_variations = join("|", @regex_variations);

			@children = grep(/$joined_regex_variations/, @dictionary);

			if (@children)
			{
				foreach (@children)
				{
					my $child = $_;

					if (!$path_found)
					{
						chomp($child);
						if (!grep $_ eq $child, @already_used)
						{

							$path_id = scalar(@search_paths);
							push(@search_paths, $search_paths[$parent_path_id]);
							$search_paths[$path_id] = $search_paths[$path_id] . " " . $child;

							push(@already_used, $child);

							if ($verbose)
							{
								print('[' . $path_id . '] ' . $search_paths[$path_id] . "\n");
							}

							if ($child eq $tail_word)
							{
								$path_found = 1;
							}
						}
					}
				}
			}
		}

		if ($path_found)
		{
			return $path_id;
		}
	}

	if ($path_found)
	{
		return $path_id;
	}
	else
	{
		$path_not_found++;

		if ($path_not_found)
		{
			return;
		}
		else
		{
			return &find_path();
		}
	}
}

sub failure
{
	if (!$found)
    {
		$found = 1;

		my $search_path_length = scalar(@search_paths);

		my $end_stopwatch = [gettimeofday];
		my $elapsed_time = tv_interval($start_stopwatch, $end_stopwatch);

		print ("Fail: could not find a path between words\n");
		print ($search_path_length . " potential paths were examined, taking " . sprintf("%9.4f", $elapsed_time) . " seconds" . "\n");
	}
}

sub success
{
	my @search_results = @_;

   	if (!$found)
	{
		$found = 1;

		my $search_path_length = scalar(@search_paths);

		my $end_stopwatch = [gettimeofday];
		my $elapsed_time = tv_interval($start_stopwatch, $end_stopwatch);

		print ($search_path_length . " potential paths were examined, taking " . sprintf("%9.4f", $elapsed_time) . " seconds" . "\n");

		my $pretty_results = join(" >> ", @search_results);
		print ($pretty_results . "\n");

	}
}

sub main
{
	$start_stopwatch = [gettimeofday];

	my $dictionary_file;
	my @default_dictionary  = ("hate", "have", "hove", "love");
	@default_dictionary = (@default_dictionary, "dogs", "does", "doles", "soles", "solves", "wolves");
	@default_dictionary = (@default_dictionary, "man", "ran", "roan", "roman", "woman");
	@default_dictionary = (@default_dictionary, "flour", "lour", "dour", "doer", "dower", "lower", "flower", "glower", "plower");
	my $help;
	my $external_dictionary;
	my $flipped_order = 0; # FALSE

	GetOptions("help|?" => \$help,
			"verbose" => \$verbose,
			"dictionary=s" => \$external_dictionary);

	if ($help)
	{
		&usage();
		exit();
	}

	if ($external_dictionary)
	{
		$dictionary_file = $external_dictionary;
	}


	if ($ARGV[0])
	{
		$head_word = $ARGV[0];
		$head_word =~ s/[?;:!,.'"]//g;
	}

	if ($ARGV[1])
	{
		$tail_word = $ARGV[1];
		$tail_word =~ s/[?;:!,.'"]//g;
	}

	if (!$ARGV[1])
	{
		print ('Error: missing parameter' . "\n");
		&usage();
		exit();
	}

	if ((length($head_word) < 2) || (length($tail_word) < 2))
	{
		print ('Error: input error' . "\n");
		print ('Both words must be at least 2 characters long.' . "\n");
		&usage();
		exit();
	}
	
	if ($head_word eq $tail_word)
	{
		print ('Done: words already match' . "\n");
		exit();
	}

	if (length($head_word) < length($tail_word))
	{
		$flipped_order = 1; # TRUE
		my $temp_word = $tail_word;
		$tail_word = $head_word;
		$head_word = $temp_word;
	}
	
	my $head_word_length = length($head_word);
	my $tail_word_length = length($tail_word);

	if ($dictionary_file)
	{
		open DICTIONARY_FILE, $dictionary_file or die "Error: input error\nCould not open dictionary file";

		while (<DICTIONARY_FILE>)
		{
			my $line = lc($_); # $_ is the default loop variable
			$line =~ s/[?;:!,.'"]//g;
			chomp($line);

			my $line_length = length($line);

			if ($line_length == 0)
			{
				next;
			}
			elsif ((($head_word_length + 1) >= $line_length) && ($line_length >= ($tail_word_length - 1)))
			{
				push(@dictionary, $line);
			}
		}
	}
	else
	{
		@dictionary = @default_dictionary;
	}

	if (!grep $_ eq $head_word, @dictionary)
	{
		print ("Fail: " . $head_word . " is not in the provided dictionary" . "\n");
		exit();
	}

	if (!grep $_ eq $tail_word, @dictionary)
	{
		print ("Fail: " . $tail_word . " is not in the provided dictionary" . "\n");
		exit();
	}

	push(@search_paths, $head_word);
	push(@already_used, $head_word);
	my @search_results = ();
	my $found_path_id = &find_path;

	# Note that Perl treats 0 as FALSE, but the first item in the array will never be the solution
	if ($found_path_id)
	{
		@search_results = split(' ', $search_paths[$found_path_id]);

		if (@search_results)
		{
			if ($flipped_order)
			{
				@search_results = reverse(@search_results);
			}

			&success(@search_results);
		}
		else
		{
			&failure();
		}
	}
	else
	{
		&failure();
	}

	exit();
}

&main();