PWC 257

PWC 257

I finished late this week, so I just submitted Challenge 1. But I finished Challenge 2 later without submitting it to github and will just post the entire code on this blog. I did both challenges in perl 4.019 on DOSBOX. For challenge 1, I also did it in python 1.4 beta on DOSBOX. Challenge 2 I only attempted in Perl. My solutions work in current versions of perl 5 (5.38) and python 2, though with warnings of the deprecated perl 4 package separator when I run challenge 2 in perl 5. 

Challenge 1 (Smaller than current)

We are given a list of integers ints say. We are asked to return a list of numbers giving at each index i the count of how many elements in ints are less than the element at ints[i].

Here is the perl 4 subroutine [link to github]:

sub smaller_than_current {
 local(@ints)=@_;
 local(@ranks)=(sort {$ints[$a]<=>$ints[$b];} 0..$#ints);
 local($i,@retval);
 
 $retval[$ranks[0]]=0;
 foreach $i (1 .. $#ranks){
  if ($ints[$ranks[$i]]==$ints[$ranks[$i-1]]) {
   $retval[$ranks[$i]]=$retval[$ranks[$i-1]];
  }
  else {
   $retval[$ranks[$i]]=$i;
  }
 }
 @retval;
}

We use sort with a custom function to rank the indices of ints in ascending order of the element at that index. This rank is the same as the number of int elements less than the element at that index, except that we need to make a minor adjustment for ties

Here is the almost direct translation to python [link to github]:

def smaller_than_current( intuple ):
 ranks=[]
 for i in range(len(intuple)):
  ranks.append((intuple[i],i))
 ranks.sort()
 ranks=map(lambda x:x[1], ranks)
 retval=[None]*len(intuple)
 retval[ranks[0]]=0
 for i in range(1,len(ranks)):
  if intuple[ranks[i]]==intuple[ranks[i-1]]:
   retval[ranks[i]]=retval[ranks[i-1]]
  else:
   retval[ranks[i]]=i
 return retval

Challenge 2 (Reduced Row Echelon)

We are given a matrix and asked to ascertain if it is in "reduced row echelon" form. If it is:

  1. The first non-zero element (if any) of each row is 1. Let us call it the leading 1,
  2. The column in which the leading 1 occurs has all other elements equal to zero.
  3. The leading 1 in any row is to the right of the leading 1 in the previous row.
  4. All-zero rows (if any) are all at the bottom of the matrix.

I  use a home-made perl 4 matrix package called mtrx to conjure up some convenience functions: to read in a matrix (as hash) from a string, to return the row or the column of a matrix, and to give the number of rows. I then create the key subroutine is_rre to check for reduced row echelon format. It loops through rows and columns applying the criteria.

Here is the entire listing, since it is not on github.

#CH-2.PL
#perl 4.019 on DOSBOX

sub reduced_row_echelon {
 local(%mtrx)=&mtrx'new(@_);
 &mtrx'is_rre(%mtrx);
}

print &reduced_row_echelon("[1,1,0;0,1,0;0,0,0]"),"\n"; #0
print &reduced_row_echelon("[0,1,-2,0,1;0,0,0,1,3;0,0,0,0,0;0,0,0,0,0]"),"\n"; #1
print &reduced_row_echelon("[1,0,0,4; 0,1,0,7; 0,0,1,-1]"),"\n"; #1
print &reduced_row_echelon("[0,1,-2,0,1; 0,0,0,0,0; 0,0,0,1,3; 0,0,0,0,0]"),"\n"; #0
print &reduced_row_echelon("[0,1,0; 1,0,0; 0,0,0]"),"\n"; #0
print &reduced_row_echelon("[4,0,0,0; 0,1,0,7; 0,0,1,-1]"),"\n"; #0

package mtrx;

sub new {
 #read matrix (assoc array) from string
 #of form "[#,#..;#,#]" (matlab style)
 local($new)=@_;
 $new =~ /^\[(.+)\]$/;
 local(@new)=split(/;/,$1);
 local($r,$c); #index thru rows and columns respectively
 local(@row); #temp variable to hold each row
 local(%new); #return value
 foreach $r (0 .. $#new) {
  @row=split(/,/,$new[$r]);
  foreach $c (0 .. $#row) {
    $new{join(",",($c,$r))}=$row[$c];
  }
 }
 %new;
}

sub col {
 #return column indexed c as array
 local( $c, %mtrx )=@_;
 local( @c ) = grep( /^$c,/, keys %mtrx );
 @c = sort {(split(/,/,$a))[1] <=> (split(/,/,$b))[1];} @c;
 @mtrx{@c};
}

sub row {
 #return row indexed r as array
 local( $r, %mtrx )=@_;
 local( @r ) = grep( /,$r$/, keys %mtrx);
 @r = sort {(split(/,/,$a))[0] <=> (split(/,/,$b))[0];} @r;
 @mtrx{@r};
}

sub nrow {
 #return number of rows in column c
 local( $c, %mtrx)=@_;
 local(@col)=&col($c, %mtrx);
 scalar(@col);
}

sub is_rre {
 #check if reduced row echelon
 local(%mtrx)=@_;
 local(@leading_1, $r, $c, @row, @col);
 ROW: foreach $r (0 .. &nrow(0,%mtrx)-1) {
  @row=&row($r,%mtrx);
  $leading_1[$r] = (scalar(@row)+1);
  COL: foreach $c (0 .. $#row) {
   next COL if ($row[$c]==0);
   next ROW if ($leading_1[$r] < (scalar(@row)+1) );
   (return 0) if ($row[$c] != 1);
   $leading_1[$r]=$c;
   (return 0) if ( ($r > 0) && ($leading_1[$r-1] >= $c) );
   @col=&col($c,%mtrx);
   ( scalar(grep($_==0,@col)) < (scalar(@col)-1) ) && (return 0);
  }
 }
 return 1;
}

My mtrx package allows the matrix to be irregular in shape (rows and columns could have varying lengths). Strictly speaking, I should have an additional check in is_rre to make sure that the input matrix is regular in shape. I haven't bothered with this chore.

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