sub findroot {
    my @words = @_;
    my %stems;
    foreach ( @words ) {
        my @letters = split //;
        do {
            $stems{join ('', @letters)}++
        } while my $stem = pop(@letters);
    }
    # dump all the possible stems that don't match every word
    map { delete $stems{$_} if $stems{$_} < scalar(@words) } keys %stems;
    
    #return the stem - i.e. the longest common element
    return [ sort { length $b <=> length $a } keys %stems ]->[0];
}