RabbitFarm

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

Part 1

You are given an array of distinct integers. Write a script to find all elements that is neither minimum nor maximum. Return -1 if you can’t.

Solution

not_min_max(Numbers, NotMinMax):-
    min_list(Numbers, Minimum),
    max_list(Numbers, Maximum),
    delete(Numbers, Minimum, NumbersNoMinimum),
    delete(NumbersNoMinimum, Maximum, NumbersNoMinimumNoMaximum),
    ((length(NumbersNoMinimumNoMaximum, 0), NotMinMax = -1), !;
     (NotMinMax = NumbersNoMinimumNoMaximum)).

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- not_min_max([3, 2], NotMinMax).  

NotMinMax = -1

yes
| ?- not_min_max([3, 2, 1, 4], NotMinMax). 

NotMinMax = [3,2]

yes
| ?- not_min_max([1, 3, 2], NotMinMax).

NotMinMax = [2]

yes

Notes

This is about as straightforward a solution as you can get in Prolog. All the details can be handled by built in predicates. That is, finding the minimum and maximum values, removing those values from consideration are all done for us. The only complication comes fromt he stipulation that we should return -1 instead of the empty list. This isn't a very Prolog thing to do! These problems are not written with Prolog in mind, however, and we make it work easily enough anyway.

Part 2

You are given a list of passenger details in the form “9999999999A1122”, where 9 denotes the phone number, A the sex, 1 the age and 2 the seat number. Write a script to return the count of all senior citizens (age >= 60).

Solution

passenger_senior(Passenger, Senior):-
    length(AgeSeat, 4),
    length(Age, 2),
    atom_chars(Passenger, PassengerChars),
    suffix(AgeSeat, PassengerChars),
    prefix(Age, AgeSeat),
    number_chars(A, Age),
    ((A >= 60, Senior = 1); Senior = 0).

count_senior_citizens(Passengers, CountSeniorCitizens):-
    maplist(passenger_senior, Passengers, SeniorCitizens), !,
    sum_list(SeniorCitizens, CountSeniorCitizens).

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- count_senior_citizens(['7868190130M7522', '5303914400F9211', '9273338290F4010'], Count).

Count = 2

(1 ms) yes
| ?- count_senior_citizens(['1313579440F2036', '2921522980M5644'], Count).   

Count = 0

yes
| ?-

Notes

Since the passenger details are given in strings with fixed width fields we can chop up and find what we need using lists. Since the information we seek (the age) is at the end of the passenger details we can work from the suffix. First we get the details as characters, then we get the final four characters. Of these final four the first two are the age.

This is all done by way of maplist/3. Only those passengers that meet the age criteria are given a value of one, the rest zero. The final count is taken via sum_list/2.

References

Challenge 231

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

Part 1

You are given an array of distinct integers. Write a script to find all elements that is neither minimum nor maximum. Return -1 if you can’t.

Solution

use v5.38;
sub not_min_max{
    my($minimum, $maximum);
    do{
        $minimum = $_ if !$minimum || $_ < $minimum;
        $maximum = $_ if !$maximum || $_ > $maximum;
    } for @_;
    my @r = grep { $_ ^ $minimum && $_ ^ $maximum } @_;
    return @r ^ 0 ? @r : -1;
}

MAIN:{
    say join q/, /, not_min_max 3, 2, 1, 4;
    say join q/, /, not_min_max 3, 1;
    say join q/, /, not_min_max 2, 1, 3;
}

Sample Run

$ perl perl/ch-1.pl 
3, 2
-1
2

Notes

Once we find the maximum and minimum values, we need to remove them. Just to be different I used the XOR ^ operator instead of !=. The effect is the same, a false (zero) value is returned if the values are identical, true (one) otherwise.

Part 2

You are given a list of passenger details in the form “9999999999A1122”, where 9 denotes the phone number, A the sex, 1 the age and 2 the seat number. Write a script to return the count of all senior citizens (age >= 60).

Solution

use v5.38;
sub count_senior_citizens{
    my $count = 0;
    do{
        my @a = unpack q/A10A1A2A2/, $_; 
        $count++ if $a[2] >= 60;
    } for @_;
    return $count;
}

MAIN:{
    say count_senior_citizens qw/7868190130M7522 5303914400F9211 9273338290F4010/;
    say count_senior_citizens qw/1313579440F2036 2921522980M5644/;
}

Sample Run

$ perl perl/ch-2.pl 
2
0

Notes

It isn't all that often you find a nice clean use of unpack! This seems to be a very nice opportunity: each passenger string has fixed field lengths.

The passenger strings themselves are just Perl scalar values. They are not, say, specially constructed strings via pack. To unpack an ordinary scalar we can just use As in the template string.

References

pack/unpack Templates

Challenge 231