PWC 195

PWC 195

Challenge 1 (Special integer)

We are given a positive integer n. We are asked to find the number of positive integers between 1 to n inclusive of both ends, i.e., 1 .. $n in Perl- or Raku-speak, such that no digit is repeated in the integer. For example, 11 or 1313 are not okay, but 12 or 1302 are.

After my over-engineered challenge 2 solution last week, brute force seems very appealing, and that is how I go with both challenges this week. I should point out though that in this case, brute force is strictly dominated by a standard analytical formula. We can calculate the number of permutations of the digits 0 .. 9 taken 1 at a time, 2 at a time, 3 at a time, etc. with adjustments to handle the upper bound n. Fellow-contributor Luis Mochan has spelled out the formula in his blog.

In Raku, the brute force solution is a short and sweet one-liner:

raku -e '(1 .. @*ARGS[0]).grep({$_ == $_.comb.unique.join}).elems.say' $@

I tried to translate this to an equivalent Perl 5 one-liner with the help of the List::MoreUtils uniq subroutine. But I gave up fast and ended up with a longer script and a subroutine. Here is the subroutine.

sub special_integers {
    my ($n)=@_;
    my $ctr=0;
    for my $i (1 .. $n) {
        my @n = uniq split(//,$i);
        ($i == join('',@n)) && ($ctr++);
    }
    return $ctr;
} 

I initially thought I would skip Julia this time, but I was able to translate the logic to Julia fast and smoothly. I want to avoid switching between integer and string types in Julia, which is more strongly typed than the Perls. So my test compares the length of the array containing the unique digits to the length of the array containing the repeated digits, i.e., an integer-to-integer comparison. Here it is, using Julia's convenient 'digits' and 'unique' functions.

function special_integers( n::Int64 ) ::Int64
    ctr=0
    for i in 1:n
        if length(digits(i)) == length(unique(digits(i)))
            ctr += 1
        end
    end
    return ctr
end

My Julia script runs in around 1 second for n = 1,000,000. Perl 5 is around 1.8 seconds. Raku is around 13 seconds.

Challenge 2 (Most frequent even)

We are given a list of integers, and asked to find the most frequently occurring even number in the list. If there is a tie, we should report the lowest candidate.

I initially spent some time attempting a one-liner in Raku, but could not resolve some mysterious bugs. So I ended up submitting a vanilla short script. Here is the key subroutine.

sub most-frequent-even (@list) {
    (my @evens = @list.grep(* %% 2)) || (return -1);
    my $max-freq = @evens.Bag.values.max;
    @evens.Bag.pairs.grep({$_.value == $max-freq}).map({$_.key}).min;  
}

We use a bag (an immutable hash that counts frequencies) to get the maximum frequency, then get the lowest bag key that has that frequency as its value.

Here is a one-liner with a slight variation on the logic. This one works fine.

raku -e '@*ARGS.grep(* %% 2).Bag.pairs.sort({($^b.value <=> $^a.value) || ($^a.key <=> $^b.key) }).[0].key.say' 6 4 4 6 1

I translate the logic to Perl 5, which involves the minor extra chore of implementing the bag myself. Here is the subroutine. The 'min' and 'max' operators are imported from List::Util.

sub most_frequent_even {
    my (@list) = @_;
    (my @evens = grep {($_ % 2) == 0} @list )  || (return -1);
#
    my %bag;
    for (@evens) {
        $bag{$_}++;
    }
#
    my $max_freq = max values %bag;
    @evens = grep {$bag{$_} == $max_freq} keys %bag;
    min @evens;
} 

I was thinking of skipping Julia, but I'm glad I didn't. This is very easy to translate to Julia. Julia also has the countmap function which does the same thing as Raku bags. Here is the function.

function most_frequent_even( mylist::Vector{Int64} ) ::Int64
    evens = mylist[mylist .% 2 .== 0]
#
    if length(evens)==0
        return -1
    end
#
    d_freq = countmap(evens) #-- a dictionary (hash)
    max_freq=maximum(values(d_freq))
    retval = Vector{Int64}()
#
    for i in keys(d_freq)
        if d_freq[i] == max_freq
            push!(retval, i)
        end
    end
#
    return minimum(retval)     
end

Here is the bad Raku one-liner with mysterious bugs. It sometimes gave the right answer and sometimes a wrong one for the same input. For example, I just ran it twice, getting 6 [wrong] the first time, and 4 [right] the second time. Possibly some compiler confusion with the overloaded '*' character, or $_ might be interpreted in some unexpected way.

#WARNING: THIS DOES NOT WORK
raku -e 'say (my @sublist=@*ARGS.grep(* %% 2)) ?? @sublist.Bag.pairs.sort({$_.value})[*-1].sort({$_.key})[0].key !! -1' 6 4 4 6 1
 
Links
Perl    Raku    Julia 



 

Comments

Post a Comment

Popular posts from this blog

PWC 258

PWC 258 Last week (#257) I finished challenge 2 and my blog post for challenge 257 late last week, so had only submitted challenge 1. Here is my blog post for PWC 257 , including the full code for my challenge 2 solution. This week, I have done both challenges in perl 4.019 on DOSBOX. Both scripts also work fine on the latest Perl 5.38. I also did the challenges in Raku, where they are one-liners.  Challenge 1 (Count Even Digits Number) We are given a list of integers, and asked to count the number of elements whose base-10 representation has an even number of digits. In Raku , this is a one-liner. Here it is: raku -e 'say +@*ARGS.grep({$_.chars %% 2})' $@ It could be a one-liner in Perl 4 too, but since I run it on DOSBOX, my script would not be a bash shell script. Here is the short subroutine that does the job.  sub count_even_digits {  scalar( grep( ((length($_) % 2) == 0), @_) ); } The full code is here . Challenge 2 (Sum of values) We are given an integer k  and a list in
Read more

PWC 249

PWC 249 Challenge 1 (Equal pairs) We are given a list of integers with an even number of elements. We are asked to check if the list can be completely divided into sub-lists of size 2 with each sub-list containing the same integer repeated, like say (2,2). If so, we are asked to return the list of such sub-lists. This is straightforward in Perl 5. I use modern conveniences this time, though it could be done using only primitive Perl 4 syntax. Here is my subroutine. It returns a list of array references. local *equal_pairs = sub {     #-- return () if input is of odd length     ((scalar(@_) % 2) > 0) && (return ());          #-- count number of occurrences of each element using a hash     local %_ = ();     map {$_{$_}++} @_;          #-- if any element occurs an odd number of times, return ()     (grep {($_{$_} % 2) > 0} keys %_) && (return ());          #-- loop thru %_ keys, returning pairs of such keys     map {         my $k=$_;         my $num_pairs=( ($_{$k}
Read more

PWC 253

PWC 253 I do both challenges this week using old software on DOSBOX: perl 4.019, and for comparison, also python 1.4 beta. My solutions also work on the current versions of Perl 5 (5.38) and Python 2 (2.7.18) respectively. Challenge 1 (Split Strings) Links to code: perl4.019 python1.4b We are given a list of strings, and a single character say sep . We are asked to return the list, with the strings split into component substrings using sep as a separator. We should not include any empty strings in the output. In perl 4, I first stick a backslash in front of the separator character, so that it is escaped if entered in a regex. This is because the perl split function takes a regex as its first argument indicating the separator. If we have a character like '$' or ',', we want to escape it so that it is read literally when parsing the regex. Here is the key subroutine:   sub split_strings {  local ($separator, @words)=@_;  local (@retval)=(); #array to be returned  #  #--
Read more