Perl Weekly Challenge: Week 92
Challenge 1:
Isomorphic Strings
You are given two strings $A and $B.
Write a script to check if the given strings are Isomorphic. Print 1 if they are otherwise 0.
Example 1
Input: $A = "abc"; $B = "xyz"
Output: 1
Example 2
Input: $A = "abb"; $B = "xyy"
Output: 1
Example 3
Input: $A = "sum"; $B = "add"
Output: 0
Isomorphic means there is a one to one correspondence between letters in the two strings. I.e. If there is an 'a' as the first letter in string A and a 'b' as the first letter in string B. every position which has an 'a' in string A will have a 'b' in the same position in string B. The link given in the spec contains an algorithm and sample code in C++ so it was just a matter of translating it to Perl.
sub isIsomorphic {
my ($A, $B) = @_;
if (length $A != length $B) {
return undef;
}
my @A = split //, $A;
my @B = split //, $B;
my %seen;
my %isomorphs;
for my $i (0 .. scalar @A - 1) {
my $a = $A[$i];
my $b = $B[$i];
if (exists $isomorphs{$a}) {
unless ($b eq $isomorphs{$a}) {
return undef;
}
} else {
if (!grep /$b/, keys %seen) {
$isomorphs{$a} = $b;
$seen{$b} = 1;
} else {
return undef;
}
}
}
return 1;
}
Perl doesn't have a set type like C++ so I used a hash instead. And instead of returning true or false I returned undef or 1.
Raku has both Sets and Booleans so the Raku version was even more faithful to the original C++.
sub isIsomorphic(Str $A, Str $B) {
my SetHash of Str $seen;
my %isomorphs;
if ($A.chars != $B.chars) {
return False;
}
for $A.comb Z $B.comb -> ($a, $b) {
if %isomorphs{$a}:exists {
unless $b eq %isomorphs{$a} {
return False;
}
} else {
if $b ∉ $seen {
%isomorphs{$a} = $b;
$seen{$b}++;
} else {
return False;
}
}
}
return True;
}
Challenge 2:
Insert Interval
You are given a set of sorted non-overlapping intervals and a new interval.
Write a script to merge the new interval to the given set of intervals.
Example 1
Input $S = (1,4), (8,10); $N = (2,6)
Output: (1,6), (8,10)
Example 2
Input $S = (1,2), (3,7), (8,10); $N = (5,8)
Output: (1,2), (3,10)
Example 3
Input $S = (1,5), (7,9); $N = (10,11)
Output: (1,5), (7,9), (10,11)
When I read the description for this problem, I got the feeling that we had done something like this before. And sure enough, some rummaging through the past challenges revealed that there had been a merging intervals problem in PWC 50. I checked Colin Crains' review of solutions for this week (But only after I'd written my own!) and it seems only E. Choroba had the same realization.
Knowing this made my task a lot easier but I didn't just cut and paste my previous code as there are slight differences in objective and some opportunities to improve.
sub toArray {
my ($arg) = @_;
$arg =~ /\( (\d+) , (\d+) \) /gmx;
return [$1, $2];
}
my @intervals = sort { $a->[0] <=> $b->[0] } map { toArray($_); } @ARGV;
Instead of looping through the elements of @ARGV, I used map() and a helper function
instead. Also I changed the input format to match that in the spec so the regexp is different.
Inserting $N (the last element of @ARGV) was a lot easier than I thought. I just sorted @ARGV by
the start of each interval.
my $size = scalar @intervals;
my @merged;
for (my $i = 0; $i < $size; $i++) {
my $start = $intervals[$i]->[0];
my $end = $intervals[$i]->[1];
while ($i < $size - 1 &&
$end >= $intervals[$i + 1]->[0] && $end <= $intervals[$i + 1]->[1]) {
$end = $intervals[$i + 1]->[1];
$i++;
}
push @merged, [$start, $end];
}
The merge code is essentially the same as in challenge 50 except I loop through the entire
@intervals instead of stopping one short from the end.
say join ', ', map { "($_->[0],$_->[1])" } @merged;
The output format is also different so I had to change the way I printed @merged slightly.
The same comments apply to the Raku version.
sub toArray(Str $arg) {
$arg ~~ m/ \( (\d+) \, (\d+) \) /;
return [$0.Int, $1.Int];
}
sub MAIN(
*@S #= A set of sorted non-overlapping intervals enclosed in
#= parentheses and separated by commas. The last pair will
#= be merged into the rest.
where { @S.elems > 1 }
) {
my @intervals = @S.map( { toArray($_) } ).sort({@^a[0] <=> @^b[0]});
my $size = @intervals.elems;
my @merged;
loop (my $i = 0; $i < $size; $i++) {
my $start = @intervals[$i][0];
my $end = @intervals[$i][1];
while $i < $size - 1 && $end ~~ @intervals[$i + 1].minmax {
I like how simple it is in Raku to see if a value such as $end is within a range. It is .minmax() that
converts the two-element array @intervals[$i + 1] into a range.
$end = @intervals[$i + 1][1];
$i++;
}
push @merged, [$start, $end];
}
@merged.map({ "[$_[0],$_[1]]"; }).join(q{, }).say;
}