Perl Weekly Challenge 367: overlapping intervals
This post presents my solutions to the Perl Weekly Challenge 367.I keep doing the Perl Weekly Challenge in order to mantain my coding skills in good shape, as well as in order to learn new things, with particular regard to Raku, a language that I love.
This week, I solved the following tasks:
- PWC 367 - Task 1 - Raku
- PWC 367 - Task 2 - Raku
- PWC 367 - Task 1 in PostgreSQL PL/Perl
- PWC 367 - Task 2 in PostgreSQL PL/Perl
Raku Implementations
PWC 367 - Task 1 - Raku Implementation
Given a binary string, provide the highest number (in binary format) that represents an odd value.sub MAIN( Str $binary where { $binary ~~ / ^ <[01]>+ $ / && $binary ~~ / 1+ / } ) {
my ( $ones, $zeros ) = $binary.comb.grep( * ~~ 1 ).elems,
$binary.comb.grep( * ~~ 0 ).elems;
$ones--;
say '1' x $ones ~ '0' x $zeros ~ '1';
}
I count how many
$ones and $zeros there are in the string, since we need an odd value, the string must end with a one, so I have less ones to insert in the leftmost part of the string.
Since the leftmost digits are those that provide the highest number, I place all but one 1 on the left, then I concatenate the zeros, then add a last one.
PWC 367 - Task 2 - Raku Implementation
Given a begin/end times for two events, see if there is an overlapping in time.sub MAIN( *@times where { @times.elems == 4 && @times.grep( * ~~ / ^ \d ** 2 ':' \d ** 2 $ / ).elems == 4 } ) {
my @first;
my @second;
for 0 .. 1 {
@first.push: @times[ $_ ].split( ':' ).map( *.Int )[ 0 ] * 60
+ @times[ $_ ].split( ':' ).map( *.Int )[ 1 ];
}
for 2 .. 3 {
@second.push: @times[ $_ ].split( ':' ).map( *.Int )[ 0 ] * 60
+ @times[ $_ ].split( ':' ).map( *.Int )[ 1 ];
}
'True'.say and exit if ( @second[ 0 ] - @first[ 1 ] < 0 || @second[ 1 ] - @first[ 0 ] < 0 );
'False'.say;
}
I convert all the times in minutes, so that I’ve two arrays
@first with starting and ending minutes, and @second the same.
If the second event starts before the ending of the first one, or viceversa, there is overlapping.
PL/Perl Implementations
PWC 367 - Task 1 - PL/Perl Implementation
Same implementation as in Raku.CREATE OR REPLACE FUNCTION
pwc367.task1_plperl( text )
RETURNS text
AS $CODE$
my ( $binary ) = @_;
my ( $ones, $zeros ) = ( scalar ( grep { $_ == 1 } split //, $binary ),
scalar ( grep { $_ == 0 } split //, $binary ) );
$ones--;
return '1' x $ones . '0' x $zeros . '1';
$CODE$
LANGUAGE plperl;
PWC 367 - Task 2 - PL/Perl Implementation
Same approach as in Raku implementation.CREATE OR REPLACE FUNCTION
pwc367.task2_plperl( text[] )
RETURNS boolean
AS $CODE$
my ( $times ) = @_;
my @first;
my @second;
for ( 0 .. 1 ) {
my @pieces = split /:/, $times->[ $_ ];
push @first, $pieces[ 0 ] * 60 + $pieces[ 1 ];
}
for ( 2 .. 3 ) {
my @pieces = split /:/, $times->[ $_ ];
push @second, $pieces[ 0 ] * 60 + $pieces[ 1 ];
}
return 1 if ( $second[ 0 ] - $first[ 1 ] < 0 || $second[ 1 ] - $first[ 0 ] < 0 );
return 0;
$CODE$
LANGUAGE plperl;