PWC 228

PWC 228

Challenge 1 (Unique Sum)

We are given an array of integers, and asked to return the sum of only those elements that are unique, i.e., skipping any elements that are repeated.

I use a single pass through the array, adding elements as I go, and also counting their frequency with a hash. If the frequency hits 2, then I subtract the element from the running total, and thereafter ignore any further repetitions. I use the ( a ? b : c ) conditional expression.

Here is the subroutine:

 sub unique_sum {
    my @int = @_;
    
    #-- %int : hash to count frequency of each element of @int,
    #-- $retval : return value
    my (%int, $retval);
    
    #initialize %int values, $retval, to zero
    $retval=0;
    map {$int{$_}=0} @int;
    
    #-- loop thru' @int counting frequencies and updating $retval
    map {
        $int{$_}++;
        
        ($int{$_} > 1) ?
            ( ($int{$_} == 2)  ? ($retval -= $_) : 1 )
            : ($retval += $_);  
    }  @int;
    $retval;
}

Challenge 2 (Empty array)

We are given an array of unique integers. Then we take the first element in the array. If it is the minimum element, we remove it (shift). Otherwise, we move it to the end of the array (shift then push). Repeat until the array is empty. We are asked to return how many steps this will take.

Since we just need to return the count rather than run through the procedure directly, we can note that if the minimum element is at position x (indexed from 0), then we need x+1 steps to take this element out (x steps to move the preceding elements, and 1 more step to shift the minimum element). For example, if the array is [3,4,2], we need 3 steps to reduce it to [3,4] (The element 2 is at position 2, so 2+1 steps to remove the element 2). 

We can now repeat the calculation with the reduced array. We need a further 1 step (index 0 + 1) to get rid of 3, and reduce to [4]. And so on (one more step to empty the array).

Here is the subroutine:

sub empty_array {
    my @int=@_;
    my $retval=0; #-- return value
    
    #-- assuming unique ints
    #-- skipping input validation chores
    
    my %indx;
    #-- %indx: index of each element
 
    my @int_sorted = sort {$a <=> $b} @int;   
    
    while (scalar @int) {
        map {
            $indx{$int[$_]} = $_;     
        } 0 .. $#int;
    
        $retval += $indx{$int_sorted[0]} + 1;
    
        splice(@int,$indx{$int_sorted[0]},1);
        shift(@int_sorted);
    }
    
    $retval;
}


Comments

Post a Comment

Popular posts from this blog

PWC 227

PWC 227 Challenge 1 (Friday 13th) This challenge requires us to count the number of times Friday 13th occurs in a particular year. I use Date::Manip. This module probably has easier ways to do this using a Date Range, but my approach is easy enough. My &friday_13th subroutine takes the year as input, throws an exception if it is outside the specified range (1753 to 9999), and then cycles through the 13th of each month, counting the Fridays. use Date::Manip; my $dateobj=Date::Manip::Date->new(); sub friday_13th {     my ($year)=@_;     my $retval=0;     ( ($year > 9999) || ($year < 1753) ) &&         die "Year should be between 1753 and 9999";     map {         ( ($dateobj->new_date("$year-$_-13")->printf('%w') ) == 5 ) &&             $retval++;     }     1 .. 12;          $retval; }   Challenge 2 (Roman Maths) This challenge requires us to implement a calculator that parses infix math operations using roman numerals.  There
Read more

PWC 234

PWC 234 I tried to restrict to Perl 4 syntax for both challenges this week, as documented in Rex Swain's Perl 4 reference or the 1st edition of Programming perl. I do use nested subroutines, which I am not sure would actually work in Perl 4, though they comply with the syntax. My programs are tested on Perl 5.38. (The -l in the shebang line works only in Perl 5. The Perl 4 equivalent was -L012 in Unix, which is no longer available.) As I have mentioned before, my aims in using the old syntax are just mild nostalgia plus to add a bit of additional challenge to the task. I know that this is not the most efficient or idiomatic way to do things today. But I should observe that it is really cool that I am able to write code using 30-year old syntax, and run it unmodified on the latest Perl 5.38. You cannot do this with Python 3 for example. This very deep backward compatibility is one of those unsung underappreciated beauties of Perl 5. In my opinion, it is a very cool thing 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