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

:-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)