PWC 197

PWC 197

I did not attempt the challenges in Julia this time. I have solutions in Perl 5 and Raku.

Challenge 1 (Move Zero)

We are given a list of integers, say (3,0,1,0,5). We are asked to sort the list so that all zeros move to the end, and the remaining items are in their original relative order. In my example, the sorted list would be (3,1,5,0,0).

This is a one-liner in Perl 5 and Raku.

Perl 5:

perl -wl -e 'my @o = sort { ($a == 0) ? 1 : ( ($b == 0) ? -1 : 0 ) } @ARGV; print "@o"' $@

Raku:

raku -e 'say @*ARGS.sort( { ($^a == 0) ?? 1 !! ( ($^b == 0) ?? -1 !! 0 ) } )' $@

The logic is via the block argument to sort. This takes two parameters $a and $b representing two elements in the list being compared. If the comparison returns -1, then $a precedes $b in the sorted list. If the comparison returns 1, then $b precedes $a in the sorted list. If the comparison returns 0, then the order doesn't matter.

The sort pattern here follows this logic:

If both $a and $b are non-zero, they can be in any relative order in the sorted list. Return 0.

If $a is zero, then return 1. In this case, $b should precede $a. (It's fine even if $b is zero too).

If $b is zero and $a is not, then return -1. In this case, $a should precede $b.

This works in recent versions of Perl 5 (I'm not sure how recent), which keep the relative order of $a and $b the same as the original list if 0 is returned. With older versions of Perl 5, the relative order of $a and $b with 0 would be arbitrary, and there's no guarantee that the non-zero items would maintain their original relative order. 

Challenge 2 (Wiggle Sort)

I have not quite solved the problem as specified by our host, and this time I also have not met the test examples. Let me first state the problem I have solved, and then I will state the difference from the specification.

The problem I solved: We are given a list of integers say @list. We are asked to sort them so that $list[0] <= $list[1] >= $list[2] <= $list[3] ... The terms with even-numbered positions in the sorted list are less than or equal to the adjacent terms on both sides with odd-numbered positions (Positions here of course start with 0 as in Perl 5 or Raku).

Our host's specification makes this a strict inequality: $list[0] < $list[1] > $list[2] ... There is no guarantee of a solution in that case (consider for example, a list with all members equal e.g., 1,1,1,1,1,1). Also (like with the weak inequalities), the solution if it exists is not guaranteed to be unique. This makes the test examples less useful, because there are several alternative answers that are as good as the one given.

Coming back to the more general problem that I solved, I first attempted to do it via a block argument to sort as in Challenge 1. I could not achieve this, though I suspect that it should be possible. It is tricky because the comparison of $a and $b depends on their position in the list after it is sorted.

The approach I ended up with was to first sort in descending order, $list[0] >= $list[1] >= $list[2] ... I then swap the elements for each pair of indices (0,1), (2,3), (4,5), ... giving $list[0] <= $list[1] >= $list[2] <= $list[3] ... exactly as we want. Here is my Perl 5 subroutine to do it (with a nested sub-subroutine to do the swapping of elements). The complete Perl 5 script is here.

sub wiggle_sort {
    #-- subsub
    local *wiggle = sub {
        my ($n)=@_;
        ($n+1, $n);
    };

    #-- wiggle_sort root sub
    my @list = @_;
    my @retval;
    
    @list = sort {$b <=> $a} @list;
    
    for (my $i = 0; ($i <= (scalar(@list)-2)); $i += 2) {
        push @retval, @list[&wiggle($i)];    
    }
    (@list % 2) && (push @retval, $list[-1]);
    @retval;
}

Raku is a direct cut-paste-edit translation, except that I moved the nested sub out to a separate subroutine (full Raku code here).

sub wiggle_sort(@list) {
    my @retval;
    
    my @list_ = @list.sort({$^b <=> $^a}).flat;
    
    loop (my $i = 0; ($i <= (@list_.elems)-2); $i += 2) {
        push @retval, (@list_[&wiggle($i)]);    
    }
    (@list_ % 2) && (push @retval, @list_[*-1]);
    @retval.List.flat;
}

#-- subsub
sub wiggle (Int $n) {
    $n+1, $n;
}

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