Solving Perl Weekly Challenge 092 -- Isomorphic Strings and Insert Interval.

作者:   發佈於: ,更新於:   #raku

The two tasks from Perl Weekly Challenge 092 seems to be useful inn some scenario.

TASK #1 › Isomorphic Strings

Submitted by: Mohammad S Anwar

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

Solution #1 › Isomorphic Strings

From the article "How to check if two strings are isomorphic", we could grasp the definition of "Isomorphic Strings". For string $A, $B, if there exists an character-mapping convert $A to $B and $B to $A, we say that this twoo strings are isomorphic. This seems to be similar to the definition of isomorphism in math.

With such definition in mind, to check if two strings are isomorphic, we shall gradually build the two-way character map by iterating through both of them character by character. In the way if any conflict happens, that means $A and $B are not isomorphic, otherwise they are.

Such algorithm can be translated to the follow Raku program:

sub isomorphic (Str $A, Str $B) {
    my %trans;
    return False unless $A.chars == $B.chars;

    # [1]
    for 0..^$A.chars -> $i {
        my $a = $A.substr($i, 1);
        my $b = $B.substr($i, 1);

        if %trans{"ab"}{$a}:exists and %trans{"ab"}{$a} ne $b {
            return False
        }
        %trans{"ab"}{$a} = $b;

        if %trans{"ba"}{$b}:exists and %trans{"ba"}{$b} ne $a {
            return False
        }
        %trans{"ba"}{$b} = $a;
    }
    return True;
}

It does not look very different from many other programming lanuanges except for some punctuations.

The beginnnig of for loop at [1] can be rewritten with .comb function and Z operator like this:

    for $A.comb Z $B.comb -> ($a, $b) {
        ...
    }

Slightly shorter.

With for loop in Raku, we could iterate over multiple elements at a time and that's as easy as just adding more variables before the block:

my @S = (1,1,2,3,5,8,13,21,34);
for @S -> $a,$b,$c {
    say "$a, $b, $c";
}
## Output
# 1, 1, 2
# 3, 5, 8
# 13, 21, 34

Z operator gives us a list of list. To capture the elements inside the inner list, we need wrap $a and $b inside a pair of parenthesis. Without, $a and $b captures the inner list themselfs. Consider the following program which demonstrates such differences:

my @S = (1,1,2,3,5,8,13,21);
my @T = (1,2,3,5,8,13,21,34);

# [2]
for @S Z @T -> $a,$b {
    say "$a, $b";
}

# [3]
for @S Z @T -> ($a,$b) {
    say "$a, $b";
}

## Output of [2]
# 1 1, 1 2
# 2 3, 3 5
# 5 8, 8 13
# 13 21, 21 34

## Output of [3]
# 1, 1
# 1, 2
# 2, 3
# 3, 5
# 5, 8
# 8, 13
# 13, 21
# 21, 34

To take a peek of what @S Z @T gives us, use .gist or .raku:

say (@S Z @T).gist;
#=> ((1 1) (1 2) (2 3) (3 5) (5 8) (8 13) (13 21) (21 34))

say (@S Z @T).raku;
#=> ((1, 1), (1, 2), (2, 3), (3, 5), (5, 8), (8, 13), (13, 21), (21, 34)).Seq

TASK #2 › Insert Interval

Submitted by: Mohammad S Anwar

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)

Solution #2 › Insert Interval

Merging multiple intervals as one, that would be a navie way to do compression.

The input $S is sorted and there are no overlaps. However, $N might be overlapping with one ore more elements inside $S. The following Raku code is not probably the most efficient solution. Since List is immutable and I need to mutate the content of it, I use @S (Array) and make it a copy of $S (List).

sub insert-intervals (@S is copy, $N) {
    # [1]
    my $i = @S.first(-> $s { $s[0] <= $N[0] <= $s[1] }, :k);
    my $j = @S.first(-> $s { $s[0] <= $N[1] <= $s[1] }, :k);

    # [2]
    if $i.defined {
        @S[$i] = (@S[$i][0], max(@S[$i][1], $N[1]));
    }

    # [3]
    if $j.defined {
        @S[$j] = (@S[$j][0], max(@S[$j][1], $N[1]));

        # [4]
        if $i.defined and @S[$i][0] <= @S[$j][0] <= @S[$i][1] {
            @S[$i] = (@S[$i][0], @S[$j][1]);

            for $i^..$j -> $x {
                @S[$x] = Nil;
            }
        }
    }

    # [5]
    if none($i.defined, $j.defined) {
        @S.push($N);
        @S = @S.sort({ $^a[0] <=> $^b[0] });
    }

    # [6]
    return @S.grep({ .defined });
}

At [1], we check whether $N[0] and $N[1] are individually overlaps with some elements in @S. If they are, we let @S[$i] be the first element of @S that contains $N[0] and @S[$j] be the first element of @S that contains $N[1]. Such arrangement is used latter from [2] to [5]. Since @S is sorted, we can also assert $i ≤ $j here.

At [2], we merge $S[$i] with $N if $N[0] is inside @S[$i].

At [3], we merge $S[$j] with $N if $N[1] is inside @S[$j].

At [4], if both $i and $j are defined, that means the elements of @S in the range of $i..$j all overlap and they are all merged into @S[$i]. Other elements arke marked as deletable.

At [5], we handle the case of when neither $i nor $j exists. This means $N is not overlapping with any elemens of @S.

At [6], we delete the elements of @S that are marked as deletable from [4].

With all those edge cases, this does not seems to be an efficient solution. Perhaps I should work onn it a little bit more.


本文為《解 Perl Weekly Challenge 092 -- 同構字串與合併範圍》之英文版。