Chinese Zodiac calculation in Perl and Elm

Tags:

This week the Perl Weekly Challenge task one was about calculating the Chinese Zodiac element and animal. I've solved it in Perl and Elm and share them here. Both I did in a TDD style; the Elm one benefits from my having solved in Perl first I think.

Perl

The Perl version I ended up with this test:

use Test2::V0 -target => 'Zodiac';

is $CLASS->sign_from_year(1938), 'Earth Tiger',  '1938 -> Earth Tiger';
is $CLASS->sign_from_year(1967), 'Fire Goat',    '1967 -> Fire Goat';
is $CLASS->sign_from_year(1973), 'Water Ox',     '1973 -> Water Ox';
is $CLASS->sign_from_year(2003), 'Water Goat',   '2003 -> Water Goat';
is $CLASS->sign_from_year(2017), 'Fire Rooster', '2017 -> Fire Rooster';

done_testing;

The accompanying lib file looks like this:

package Zodiac;
use Moo;

sub _build_zodiac_table {

    my @elements = (
        qw/
            Wood
            Fire
            Earth
            Metal
            Water
            /
    );

    my @animals = (
        qw/
            Rat
            Ox
            Tiger
            Rabbit
            Dragon
            Snake
            Horse
            Goat
            Monkey
            Rooster
            Dog
            Pig
            /
    );

    my $elem_key = 0;

    my %table;
    for ( my $i = 1; $i <= 61; $i = $i + 2 ) {
        $table{$i} = $elements[$elem_key];
        $table{ $i + 1 } = $elements[$elem_key];

        $elem_key++;
        $elem_key = 0 if $elem_key > 4;
    }

    my $animal_key = 0;
    for ( my $i = 1; $i <= 61; $i++ ) {
        $table{$i} .= ' ' . $animals[$animal_key];

        $animal_key++;
        $animal_key = 0 if $animal_key > 11;
    }

    return \%table;

}

sub sign_from_year {
    my ( $self, $year ) = @_;

    my $table = _build_zodiac_table();
    my $step1 = $year - 3;
    my $step2 = int $step1 / 60;
    my $step3 = $step1 - ( 60 * $step2 );

    return $table->{$step3};
}

1;

I find this a bit clunky, the code that generates the lookup table is a bit mystical and has some magic numbers. As you'll see in the Elm version, actually just having the lookup table as a simple array might be better for readability.

The sign_from_year is pretty simple I think, it "should" reference the formula from the wiki page really. I've left it pretty much as the formula describes... which I think in this case makes sense for a future developer looking at the code. It's not concise, but reflects the "business logic" and the language matches that of the language of the "domain". The wiki page author I hope would be able to see the steps they described in that function. So if I misunderstood the steps, hopefully they would see it without being a Perl developer.

Elm

The equivalent Elm test code looks like this:

module Zodiac_test exposing (..)

import Array
import Browser exposing (element)
import Expect exposing (Expectation)
import Fuzz exposing (Fuzzer, int, list, string)
import Html exposing (footer)
import Test exposing (..)
import Zodiac exposing (..)


sign_from_year_test =
    describe "Zodiac sign_from_year"
        [ test "1967 -> Fire Goat" <|
            \_ ->
                let
                    sign =
                        Zodiac.sign_from_year 1967
                in
                Expect.equal sign "Fire Goat"
        , test "2017 -> Fire Rooster" <|
            \_ ->
                let
                    sign =
                        Zodiac.sign_from_year 2017
                in
                Expect.equal sign "Fire Rooster"
        , test "1938 -> Earth Tiger" <|
            \_ ->
                let
                    sign =
                        Zodiac.sign_from_year 1938
                in
                Expect.equal sign "Earth Tiger"
        , test "1973 -> Water Ox" <|
            \_ ->
                let
                    sign =
                        Zodiac.sign_from_year 1973
                in
                Expect.equal sign "Water Ox"
        ]


table_index_test =
    describe "Zodiac table_index"
        [ test "1967 -> 44" <|
            \_ ->
                let
                    index =
                        Zodiac.table_index 1967
                in
                Expect.equal index 44
        , test "2017 -> 34" <|
            \_ ->
                let
                    index =
                        Zodiac.table_index 2017
                in
                Expect.equal index 34
        , test "1973" <|
            \_ ->
                let
                    index =
                        Zodiac.table_index 1973
                in
                Expect.equal index 50
        ]


table_test =
    describe "Zodiac table"
        [ test "60 rows" <|
            \_ ->
                let
                    ztable =
                        Zodiac.table
                in
                Expect.equal (Array.length ztable) 60
        , test "row 44 -> Fire Goat" <|
            \_ ->
                let
                    ztable =
                        Zodiac.table

                    element =
                        case Array.get 44 ztable of
                            Just foo ->
                                foo

                            Nothing ->
                                "Error!"
                in
                Expect.equal element "Fire Goat"
        , test "row 34 -> Fire Rooster" <|
            \_ ->
                let
                    ztable =
                        Zodiac.table

                    element =
                        case Array.get 34 ztable of
                            Just foo ->
                                foo

                            Nothing ->
                                "Error!"
                in
                Expect.equal element "Fire Rooster"
        ]

And the logic looks like this:

module Zodiac exposing (..)

import Array


table_index : Int -> Int
table_index year =
    let
        step1 =
            year - 3

        step2 =
            step1 // 60

        step3 =
            step1 - (60 * step2)
    in
    step3


sign_from_year : Int -> String
sign_from_year year =
    let
        zodiac_table =
            table

        index =
            table_index year
    in
    case Array.get index zodiac_table of
        Just sign ->
            sign

        Nothing ->
            "ERROR: year->" ++ String.fromInt year ++ " index->" ++ String.fromInt index


table =
    let
        zodiac =
            [ "" -- Left blank intentionally
            , "Wood Rat"
            , "Wood Ox"
            , "Fire Tiger"
            , "Fire Rabbit"
            , "Earth Dragon"
            , "Earth Snake"
            , "Metal Horse"
            , "Metal Goat"
            , "Water Monkey"
            , "Water Rooster"
            , "Wood Dog"
            , "Wood Pig"
            , "Fire Rat"
            , "Fire Ox"
            , "Earth Tiger"
            , "Earth Rabbit"
            , "Metal Dragon"
            , "Metal Snake"
            , "Water Horse"
            , "Water Goat"
            , "Wood Monkey"
            , "Wood Rooster"
            , "Fire Dog"
            , "Fire Pig"
            , "Earth Rat"
            , "Earth Ox"
            , "Metal Tiger"
            , "Metal Rabbit"
            , "Water Dragon"
            , "Water Snake"
            , "Wood Horse"
            , "Wood Goat"
            , "Fire Monkey"
            , "Fire Rooster"
            , "Earth Dog"
            , "Earth Pig"
            , "Metal Rat"
            , "Metal Ox"
            , "Water Tiger"
            , "Water Rabbit"
            , "Wood Dragon"
            , "Wood Snake"
            , "Fire Horse"
            , "Fire Goat"
            , "Earth Monkey"
            , "Earth Rooster"
            , "Metal Dog"
            , "Metal Pig"
            , "Water Rat"
            , "Water Ox"
            , "Wood Tiger"
            , "Wood Rabbit"
            , "Fire Dragon"
            , "Fire Snake"
            , "Earth Horse"
            , "Earth Goat"
            , "Metal Monkey"
            , "Metal Rooster"
            , "Water Dog"
            ]
    in
    Array.fromList zodiac

You can see that I benefited from having written the Perl solution already, it is a good lesson to any of us. The second implementation of your solution is often better than your first as you learnt a few things doing the first one. Too often, once we do the first implementation we never do a second. Be that in another language like this; or a refactor in the same language.

I use a simple list, rather than the complicated looping I did in Perl. Which for me is more elegant, a new developer coming to my code I think will see the zodiac signs and understand it a lot more easily than the calculated version.

The other thing I do better in the Elm version is break the code into three components, and test them accordingly. With the Perl version I basically just did a "service" test or "integration" test. Though they are all "unit" tests.

The tests in Elm verbose. That may be the way I wrote them, it might be the library. In either case I don't mind. I like the test format, it's descriptive and the verbosity is balanced against specific and readable tests. I am not a fan of super complicated tests when I can't easily see the input, the command call and the expected value. I like that this test tells me what I am testing.

The table_test may seem a bit excessive when you compare it to the code it is testing. It is, the reason being that I had a different approach when I started (calculating the table) so I had tests to confirm I had the right number of elements. Trying to test and code it proved more difficult than it felt worth doing. So I simplified the code. I did not remove the tests as they kept passing when I changed approach.

Comparing the two implementations, I prefer the Elm one this time (unlike when I did this previously). I think the reason is that this time I started in a TDD style with the Elm, which meant that I broke it into easily testable units. Which helped with the design of the code.

I wish I had recorded my coding up the Elm implementation as the end result does not show the way the TDD approach and an exquisite compiler helped me to quickly take small steps towards the solution. Next time I shall try and be good and do that.

Thanks once again to Mohammad for running the challenge. Please chat with me about this via the @perlkiwi twitter handle.

Perl Weekly Challenge 100 part 2

Tags:

This is the second post in relation to Mohammad Anwar's awesome Perl Weekly Challenge, to celebrate the 100th challenge.

You can find the first post here: pErLM for the Perl Weekly Challenge 100.

Task 2 - Triangle Sum (Minimum Path Sum)

I you head over to the https://perlweeklychallenge.org/blog/perl-weekly-challenge-100/#TASK2 page, you'll see the idea here. Calculate the smallest sum of the nodes in a triangle/tree of integers. This is a pretty classic problem and is solved a bunch of ways; my approach is the "Dynamic Programming" approach in Perl.

So the pseudo-code for this is:

  • Take the array of arrays and make it a table/matrix
  • Start at bottom row and calculate the smallest sum option.
  • Repeat moving up the rows
  • Return cell 0,0 which "should" be the minimum path sum.

As ever, I start with a test and work my way out from there. Adding the simplest solution I can as I go along... literally return static values at first. So I call a class method, see the tests fail. Then create the .pm file, name it and add a sub foo { return 8; } which literally does nothing. Then I expand out from there.

Lets break with tradition and lets look at the completed module first:



package Triangle;

use Moo;

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

sub min_path_sum {
    my ( $self, $triangle ) = @_;

    my $table = $self->triangle_to_table($triangle);
    my $sum   = $self->parse_table($table);

    return $sum;
}

sub triangle_to_table {
    my ( $self, $triangle ) = @_;

    my $max = @$triangle - 1;
    for my $row_index ( 0 .. $max ) {
        for my $column_index ( 0 .. $max ) {
            $triangle->[$row_index][$column_index] //= 0;
        }
    }

    return $triangle;
}

sub parse_table {
    my ( $self, $table ) = @_;

    my $max = @$table - 1;

    for my $row_index ( reverse( 0 .. $max - 1 ) ) {
        for my $column_index ( 0 .. $max - 1 ) {
            if ( $table->[ $row_index + 1 ][$column_index]
                < $table->[ $row_index + 1 ][ $column_index + 1 ] )
            {
                $table->[$row_index][$column_index]
                    += $table->[ $row_index + 1 ][$column_index];
            }
            else {
                $table->[$row_index][$column_index]
                    += $table->[ $row_index + 1 ][ $column_index + 1 ];
            }

        }
    }

    return $table->[0][0];
}

1;

So you can see the I broke the problem up into two stages:

  • triangle_to_table
  • parse_table

Bad names I think, but it does mean that hopefully you can recognise the approach I described in pseudo-code. There are absolutely better ways of doing this, but this works and I know it works because of the tests I wrote as I explored the approach:


use Test2::V0 -target => 'Triangle';

subtest 'min_path_sum' => sub {
    is $CLASS->min_path_sum( [ [1], [ 2, 4 ], [ 6, 4, 9 ], [ 5, 1, 7, 2 ] ] ),
        8,
        'Example 1 returns 8';

    is $CLASS->min_path_sum( [ [3], [ 3, 1 ], [ 5, 2, 3 ], [ 4, 3, 1, 3 ] ] ),
        7,
        'Example 2 returns 7';
};

subtest 'triangle_to_table' => sub {
    my $in = [ [1], [ 2, 4 ], [ 6, 4, 9 ], [ 5, 1, 7, 2 ] ];
    my $expected
        = [ [ 1, 0, 0, 0 ], [ 2, 4, 0, 0 ], [ 6, 4, 9, 0 ], [ 5, 1, 7, 2 ] ];
    is $CLASS->triangle_to_table($in), $expected, 'Example 1';

    $in = [ [3], [ 3, 1 ], [ 5, 2, 3 ], [ 4, 3, 1, 3 ] ];
    $expected
        = [ [ 3, 0, 0, 0 ], [ 3, 1, 0, 0 ], [ 5, 2, 3, 0 ], [ 4, 3, 1, 3 ] ];
    is $CLASS->triangle_to_table($in), $expected, 'Example 2';
};

ok 1;

done_testing;

When I started I only had the first test:


    is $CLASS->min_path_sum( [ [1], [ 2, 4 ], [ 6, 4, 9 ], [ 5, 1, 7, 2 ] ] ),
        8,
        'Example 1 returns 8';

And the first iteration of Triangle.pm looked like this:


package Triangle;

sub min_path_sum {
    return 8;
}

1;

As I've said elsewhere, this is my style of doing things. Write a test, hard-code a return value. Then I know that I have the simplest solution. If Mohammad literally only had the one example, I'd stop there as I have met the "user requirement".

But there is more than one example, so a simple return does not suffice (of course) so I did implement the next stage. In my case, I actually moved forward by hard coding the triangle_to_table sub, and worked on the actual logic to solve for first example properly. THEN, I added the second example as a test and it failed as the triangle_to_table sub was stubbed out. So then I wrote tests for that sub and implemented the logic.

The nice thing here was that once I did that, the tests worked and adding the second example to the min_path_sum test just plain worked. :)

A good example of how TDD helps you design and then maintain integrity when you get it right. It took me a little longer (arguably) to get to a working solution... but it got faster as I went along and when I was "done" I had confidence I was finished as the tests confirmed it. At least in so much that the assumptions I tested were true. I have not coded for edge cases, etc.

I actually find TDD gives me a smoother ramp up, I start coding with super simple building blocks, the scaffolding which I need to build my solution. And line physical scaffolding, it's pretty easy to put together and when done shows the shape of things to come. I find it gets my head into the right space to do the "hard stuff". I have got the dopamine hits of tests passing, I've also very lightly started thinking through interfaces and the problem space.

I should also focus some attention on the pseudo-code stage of the process.

This you could call the High Level Design (HLD) as it's been called in places I have worked. This is the whiteboard scribbles, the napkin design that serves as the first feedback cycle in the design. As you can see from the example at the top of this page, my initial plan had four steps. By the time I finished you can see that was altered to be 2 methods. So my design changed even between the time I wrote the pseudo-code and when I started coding. That is super cheap, this is the essence of pragmatic software development for me. Do the smallest thing that gets me feedback that I know what I am doing will work. Then do the next step.

The final step (and I admit I often skip this) was to wire this into a Perl script someone could call from the command line. This was actually one that took me a little longer than it should, and I'd not want to ship my solution to a real user as it's definitely a kludge.


use strict;
use warnings;

use lib './lib';
use Triangle;

my $tri = Triangle->new;

# usage:
# perl ch-2.pl [[1], [2,4], [6,4,9], [5,1,7,2]]
# perl ch-2.pl [[3], [3,1], [5,2,3], [4,3,1,3]]

my @triangle = parse(@ARGV);

print "The minimum path sum: ";
print $tri->min_path_sum( \@triangle );
print "\n";

sub parse {
    my @rows = @_;
    my @triangle;

    for my $row (@rows) {
        $row =~ s/\[//g;
        $row =~ s/\]//g;

        my @values = split ',', $row;
        push @triangle, \@values;
    }

    return @triangle;
}

My script basically allowed me to cut and paste the Perl style arrayrefs that the challenge used directly. It meant some ugly regexing away the square brackets and using Perl's flexibility to auto-magically know that I wanted the strings that contained numbers should be integers to do the minimum_path_sum calculations to.

By this I mean that the way I wrote this the Perl script just sees an array of strings. So the square brackets are removing the character from the string. The split makes an array of strings from the row strings. Then pushes a reference to that array of strings into @triangle and returns that.

The min_path_sum method just starts treating the elements as integers later (in the comparisons and addition). It's one of Perl's strengths compared to typed languages for example where I'd have to explicitly do a conversion (if you look at my Elm solution to task 1 (previous post) you'll see I need to use String.toInt to make that happen. In Perl I don't have to do that dance. Yes, there are downsides and weird bugs that "could" occur; but for the purposes of this code, I don't need to worry about it and can just benefit from this feature of the language.

Summary

This was another fun one, nice to work on. The pattern is one we have seen in other challenges, and every time you get to exercise an approach intentionally it helps to cement it into your mind/toolkit. Making it easier to identify and take advantage of in a different context.

I hope if you have read this far that it was of interest and that you'll drop me a message with your thoughts.

pErLM for the Perl Weekly Challenge 100

Tags:

This week marks the 100th edition of the Perl Weekly Challenge a fantastic project started back in March 2019. Since the start it has garnered a lot of support from Perl developers and other languages.

This week, so far; I have solved the first solution in two languages. Firstly Perl and secondly in Elm. I like both languages a lot and decided to coin the term pErLM to describe my use of Perl as my back-end language and Elm as my front-end language.

Perl is the mature, super stable, well proven technology that runs almost anywhere and is flexible and allows many ways of doing things. Great library support and "boring" in the good sense of the term. Perl just works for me.

Elm on the other hand is new, very constrained and serves one purpose... creating web applications.

The combination or Perl and Elm (pErLM) provides a fantastic combination. Elm provides the interactivity on the front-end and Perl the flexibility on the back end. Where Elm provides types and constraints to work within, Perl provides options for those "side effects". Using a web framework like Dancer2 makes scaffolding up a back-end for a Elm app a breeze.

Both language have a great formatter and static analysis... sort of. Perl has Perl::Critic and Elm has well it's amazing compiler.

I recommend giving it a try, let me know how you get on. I'll be posting about how I have started adopting this pErLM shape on the side project I have been renovating from CGI to PSGI/Dancer2 to a JSON back-end and Elm front-end.

But that's the future... today lets look at how I implemented the challenge for week 100 in both languages.

Challenge 100

This weeks challenge is a time converter. When given a time in 24 hour format; return it in 12 hour format and vice versa.

Perl version

So I did this challenge on my normal style; starting with a .t test file:


use Test2::V0 -target => "Fun";

is $CLASS->convert("05:15 pm"), '17:15', 'Example 1-1';
is $CLASS->convert("05:15pm"),  '17:15', 'Example 1-2';

is $CLASS->convert("19:15"), '07:15pm', 'Example 2-1';

is $CLASS->convert("09:15"), '09:15am', '24hr AM';

done_testing;

Four simple tests (yes I did them one at a time in a TDD-esque style), the code I ended up with looks like this:


package Fun;

use Moo;

sub convert {
    my ( $self, $time ) = @_;

    if ( $time =~ m/([ap]m)/ ) {
        my $am_pm = $1;

        $time =~ m/^(\d+):(\d+)/;
        my $hours   = $1;
        my $minutes = $2;

        if ( $am_pm eq 'pm' ) {
            $hours += 12;
        }
        return "$hours:$minutes";
    }
    else {
        $time =~ m/^(\d+):(\d+)/;
        my $hours   = $1;
        my $minutes = $2;

        if ( $hours > 12 ) {
            $hours -= 12;
            return sprintf( "%02d", $hours ) . ":$minutes" . 'pm';
        }
        else {
            return sprintf( "%02d", $hours ) . ":$minutes" . 'am';
        }
    }
}

1;

Nothing too clever to talk about here; this is a un-refined solution; but works and provably works.

I also created a small script file to meet the requirement to use this from the command line:


use strict;
use warnings;

use lib './lib';
use Fun;

my $fun = Fun->new;

print $fun->convert($ARGV[0]);
print "\n";

Short and to the point. I have a confession to make; Mohammad if you are reading this I saw the "Ideally we expect a one-liner." instruction... and ignored it completely! :-)

Why?

Because I don't have an interest in one-liners; it is partially as I am too lazy to put the work in and partially because I don't like to promote Perl in that context. Perl is a graceful language; but can also be a code golfers paradise. One liners and code golfing is, to use a common refrain, "considered harmful" for the Perl community I think broadly.

The main reason I say that is the external perspective of Perl, I read too many tweets and blog posts that when they talk about Perl it's not positive often because of the perception created by the "clever" Perl one-liner. To be clear, the clever one-liners are superbly powerful and useful in the right hands. But I feel that they should be what we discover later in our Perl journey and not be the think we place front and centre.

That's just a personal perspective. Give it some thought and tell me what you think.

Elm

My Elm solution is... ugly and incomplete. It's not a functional web app just a some code that does the conversion. I did the least effort possible, its not DRY, it's not thought through... you have been warned.

So again, I start with a test; the final version here (again I started with a single test):

module Example exposing (..)

import Expect exposing (Expectation)
import Fun exposing (convert)
import Fuzz exposing (Fuzzer, int, list, string)
import Test exposing (..)


suite : Test
suite =
    describe "Fun"
        [ test "convert 07:15" <|
            \_ ->
                let
                    got =
                        convert "07:15"
                in
                Expect.equal got "07:15am"
        , test "convert 05:15pm" <|
            \_ ->
                let
                    got =
                        convert "05:15 pm"
                in
                Expect.equal got "17:15"
        , test "convert 19:15" <|
            \_ ->
                let
                    got =
                        convert "19:15"
                in
                Expect.equal got "07:15pm"
        , test "convert 09:15" <|
            \_ ->
                let
                    got =
                        convert "09:15 am"
                in
                Expect.equal got "09:15"
        ]


And the (ugly... I have warned you) code looks like this:


module Fun exposing (convert)


convert : String -> String
convert time =
    if String.contains "am" time then
        String.slice 0 5 time

    else if String.contains "pm" time then
        let
            hourMin =
                String.split ":" time
        in
        case List.head hourMin of
            Just a ->
                let
                    hour =
                        String.toInt a
                in
                case hour of
                    Just h ->
                        let
                            hx =
                                h + 12
                        in
                        String.fromInt hx ++ String.slice 2 5 time

                    Nothing ->
                        ""

            Nothing ->
                ""

    else
        let
            hourMin =
                String.split ":" time
        in
        case List.head hourMin of
            Just a ->
                let
                    hour =
                        String.toInt a
                in
                case hour of
                    Just h ->
                        if h > 12 then
                            let
                                hx =
                                    h - 12
                            in
                            let
                                hourStr =
                                    String.fromInt hx
                            in
                            if String.length hourStr > 1 then
                                hourStr ++ String.slice 2 5 time ++ "pm"

                            else
                                "0" ++ hourStr ++ String.slice 2 5 time ++ "pm"


                        else
                            String.slice 0 5 time ++ "am"

                    Nothing ->
                        ""

            Nothing ->
                ""

As you can see lots of ugly repetition and some naive approaches. I've not broken the code out into sub functions there is not typing etc. But it works and it provably works.

Thoughts?

As you can see neither solution wins any prizes for conciseness; but interestingly the Perl is tidier. This is partially because I naturally write better Perl that Elm at the moment. Especially "first pass" code like these two example. The other reason in my opinion is that Perl is well suited to the task and Elm less so.

Elm is designed to create a interactive web application, handling human interactions (via messages) and representing these changes in a web page. Being a functional language side effects are intentional discouraged and immutable data is what we want. It is ideal for interactivity, sending and receiving data from an API and that sort of thing.

Perl is really well suited to handling text, massaging it into something else and returning it. Even my simplistic implementation is smaller and makes more sense than the Elm equivalent. I think after some iterations and refactoring the Elm would be a lot tidier... but again it's pushing against the flow of what Elm wants to be.

So I like this as an example of why I like my new "pErLM" stack. Elm does one thing and does it well, front-end. Perl does not work here at all; but is ideal for a stable back-end. Where Perl is flexible and able to do a wide variety of tasks well; Elm is tightly constrained and does not make doing things other than a web front-end easy.

So doing this dual implementation is for me an example of using the right tool for the right job.

Next?

So after this, I want to do the challenge in another language. Clojure (Lisp) I think; a language I have never worked in. Maybe PHP (that's an easy one I know) or perhaps Node if time/energy permits. But those are easy choices; so I want to try this in a lisp as it's very different... what other languages do you think I could try?

Drop me a note and let me know.

Perl Weekly Challenge 097

Tags:

This is another one of those posts about the Perl Weekly Challenge where I briefly describe the solution I write for the challenge. You can see other posts in this series clicking HERE.

This week the challenge was to implement the classic Caesar cipher.

Here is the week 097 challenge:

TASK #1 › Caesar Cipher Submitted by: Mohammad S Anwar

You are given string $S containing alphabets A..Z only and a number $N.

Write a script to encrypt the given string $S using Caesar Cipher with left shift of size $N. Example

Input: $S = "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG", $N = 3 Output: "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD"

Plain: ABCDEFGHIJKLMNOPQRSTUVWXYZ Cipher: XYZABCDEFGHIJKLMNOPQRSTUVW

Plaintext: THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG Ciphertext: QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD

As is my habit I started by creating a .t test file:


use strict;
use warnings;

use Test2::V0 -target => 'Caesar';

can_ok( $CLASS, 'encode' );

done_testing;

This is for me an example of "[tracer bullet developmentp(https://growsmethod.com/practices/TracerBullets.html)", to a degree at least.

The idea, which I think I first saw in the Pragmatic Programmer book, is that you should try going end to end with the thinnest slice you can. So in this case the bare minimum I am looking for is a class that has a encode method. That's my base, so this test is simply trying to load a package and checking the method exists.

At this point it fails as lib/Caesar.pm does not exist; so I create a simple file:


package Caesar;

use Moo;

1;

This also fails as there is no encode method; so I add that:


package Caesar;

use Moo;

sub encode {}

1;

And now my tests pass, as I have a module with the correct file and package names, and a correctly named method. This may seem to simple to bother as a first step, but given how terrible my typing is, I like to confirm the basics. In a "real" code base where you might be building a feature that requires multiple new classes and/or methods at varying layers I think it's really valuable to at least "wire up" the classes and methods this way before starting to add business logic. It just helps avoid the inevitable typo style errors. I think it also helps me with naming as you flex your fingers through multiple places; it becomes obvious where a naming convention is jarring. It's loads easier to make the naming changes before anything relies on it.

So... having established as frame to work from (some people call this a walking skeleton, I can start fleshing it out, so lets add a more useful test:


use strict;
use warnings;

use Test2::V0 -target => 'Caesar';

subtest '->encode()' => sub {
    my $S        = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
    my $N        = 3;
    my $expected = "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD";

    my $got = $CLASS->encode(
        string => $S,
        n      => $N,
    );

    is $got, $expected, "'$S' with shift of '$N' should return '$expected'";
};


done_testing;

So we can see easily there what we are feeding in and what we expect out, and Test2::V0 makes it really easy to visualise what we are testing. The code that generates starts as simple as return 'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD' as the first iteration. Then grows outwards, and in my case I ended up with:


sub encode {
    my ( $self, %args ) = @_;

    my $cipher = $self->_cipher( 'n' => $args{n}, mode => 'encode' );

    my $text;
    my @chars = split "", $args{string};
    for my $char (@chars) {
        $text .= $cipher->{ lc($char) };

    }

    return uc $text;
}

To be clear, this is the version after several iterations. You can see I call a "private" method $self->_cipher which was code that was originally in the method, but I moved it out when I added the ability to both encode and decode text. The code is hopefully pretty understandable, we get the cipher. We take the string we were passed and convert it into an array. Then is a simple loop through the array converting the encoded character to the decoded character. Finally returning the converted string.

You'll see I added a lc (lower case) and a uc (upper case) to format as per the examples.

The $cipher is a simple hash that has a nice encoded => decoded mapping. It's generated with this code:


sub _cipher {
    my ( $self, %args ) = @_;

    my @alpha  = (qw/a b c d e f g h i j k l m n o p q r s t u v w x y z/);
    my @cipher = @alpha;

    if ( $args{mode} eq 'decode' ) {

        for ( 1 .. $args{n} ) {
            my $char = pop @cipher;
            unshift @cipher, $char;
        }
    }
    else {
        for ( 1 .. $args{n} ) {
            my $char = shift @cipher;
            push @cipher, $char;
        }

    }

    my %code;
    for my $i ( 0 .. 25 ) {
        $code{ $cipher[$i] } = $alpha[$i];
    }

    $code{' '} = ' ';

    return \%code;
}

You'll notice that again this is the "final" version, not the basic code that existed in the iterations. That should be obvious from the if statement in the middle there that gives me the structure for a decode OR a encode operation. Which is a feature I added later in the process. Being in a separate method, it had the advantage that I could test it in isolation; which was helpful when I miscoded the solution to decode originally.

In a break from the norm for me; this time I actually made this work from/as a script. So here is my ch-1.pl file:


use strict;
use warnings;

use lib './lib';
use Caesar;

use Getopt::Long;

my ($string,$n,$decode);
GetOptions(
    'string=s' => \$string,
    'n=i'      => \$n,
    'd'        => \$decode,
);

unless ($string && $n) {
    die <<"MESSAGE";

MISSING PARAMS

You need to provide:
 -s "the string to encode goes here"
 -n 3


eg perl ch-1.pl -s "foo bar" -n 3

Which rotates "foo bar" by three characters, returning:
CLL YXO

By default the script will encode, add the -d param to decode.


MESSAGE
}


my $caesar = Caesar->new;

my $text;
if ($decode) {
    $text = $caesar->decode(
        string => $string,
        n      => $n,
    );
} else {
    $text = $caesar->encode(
        string => $string,
        n      => $n,
    );

}
print $text;
print "\n";


Now, just to protect my reputation, yes this is clunky and I am intentionally not coding defensively. I have zero parameter checking anywhere in the code. I do this for fun after all, and consciously choose to not do it "right".

OK with that caveat in place... I did start by just using @ARGV, but wanted to remind myself about how Getopt::Long feels. So using that to manage the inputs, which includes my -d switch. -d is the decode option (Do I get extra credit Mohammad?) so that you can encode and decode messages with this script. I have the module installed, so this is definitely a "Works on my machine" solution.

The last version of the module looks like this:


 t/00-cipher.t  l/Caesar.pm  ch-1.pl                                                                                                                                                         X
package Caesar;

use Moo;

sub encode {
    my ( $self, %args ) = @_;

    my $cipher = $self->_cipher( 'n' => $args{n}, mode => 'encode' );

    my $text;
    my @chars = split "", $args{string};
    for my $char (@chars) {
        $text .= $cipher->{ lc($char) };

    }

    return uc $text;

}

sub decode {
    my ( $self, %args ) = @_;

    my $cipher = $self->_cipher( 'n' => $args{n}, mode => 'decode' );

    my $text;
    my @chars = split "", $args{string};
    for my $char (@chars) {
        $text .= $cipher->{ lc($char) };

    }

    return uc $text;
}

1;

sub _cipher {
    my ( $self, %args ) = @_;

    my @alpha  = (qw/a b c d e f g h i j k l m n o p q r s t u v w x y z/);
    my @cipher = @alpha;

    if ( $args{mode} eq 'decode' ) {

        for ( 1 .. $args{n} ) {
            my $char = pop @cipher;
            unshift @cipher, $char;
        }
    }
    else {
        for ( 1 .. $args{n} ) {
            my $char = shift @cipher;
            push @cipher, $char;
        }

    }

    my %code;
    for my $i ( 0 .. 25 ) {
        $code{ $cipher[$i] } = $alpha[$i];
    }

    $code{' '} = ' ';

    return \%code;
}


And the test file ended up looking like this:


use strict;
use warnings;

use Test2::V0 -target => 'Caesar';

can_ok( $CLASS, 'decode' );

subtest '->encode()' => sub {
    my $S        = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
    my $N        = 3;
    my $expected = "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD";

    my $got = $CLASS->encode(
        string => $S,
        n      => $N,
    );

    is $got, $expected, "'$S' with shift of '$N' should return '$expected'";
};

subtest '->decode()' => sub {
    my $expected = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
    my $N        = 3;
    my $S        = "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD";

    my $got = $CLASS->decode(
        string => $S,
        n      => $N,
    );

    is $got, $expected, "'$S' with shift of '$N' should return '$expected'";
};

subtest '->_cipher(mode => "encode")' => sub {
    my $expected = {
        ' ' => ' ',
        'a' => 'x',
        'b' => 'y',
        'c' => 'z',
        'd' => 'a',
        'e' => 'b',
        'f' => 'c',
        'g' => 'd',
        'h' => 'e',
        'i' => 'f',
        'j' => 'g',
        'k' => 'h',
        'l' => 'i',
        'm' => 'j',
        'n' => 'k',
        'o' => 'l',
        'p' => 'm',
        'q' => 'n',
        'r' => 'o',
        's' => 'p',
        't' => 'q',
        'u' => 'r',
        'v' => 's',
        'w' => 't',
        'x' => 'u',
        'y' => 'v',
        'z' => 'w',
    };

    my $got = $CLASS->_cipher(
        'n'  => 3,
        mode => 'encode'
    );

    is $got, $expected, 'encode mode (shift 3) cipher as expected';

    $expected = {
        ' ' => ' ',
        'a' => 'v',
        'b' => 'w',
        'c' => 'x',
        'd' => 'y',
        'e' => 'z',
        'f' => 'a',
        'g' => 'b',
        'h' => 'c',
        'i' => 'd',
        'j' => 'e',
        'k' => 'f',
        'l' => 'g',
        'm' => 'h',
        'n' => 'i',
        'o' => 'j',
        'p' => 'k',
        'q' => 'l',
        'r' => 'm',
        's' => 'n',
        't' => 'o',
        'u' => 'p',
        'v' => 'q',
        'w' => 'r',
        'x' => 's',
        'y' => 't',
        'z' => 'u',
    };

    $got = $CLASS->_cipher(
        'n'  => 5,
        mode => 'encode'
    );
    is $got, $expected, 'encode mode (shift 5) cipher as expected';

};

subtest '->_cipher(mode => "decode")' => sub {
    my $expected = {
          ' ' => ' ',
          'a' => 'd',
          'b' => 'e',
          'c' => 'f',
          'd' => 'g',
          'e' => 'h',
          'f' => 'i',
          'g' => 'j',
          'h' => 'k',
          'i' => 'l',
          'j' => 'm',
          'k' => 'n',
          'l' => 'o',
          'm' => 'p',
          'n' => 'q',
          'o' => 'r',
          'p' => 's',
          'q' => 't',
          'r' => 'u',
          's' => 'v',
          't' => 'w',
          'u' => 'x',
          'v' => 'y',
          'w' => 'z',
          'x' => 'a',
          'y' => 'b',
          'z' => 'c',
    };

    my $got = $CLASS->_cipher(
        'n'  => 3,
        mode => 'decode'
    );

    is $got, $expected, 'decode mode (shift 3) cipher as expected';

    $expected = {
          ' ' => ' ',
          'a' => 'f',
          'b' => 'g',
          'c' => 'h',
          'd' => 'i',
          'e' => 'j',
          'f' => 'k',
          'g' => 'l',
          'h' => 'm',
          'i' => 'n',
          'j' => 'o',
          'k' => 'p',
          'l' => 'q',
          'm' => 'r',
          'n' => 's',
          'o' => 't',
          'p' => 'u',
          'q' => 'v',
          'r' => 'w',
          's' => 'x',
          't' => 'y',
          'u' => 'z',
          'v' => 'a',
          'w' => 'b',
          'x' => 'c',
          'y' => 'd',
          'z' => 'e',
    };

    $got = $CLASS->_cipher(
        'n'  => 5,
        mode => 'decode'
    );

    is $got, $expected, 'decode mode (shift 5) cipher as expected';

};

done_testing;

I hope if you are reading this that you found it interesting. This is not a particularly sophisticated solution I know. I am sure some of my peers can do this as a one liner. That is not my style. I like simple. This has also only had limited attention applied and zero defensive programming or testing for edge cases. I did refactor a little as I went along, but not with much focus or time investment.

I'd be interested in your approaches and your comments, drop me a message to lance@perl.kiwi or tweet me @perlkiwi.

Perl Weekly Challenge

Tags:

The Perl Weekly Challenge is an amazing project run by Mohammad Anwar that provides coding challenges on a weekly basis; and more importantly a good variety of approaches written up (or shared as video) by developers in Perl and other programming languages.

This week for example the challenges are/were:

TASK #1: Reverse Words

You are given a string $S. Write a script to reverse the order of words in the given string. The string may contain leading/trailing spaces. The string may have more than one space between words in the string. Print the result without leading/trailing spaces and there should be only one space between words.

TASK #2: Edit Distance

You are given two strings $S1 and $S2. Write a script to find out the minimum operations required to convert $S1 into $S2. The operations can be 'insert', 'remove' or 'replace' a character.

Solving the challenge can be a challenge of finding an approach that works, though sometimes they are also simple. When simple I have found it enjoyable and rewarding to use it as a code kata where I might try different approaches or try solving in multiple programming languages.

So this weeks is one of those ones that clicked in my head so here is a small overview of my solution:

Here is the test...

    # t/pw96.t

    use strict;
    use warnings;

    use Test2::V0 -target => 'pw96';

    my $input    = 'The Weekly Challenge';
    my $expected = 'Challenge Weekly The';

    is $CLASS->reverse_words($input),
        $expected,
        'Example one is correct';


    $input    = '    Perl and   Raku are  part of the same family  ';
    $expected = 'family same the of part are Raku and Perl';

    is $CLASS->reverse_words($input),
        $expected,
        'Example two is correct';

    done_testing;

So as I have mentioned in other places, I default to Test2:V0 where possible. It's modern and full featured. It is a solid "Batteries included" testing library. This is a pretty basic set of tests.

Here is the code that followed the tests...

    # lib/pw96.pm

    package pw96;

    use strict;
    use warnings;

    use Moo;

    sub reverse_words {
        my ($self, $phrase) = @_;

        my @words = split ' ', $phrase;
        return join ' ', reverse @words;
    }

    1;

As you can see it's pretty simple; though in fact it's more complex than actually required.

Why?

Because I have another "default setting", I tend to use the Moo module for some object orientation ease. I don't "need" it so technically I am not doing the "simplest thing that works" depending on how you define simple. In the situation of doing this sort task; using a comfortable setup (Test2::V0 and Moo) means consistency which makes it simple over time?

This is more the making things simple to write, rather than writing the simplest thing.

At this stage I should point out that I did TDD this code; so the first thing I wrote was this:

    use Test2:V0 -target => 'pw96';
    done_testing;

The above failed, as I had not created the lib/pw96.pm file. So I created that with a little boiler plate:

    package pw96;
    1;

Which made the test pass. Next I tested for the method I wanted to write add in:

    can_ok($CLASS, 'reverse_words');

After watching that fail, I added this in the module:

    use Moo;
    sub reverse_words{}

All good! After which I added my first practical test (and deleting the can_ok test).

    my $input    = 'The Weekly Challenge';
    my $expected = 'Challenge Weekly The';

    is $CLASS->reverse_words($input),
        $expected,
        'Example one is correct';

After which I wrote the method in a basic way. Once that was working; I refined it to the two line solution. You could take it down a bit more; but where it sits is a nice balance of conciseness and simplicity to read.

So there you have it my solution to this weeks Perl Weekly Challenge.