RabbitFarm

2022-12-18

The Weekly Challenge 195 (Prolog Solutions)

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

Part 1

You are given a positive integer, $n > 0. Write a script to print the count of all special integers between 1 and $n.

Solution


code2digit(C, D):-
    number_codes(D, [C]).

special(N):-
    number_codes(N, NCodes),
    maplist(code2digit, NCodes, Digits),
    sort(Digits, DigitsSorted),
    length(Digits, NumberDigits),
    length(DigitsSorted, NumberDigits).

number_special(N, NumberSpecial):-
    findall(I, (between(1, N, I), special(I)), Specials),
    length(Specials, NumberSpecial). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- number_special(15, NumberSpecial).

NumberSpecial = 14

(1 ms) yes
| ?- number_special(35, NumberSpecial).

NumberSpecial = 32

(1 ms) yes
| ?- 

Notes

The definition of a special integer for this problem is an integer whose digits are unique. To determine this specialness we split the number into its digits using number_codes/2 and a maplist/3 which uses a small helper predicate to convert the codes back to the corresponding digit.

After getting set with identifying special integers all the is left is to count up all the ones found in the given range.

Part 2

You are given a list of numbers, @list. Write a script to find most frequent even numbers in the list. In case you get more than one even numbers then return the smallest even integer. For all other case, return -1.

Solution


even(N, Even):-
    (0 is mod(N, 2), Even = N);
    (Even = nil).

frequency(ListNumbers, N, Frequency):-
    delete(ListNumbers, N, ListDeleted),
    length(ListNumbers, L),
    length(ListDeleted, LD),
    Frequency is L - LD. 

most_frequent_even(ListNumbers, MostFrequentEven):-
    maplist(even, ListNumbers, EN),
    delete(EN, nil, EvenNumbers), 
    length(EvenNumbers, LengthEvens),
    LengthEvens > 0,
    maplist(frequency(ListNumbers), EvenNumbers, Frequencies),      
    msort(Frequencies, FS), 
    reverse(FS, FrequenciesSorted), 
    ((
         nth(1, FrequenciesSorted, F1),
         nth(2, FrequenciesSorted, F2), 
         F1 \== F2,
         nth(N, Frequencies, F1),  
         nth(N, EvenNumbers, MostFrequentEven)  
     );
     (
         nth(1, FrequenciesSorted, F1),
         nth(2, FrequenciesSorted, F2), 
         F1 == F2,
         findall(MFE, (member(FX, FrequenciesSorted), FX == F1, nth(N, Frequencies, FX), nth(N, EvenNumbers, MFE)), MostFrequentEvens),   
         sort(MostFrequentEvens, MostFrequentEvensSorted), 
         nth(1, MostFrequentEvensSorted, MostFrequentEven)
     ) 
    ), !.

most_frequent_even(_, MostFrequentEven):-
    MostFrequentEven = -1, !. 

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- most_frequent_even([1, 1, 2, 6, 2], MostFrequentEven).

MostFrequentEven = 2

yes
| ?- most_frequent_even([1, 3, 5, 7], MostFrequentEven).   

MostFrequentEven = -1

yes
| ?- most_frequent_even([6, 4, 4, 6, 1], MostFrequentEven).

MostFrequentEven = 4

yes
| ?- 

Notes

The code here may look a bit more convoluted than it really is. Well my use of the disjunction in most_frequent/2 may only be against my own personal sense of aesthetics! Also, in balance the use of maplist/3 cleans things up a bit.

The main ideas here are:

  1. Remove all odd numbers and check to see if any numbers remain.

  2. Compute the frequency of each remaining even number.

  3. Sort and see if there is a tie for most frequent.

  4. If there is no tie in (3) then we're done in the first part of the disjunction. Otherwise, in the second part of the disjunction, find the smallest of the numbers tied for most frequent.

References

Challenge 195

posted at: 16:05 by: Adam Russell | path: /prolog | permanent link to this entry

Especially Frequent Even

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

Part 1

You are given a positive integer, $n > 0. Write a script to print the count of all special integers between 1 and $n.

Solution


use v5.36;
use boolean;  
sub is_special{
    my($x) = @_;
    my %h; 
    my @digits = split(//, $x);
    map{ $h{$_} = undef } @digits; 
    return keys %h == @digits; 
}

MAIN:{
    say q// . grep{ is_special($_) } 1 .. $ARGV[0];  
}

Sample Run


$ perl perl/ch-1.pl 15
14
$ perl perl/ch-1.pl 35
32

Notes

The definition of a special integer for this problem is an integer whose digits are unique. To determine this specialness we define is_special() which splits any given number into an array of digits. Each of the digits are added to a hash as the keys. If any digits are not unique then they will not be duplicated as a hash key and the test will return false.

Once is_special() is set all we need to do is to map over the given range and count up the results!

Part 2

You are given a list of numbers, @list. Write a script to find most frequent even numbers in the list. In case you get more than one even numbers then return the smallest even integer. For all other case, return -1.

Solution


use v5.36;
sub most_frequent_even{
    my @list = @_;
    @list = grep { $_ % 2 == 0 } @list; 
    return -1 if @list == 0;  
    my %frequencies;
    map { $frequencies{$_}++ } @list;
    my @sorted = sort { $frequencies{$b} <=> $frequencies{$a} } @list; 
    return $sorted[0] if $frequencies{$sorted[0]} != $frequencies{$sorted[1]};   
    my @tied = grep { $frequencies{$_} == $frequencies{$sorted[0]} } @list;
    return (sort { $a <=> $b } @tied)[0];       
}

MAIN:{
    my @list;
    @list = (1, 1, 2, 6, 2); 
    say most_frequent_even(@list);    
    @list = (1, 3, 5, 7); 
    say most_frequent_even(@list);    
    @list = (6, 4, 4, 6, 1); 
    say most_frequent_even(@list);    
}

Sample Run


$ perl perl/ch-2.pl
2
-1
4

Notes

map and grep really do a lot to make this solution pretty succinct. First grep is used to extract just the even numbers. Then map is used to count up the frequencies. In the case of ties grep is used to identify the numbers with a tied frequency. The tied numbers are then sorted with the lowest one being returned, as specified.

References

Challenge 195

posted at: 00:53 by: Adam Russell | path: /perl | permanent link to this entry