From dc4def61ef2eb1ebf2c6df0698ad8691a4ad384d Mon Sep 17 00:00:00 2001 From: Steven Wilson Date: Wed, 24 Jul 2019 17:27:29 +0100 Subject: add task 1 solution --- challenge-018/steven-wilson/perl5/ch-1.pl | 65 +++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) create mode 100644 challenge-018/steven-wilson/perl5/ch-1.pl diff --git a/challenge-018/steven-wilson/perl5/ch-1.pl b/challenge-018/steven-wilson/perl5/ch-1.pl new file mode 100644 index 0000000000..f8d86eadd2 --- /dev/null +++ b/challenge-018/steven-wilson/perl5/ch-1.pl @@ -0,0 +1,65 @@ +#!/usr/bin/env perl +# Author: Steven Wilson +# Date: 2019-07-22 +# Week: 018 +# +# Task #1 +# Write a script that takes 2 or more strings as command line parameters +# and print the longest common substring. For example, the longest +# common substring of the strings “ABABC”, “BABCA” and “ABCBA” is string +# “ABC” of length 3. Other common substrings are “A”, “AB”, “B”, “BA”, +# “BC” and “C”. Please check this wiki page for details. + +use strict; +use warnings; +use feature qw/ say /; + +# my @input_strings = @ARGV; +# print_longest_common_string(@input_strings); + +my @input_strings = qw/ ABABC BABCA ABCBA /; +print_longest_common_string(@input_strings); + +sub print_longest_common_string { + my @strings = @_; + + # longest strings first + my @sorted_strings = sort { length $b <=> length $a } @strings; + + my %longest_common_substrings + = map { $_ => 1 } all_substrings( shift @sorted_strings ); + + while (@sorted_strings) { + %longest_common_substrings = map { $_ => 1 } + grep { exists $longest_common_substrings{$_} } + all_substrings( shift @sorted_strings ); + } + + my @sorted_common_strings + = sort { length $b <=> length $a } keys %longest_common_substrings; + + if (@sorted_common_strings) { + my $longest_common_substring_length + = length $sorted_common_strings[0]; + say "Longest common substring(s): " . join " ", + grep { length $_ == $longest_common_substring_length } + @sorted_common_strings; + } + else { + say "No common substrings exist"; + } + return; +} + +sub all_substrings { + my $string = shift; + my $string_length = length $string; + my %substrings; + for ( my $i = 0; $i <= $string_length - 1; $i++ ) { + for ( my $j = ($string_length) - ($i); $j > 0; $j-- ) { + $substrings{ substr $string, $i, $j } = 1; + } + } + my @sorted_substrings = sort { length $b <=> length $a } keys %substrings; + return @sorted_substrings; +} -- cgit