RabbitFarm

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given an integer. Write a script find out the middle 3-digits of the given integer, if possible, otherwise show a sensible error message.

Solution

use strict;
use warnings;
use POSIX;
sub middle_3{
    my($i) = @_;
    $i = abs($i);
    my $length = length($i);
    return "even number of digits" if $length % 2 == 0;
    return "too short" if $length < 3;
    my $middle = ceil($length / 2);
    return substr($i, $middle - 2, 3);
}

MAIN:{
    print middle_3(1234567) . "\n";
    print middle_3(-123) . "\n";
    print middle_3(1) . "\n";
    print middle_3(10) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
345
123
too short
even number of digits

Notes

Maybe on of the more interesting things about this is just what we consider the middle 3. Truly it only makes sense for an integer with an odd number of digits. But could we have stretched the idea to allow for an even number of digits, perhaps with some left padding? Perhaps, but here we don't. So all integers with only 1 or 2 digits are discarded as are those with an even number of digits. Negative numbers are allowed, but we do not consider the minus sign in determining the middle.

Part 2

You are given 7-characters alphanumeric SEDOL. Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL otherwise 0.

Solution

use strict;
use warnings;
use boolean;

sub is_sedol{
    my($sedol) = @_;
    my $base = substr($sedol, 0, 6);
    my $check_digit = substr($sedol, 6, 1); 
    ##
    # check length
    ##
    return false if length($sedol) != 7;
    ##
    # check for alphanumerics only
    ##
    my $test_base = $base;
    $test_base =~ tr/[0-9][B-Z]//d;
    return false if $test_base;
    ##
    # confirm the check_digit
    ##
    return false if $check_digit != compute_check_digit($base);
    ##
    # all tests passed!
    ##
    return true;
}

sub compute_check_digit{
    my($base) = @_;
    my @chars = split(//, $base);
    my @weights = (1, 3, 1, 7, 3, 9),
    my $sum = 0;
    do{
        my $c = ord(shift @chars);
        if($c >= 66 && $c <= 90){
            $sum += (($c - 64 + 9) * shift @weights);
        }
        if($c >= 48 && $c <= 57){
            $sum += (($c - 48) * shift @weights);
        }
    }while(@chars);
    return (10 - ($sum % 10)) % 10
}

MAIN:{
    print is_sedol(2936921) . "\n";
    print is_sedol(1234567) . "\n";
    print is_sedol("B0YBKL9") . "\n";
}

Sample Run

1
0
1

Notes

The rules around SEDOLs are a bit more complex than this problem lets on. I won't recount them all here, but suffice to say we are dealing with a quite idealized set of validations here. For example, prior to 2004 only numerals were allowed, but since then letters are allowed. But only a numeral can follow a letter. Again, though, those are only rules that apply for a certain time range.

Here we are just checking on length, whether or not the SEDOl contains all numerals and/or (uppercase) letter, and the checksum validation.

References

Challenge 135

Stock Exchange Daily Official List (SEDOL)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given an integer. Write a script find out the middle 3-digits of the given integer, if possible, otherwise show a sensible error message.

Solution

:-initialization(main).

middle_three(N, Middle3):-
    number_chars(N, Chars),
    N > 0,
    length(Chars, Length),  
    Length > 2,
    IsOdd is Length mod 2, IsOdd == 1,
    length(M3, 3),
    PrefixLength is ceiling(Length / 2) - 2,
    length(Prefix, PrefixLength),
    append(Prefix, Middle, Chars),
    append(M3, _, Middle),
    number_chars(Middle3, M3). 

middle_three(N, Middle3):-
    (N < 0, N0 is abs(N), middle_three(N0, Middle3));
    (number_chars(N, Chars), length(Chars, Length), Length < 3, format("too short~n", _));  
    (number_chars(N, Chars), length(Chars, Length), IsOdd is Length mod 2, IsOdd == 0, format("even number of digits~n", _));
    middle_three(N, Middle3). 

main:-
    middle_three(1234567, Middle3),
    ((nonvar(Middle3), format("~d~n", [Middle3]), halt);
    halt).

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
345

Notes

Interestingly this is one of the rare cases where a Prolog solution follows a fairly similar approach a [Perl solution to the same problem0(http://www.rabbitfarm.com/cgi-bin/blosxom/2021/10/24/perl).

Part 2

You are given 7-characters alphanumeric SEDOL. Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL otherwise 0.

Solution

:-initialization(main).

weight(1, 1).
weight(2, 3).
weight(3, 1).
weight(4, 7).
weight(5, 3).
weight(6, 9).

base --> alphanumeric, alphanumeric, alphanumeric, alphanumeric, alphanumeric, alphanumeric.
alphanumeric --> [AlphaNumeric], {letter_or_digit(AlphaNumeric)}.

sedol(Sedol):-
    var(Sedol),
    sedol(_, Sedol).
sedol(Sedol):-
    nonvar(Sedol),
    length(Base, 6),
    append(Base, [CheckDigit], Sedol),
    phrase(base, Base),
    compute_check(Base, ComputedCheckDigit),
    CheckDigit == ComputedCheckDigit.

sedol(Base, Sedol):-
    phrase(base, Base),
    check_digit(Base, Sedol).

letter_or_digit(A):-
    nonvar(A),
    atom_codes(A, C),
    ((C >= 66, C =< 90);
     (C >= 48, C =< 57)).

letter_or_digit(A):-
    var(A),
    ((between(66, 90, C));  %B through Z
     (between(48, 57, C))), %0-9
    atom_codes(A, [C]).

compute_check(Base, CheckSum):-
    compute_check(Base, 1, CheckSum, 0).
compute_check([], _, CheckSum, PartialCheckSum):-
    CheckSum is mod(10 - mod(PartialCheckSum, 10), 10).    
compute_check([H|T], Index, CheckSum, PartialCheckSum):-
    atom_codes(H, [C]),
    between(66, 90, C),
    weight(Index, Weight),
    LetterValue is C - 64 + 9,
    Partial is PartialCheckSum + (LetterValue * Weight),
    succ(Index, I),
    compute_check(T, I, CheckSum, Partial).
compute_check([H|T], Index, CheckSum, PartialCheckSum):-
    atom_codes(H, [C]),
    between(48, 57, C),
    weight(Index, Weight),
    NumeralValue is C - 48,
    Partial is PartialCheckSum + (NumeralValue * Weight),
    succ(Index, I),
    compute_check(T, I, CheckSum, Partial).

check_digit(Base, BaseCheckDigit):-
    compute_check(Base, CheckDigit),
    append(Base, [CheckDigit], BaseCheckDigit).       

main:-
    (sedol(['2','9','3','6','9','2',1]), format("1~n", _);
     format("0~n", _)),
    (sedol(['1','2','3','4','5','6',7]), format("1~n", _);
     format("0~n", _)),
    (sedol(['B','0','Y','B','K','L',9]), format("1~n", _);
     format("0~n", _)),
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2
1
0
1

Notes

I had originally hoped to have all code for this using almost exclusively DCGs. Things got a bit unwieldy with the checksum computation and so I dialed that back a bit, so to speak. Here the DCG part is for validating or generating a SEDOL base 6 digits sequence and the check digit is computed using regular Prolog predicates.

The rules around SEDOLs are a bit more complex than this problem lets on. I won't recount them all here, but suffice to say we are dealing with a quite idealized set of validations here. For example, prior to 2004 only numerals were allowed, but since then letters are allowed. But only a numeral can follow a letter. Again, though, those are only rules that apply for a certain time range.

Here we are just checking on length, whether or not the SEDOl contains all numerals and/or (uppercase) letter, and the checksum validation.

References

Challenge 135

Stock Exchange Daily Official List (SEDOL)