#!/usr/bin/perl use strict; use warnings; use Storable; my ($src, $tgt) = @ARGV; die "Usage: $0 " if ! defined $src || ! defined $tgt; die "The and must be same length" if length($src) != length($tgt); my $db = retrieve('dictionary.db'); my $path = find_path($src, $tgt, $db->{length($tgt)}); print "$path\n"; sub find_path { my ($src, $tgt, $list, $search) = @_; for my $pos (qw/src tgt/) { my $dir = $pos eq 'src' ? $src : $tgt; my $opp = $pos eq 'src' ? 'tgt' : 'src'; if (! defined $search->{$pos}{work}) { for (@{$list->{$dir}}) { push @{$search->{$pos}{work}}, {key => $_, path => "$dir-$_"}; $search->{$pos}{term}{$_} = $search->{$pos}{work}[-1]; } $search->{$pos}{term}{$dir} = {key => $dir, path => $dir}; } my ($work, $next) = ($search->{$pos}{work}, []); while (@$work) { my $node = shift @$work; my ($word, $path) = @{$node}{qw/key path/}; next if $search->{$pos}{seen}{$word}++; if ($search->{$opp}{term}{$word}) { my @cur_path = split /-/, $path; my @con_path = split /-/, $search->{$opp}{term}{$word}{path}; return $pos eq 'tgt' ? join '-', @con_path, @cur_path[reverse 0 .. $#cur_path - 1] : join '-', @cur_path, @con_path[reverse 0 .. $#con_path - 1]; } for (@{$list->{$word}}) { push @$next, {key => $_, path => "$path-$_"}; $search->{$pos}{term}{$_} = $next->[-1]; } } $search->{$pos}{work} = $next; } return 'path not found' if ! @{$search->{src}{work}} || ! @{$search->{tgt}{work}}; return find_path($src, $tgt, $list, $search); }