Source code in the perl programming language

use strict;
use warnings;

my %dict;

open my $handle, '<', 'unixdict.txt';
while (my $word = <$handle>) {
    chomp($word);
    my $len = length $word;
    if (exists $dict{$len}) {
        push @{ $dict{ $len } }, $word;
    } else {
        my @words = ( $word );
        $dict{$len} = \@words;
    }
}
close $handle;

sub distance {
    my $w1 = shift;
    my $w2 = shift;

    my $dist = 0;
    for my $i (0 .. length($w1) - 1) {
        my $c1 = substr($w1, $i, 1);
        my $c2 = substr($w2, $i, 1);
        if (not ($c1 eq $c2)) {
            $dist++;
        }
    }
    return $dist;
}

sub contains {
    my $aref = shift;
    my $needle = shift;

    for my $v (@$aref) {
        if ($v eq $needle) {
            return 1;
        }
    }

    return 0;
}

sub word_ladder {
    my $fw = shift;
    my $tw = shift;

    if (exists $dict{length $fw}) {
        my @poss = @{ $dict{length $fw} };
        my @queue = ([$fw]);
        while (scalar @queue > 0) {
            my $curr_ref = shift @queue;
            my $last = $curr_ref->[-1];

            my @next;
            for my $word (@poss) {
                if (distance($last, $word) == 1) {
                    push @next, $word;
                }
            }

            if (contains(\@next, $tw)) {
                push @$curr_ref, $tw;
                print join (' -> ', @$curr_ref), "\n";
                return;
            }

            for my $word (@next) {
                for my $i (0 .. scalar @poss - 1) {
                    if ($word eq $poss[$i]) {
                        splice @poss, $i, 1;
                        last;
                    }
                }
            }

            for my $word (@next) {
                my @temp = @$curr_ref;
                push @temp, $word;

                push @queue, \@temp;
            }
        }
    }

    print STDERR "Cannot change $fw into $tw\n";
}

word_ladder('boy', 'man');
word_ladder('girl', 'lady');
word_ladder('john', 'jane');
word_ladder('child', 'adult');
word_ladder('cat', 'dog');
word_ladder('lead', 'gold');
word_ladder('white', 'black');
word_ladder('bubble', 'tickle');


use strict;
use warnings;
use feature 'say';

my %dict;
open my $handle, '<', 'ref/unixdict.txt';
while (my $word = <$handle>) {
    chomp $word;
    my $l = length $word;
    if ($dict{$l}) { push @{ $dict{$l} },    $word   }
    else           {         $dict{$l} = \@{[$word]} }
}
close $handle;

sub distance {
    my($w1,$w2) = @_;
    my $d;
    substr($w1, $_, 1) eq substr($w2, $_, 1) or $d++ for 0 .. length($w1) - 1;
    return $d // 0;
}

sub contains {
    my($aref,$needle) = @_;
    $needle eq $_ and return 1 for @$aref;
    return 0;
}

sub word_ladder {
    my($fw,$tw) = @_;
    say 'Nothing like that in dictionary.' and return unless $dict{length $fw};

    my @poss  = @{ $dict{length $fw} };
    my @queue = [$fw];
    while (@queue) {
        my $curr_ref = shift @queue;
        my $last     = $curr_ref->[-1];

        my @next;
        distance($last, $_) == 1 and push @next, $_ for @poss;
        push(@$curr_ref, $tw) and say join ' -> ', @$curr_ref and return if contains \@next, $tw;

        for my $word (@next) {
            $word eq $poss[$_] and splice(@poss, $_, 1) and last for 0 .. @poss - 1;
        }
        push @queue, \@{[@{$curr_ref}, $_]} for @next;
    }

    say "Cannot change $fw into $tw";
}

word_ladder(split) for 'boy man', 'girl lady', 'john jane', 'child adult';