PWC 192

PWC 192

Challenge 1 (Binary flip)

We are given an integer. We are asked to convert it to its binary representation, and then flip the bits, that is, 1 becomes 0, and 0 becomes 1. From the examples, it is clear that we do not flip leading zeros in the binary representation: i.e., 010 flips to 001, not 101.

It is easier to do this in Perl (5 or 6) with string-handling operators rather than bit operators. One first uses sprintf("%b",...) to represent the integer as a string version of its binary form. Then one applies the tr (transliterate) operator on this string to replace [01] with [10]. Then stick a '0b' in front of the resulting string, and call eval on the result to magically make it an integer.

Here is my Perl 5 subroutine:

sub binary_flip  {
    my $b=sprintf("%b",shift);
    $b =~ tr/[10]/[01]/;
    eval('0b' . $b);
}

Here is the direct port to Raku:

sub binary-flip (Int $n) {
    my $b=sprintf("%b",$n);
    $b ~~ tr/<[1 0]>/<[0 1]>/;
    +('0b' ~ $b);
}

The brackets are not really needed for the search and replace character classes. 

Again I was too busy this week to do a Julia solution for either challenge. Let me point to a Julia solution from Robert diCicco.

Challenge 2 (Equal distribution)

We are given a list of integers, say (1,2,3,4,5). We are asked to convert it, if possible, to a list where:

  1. The sum of the entries is the same as that in the original list (15 in my example). 
  2. Every entry in the solution list is the same number (3,3,3,3,3 in my example).

We are asked to find the number of moves to transform the original list to the solution. If no solution is possible (that is, the sum is not divisible by the number of elements), then we return -1.

To move from the original list to the solution, we are restricted to the following operations, performed only one at a time:

  1. We can move 1 from an entry to an adjacent entry on either the left or the right. That is, we decrement the entry we are moving from by 1, and increment the entry we are moving to by 1.
  2. We cannot move more than 1 in a single move.
  3. We cannot move 1 to a non-adjacent cell directly, i.e., from $list[$n], we can move 1 only to $list[$n+1] or $list[$n-1].

This looks a bit like the well-known Tower of Hanoi puzzle. By rough analogy with Tower of Hanoi and by experimenting with some different orderings of the (1,2,3,4,5) list, I came up with the following iterative strategy:

  1. Move 1 from the biggest entry in the list (5 in my example) to the smallest entry in the list (1 in my example), by passing it along the numbers in-between (which would take 4 moves in my example). The number of moves to do so is the distance between the biggest and smallest numbers, or the number of elements between them.
  2. In case there are multiple maxima and minima, move between the pair which are nearest to each other.
  3. Repeat until we have a solution.

In my example @list=(1,2,3,4,5):

We first move 1 from 5 ($list[4]) to 1 ($list[0]) via the intermediate elements: 4 moves.

We now have @list=(2,2,3,4,4).

Following our algorithm, we move 1 from $list[3] to $list[1]: 2 more moves. We now have @list=(2,3,3,3,4). 

Finally, we move 1 from $list[4] to $list[0]: 4 more moves. We now have our solution: (3,3,3,3,3). It took 10 moves.

I was not sure that this is the optimal (least-number-of-moves) strategy (though more on this later in this post). In any case, it gives the correct answers for all the test examples, and the task specification does not demand the optimal number of moves. 

To implement it in Perl 5, I use a subroutine equal_distribution with nested helper sub-subroutines to do things like find the indices of the maxima and minima, and compute the closest (min,max) pair. Except for calls to List::Util functions, I stick to Perl 4 syntax. (This is purely in a playful and doing-something-different spirit, and I do not mean at all to disrespect contrary best-practice guidelines). 

My Raku script is a direct translation from the Perl 5. I could not do it in Julia this time. But here is a Julia solution from Robert diCicco.

Fellow-contributor Jo S has derived a formula to find the number of moves. It's not quite closed-form but should be very fast to compute even with big data, with tools such as PDL or Julia (or List::Util). This is as follows:

  1. Compute an array S where each element of S is the cumulative sum of the elements of the source array up to that point. In my initial example of (1,2,3,4,5) we have S=(1,3,6,10,15). 
  2. Compute an array E where each element of E is the cumulative sum of the elements in the final solution. In my initial example where the final solution is (3,3,3,3,3), we have E=(3,6,9,12,15). 
  3. Compute an array ABSDIFF where each element is the absolute difference between the corresponding elements of S and E. In my initial example, we have: ABSDIFF=(2,3,3,2,0). 
  4. The number of moves needed say N is then the sum of the elements of ABSDIFF. In my example, 2+3+3+2+0=10.

Fellow-contributor James Smith has an intuitive explanation of why this works (derived independently from Jo S). 

Jo S also shows that any strategy that avoids unnecessary regressive moves will complete in N moves, so this is the optimal number of moves (other strategies are of course worse). My strategy seems to qualify as optimal, but not uniquely so. 

My program surprisingly runs 10x faster than Jo S's (their script runs in ~0.13 seconds on my hardware while mine runs in ~0.013 seconds). But this is just because of my faster startup due to the minimalist syntax. If I run the scripts on the more demanding input (70000,3,6,4,5,2,1) [solution is  210,000], my script takes ~0.5 seconds, while Jo S's still runs in ~0.13 seconds. This is of course because of my less efficient algorithm, but it's also because I depend on slow interpreted loops, while Jo S uses efficient List::Util routines such as the reductions operator.  List::Util looks like it's becoming a really useful bag of array-programming tricks, comparable to PDL or even better.

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