The Weekly Challenge ‐ Perl and Raku

CY's Take on The Weekly Challenge #115

If you want to challenge yourself on programming, especially on Perl and/or Raku, go to https://perlweeklychallenge.org, code the latest challenges, submit codes on-time (by GitHub or email).

Do tell me, if I am wrong or you strongly oppose my statements!

---

Task 1: String Chain

We can solve this by brute-force: counting all possible permutations and check whether the last alphabet of a component is the first alphabet of next component. But we can treat the task as a task of graph theory.

Treat the strings as edges and the first(and last) alphabets as vertices.

A directed graph has an Eulerian cycle if and only if every vertex has equal in-degree and out-degree, and all of its vertices belong to a single connected component of the underlying undirected graph. (Source: Wikipedia, much rephrased)

Therefore there are two parts of my code:

1. Check the in-degree and out-degree of each vertex;
2. check whether the underlying undirected graph is connected.

First part:

sub consistent_degrees {
    my @edges = @_;
    my %i_vertex;
    my %o_vertex;
    for my $str (@edges) {
        my $head = substr $str, 0, 1;
        my $tail = substr $str, -1, 1;
        push $i_vertex{$tail}->@*, $head;
        push $o_vertex{$head}->@*, $tail;
    }

    for my $letter (keys %i_vertex) {
        if (!$o_vertex{$letter}) {
            return 0;
        }
        if (scalar @{$i_vertex{$letter}}
              != scalar @{$o_vertex{$letter}}) {
            return 0;
        }
    }
    return 1;
}

Second part:

sub is_connected {
    my @edges = @_;
    my %collected;
    my %vertex_neigh;
    for my $str (@edges) {
        my $head = substr $str, 0, 1;
        my $tail = substr $str, -1, 1;
        $collected{$head} = -1;
        $collected{$tail} = -1;
        push $vertex_neigh{$head}->@*, $tail;
        push $vertex_neigh{$tail}->@*, $head;
    }
    # depth-first search
    my @stack = substr($edges[0], 0, 1);
    while (scalar @stack != 0) {
        my $cur = pop @stack;
        if ($collected{$cur} == 1) {
            next;
        }
        else {
            for my $neigh ($vertex_neigh{$cur}->@*) {
                push @stack, $neigh if $collected{$neigh} == -1;
            }
            $collected{$cur} = 1;
        }
    }
    #check connectedness
    for my $letter (keys %collected) {
        if ($collected{$letter} == -1) {
            return 0;
        }
    }
    return 1;
}

As the question does not request us output a possible chain, I just stop here. An algorithm can be found, again, on Wikipedia.

I thought of providing a guest language submission of Java, but I found I deleted my previous Java code on rosalind.info (a site on bioinformatics algorithms) (though I have recollected that I made an Edge class and Vertex class for those tasks); and this week wasn't a fine week for me; hence I just slacked off.

Anyway... A mere accident is going to be mentioned. During my coding, initially, I wrote the default case as:

my $S = @ARGV || ("abc");

It kept bringing me the number of strings (scalar context of @ARGV) and, return 1 (because I am testing with small number of strings). Ooops. Finally I realized the problem is on ||. The code was then changed:

my @S = @ARGV;
@S = ("IT DOESNT MATTER ") if !@S;

Task 2: Largest Multiple

Sort the digits from largest to smallest, pick up the smallest even digit to be the last digit, then output the number.

A Few Words on Previous Week

Challenge 114, Task 2 : I just divided several cases for task 2 "Higher Integer Set Bits" (code). Never thought of the simple idea of keeping change of "01" to "10". Oh.

Challenge 111, Task 2 : I read the Perl review and found my submitted code trapped by case-insenitiveness. :( Maybe this is why experience in programming is important. :)

---

Stay alert (even if you have taken the vaccine); furthermore, care for the less lucky people in our flat world! □

link for codes: ch-1.pl, ch-2.pl

---

Contact on twitter: @e7_87.

Created Date: 6th May, 2021; last updated: 22:20 HKT