diff options
| author | drbaggy <js5@sanger.ac.uk> | 2022-08-26 22:33:34 +0100 |
|---|---|---|
| committer | drbaggy <js5@sanger.ac.uk> | 2022-08-26 22:33:34 +0100 |
| commit | 307c8dd5ab60c2c8f4dc9d84dfd87999fd475edf (patch) | |
| tree | 6507fbd26a6b4064fc6d1a85d69fe1ebc424b3cc /challenge-178 | |
| parent | 0e2abad9cf792a42a5c2d486de429979b0c147e5 (diff) | |
| download | perlweeklychallenge-club-307c8dd5ab60c2c8f4dc9d84dfd87999fd475edf.tar.gz perlweeklychallenge-club-307c8dd5ab60c2c8f4dc9d84dfd87999fd475edf.tar.bz2 perlweeklychallenge-club-307c8dd5ab60c2c8f4dc9d84dfd87999fd475edf.zip | |
updates
Diffstat (limited to 'challenge-178')
| -rw-r--r-- | challenge-178/james-smith/README.md | 111 | ||||
| -rw-r--r-- | challenge-178/james-smith/perl/ch-1.pl | 1 | ||||
| -rw-r--r-- | challenge-178/james-smith/perl/ch-2.pl | 30 |
3 files changed, 134 insertions, 8 deletions
diff --git a/challenge-178/james-smith/README.md b/challenge-178/james-smith/README.md index 3b736748ea..9872683018 100644 --- a/challenge-178/james-smith/README.md +++ b/challenge-178/james-smith/README.md @@ -1 +1,110 @@ -Solutions by James Smith. +[< Previous 177](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-177/james-smith) | +[Next 179 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-179/james-smith) + +# The Weekly Challenge 178 + +You can find more information about this weeks, and previous weeks challenges at: + + https://theweeklychallenge.org/ + +If you are not already doing the challenge - it is a good place to practise your +**perl** or **raku**. If it is not **perl** or **raku** you develop in - you can +submit solutions in whichever language you feel comfortable with. + +You can find the solutions here on github at: + +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-178/james-smith + +### Note + +Have had a busy week (Coldplay concert and a few days away) - so have concentrated on task 1 this week. + +# Task 1 - Damm Algorithm + +***Write a script to convert a given number (base 10) to quater-imaginary base number and vice-versa.*** + +## Solution + +Our first task is to write two packages one to represent both a complex number and one to create a QIB number. + +### Complex numbers + +This is fairly self-explanatory. We have standard methods, real, imaginary, is_real alons with new and +the overloaded "stringify" function. + +A complex number is represented by a 2 element array. +```perl +package Complex; + +sub new { bless [@_[1,2]], shift } +use overload '""' => sub { "$_[0][0] + $_[0][1] i" }; +sub real { $_[0][0] } +sub imaginary { $_[0][1] } +sub is_real { !$_[0][1] } +sub toQIB { QIB->new_from_Complex( $_[0] ); } + +sub new_from_QIB { + my( $class, $r, $i, $f, @v ) = + ( $_[0], 0, 0, 1, split //, pop->[0] ); + + ## Creates a new complex number from a QIB, computing + ## the real and imaginary parts of the number, which are + ## stored in alterating elements of the string. + $r += $f*pop @v, @v && ($i += $f*pop @v), $f*=-4 while @v; + + ## Create the new object.... + $class->new( $r, $i ); +} +```` + +```perl +use strict; +use warnings; +use feature qw(say state); + +foreach ( -10000 .. 10000 ) { + my $t = Complex->new($_,0); + my $q = $t->toQIB; + my $c = $q->toComplex; + say "$t -> $q -> $c -> ",$c->toQIB if "$t" ne "$c"; +} +```` + +```perl +package QIB; + +sub new { bless [pop], shift } +use overload '""' => sub { $_[0][0] }; +sub value { $_[0][0] } +sub toComplex { Complex->new_from_QIB( $_[0] ) } + +sub new_from_Real { + my $class = shift; + ## Special case where r=0 - value is 0... + return $class->new(0) unless $_[0]; ## Null case! + + ## Lookup (saves a bit of nasty mathes later + state @LOOK = qw(0000 0103 0102 0101 0100 0203 0202 0201 0200 0303 0302 0301 0300 0003 0002 0001); + + ## If +ve we have to remove the last to digits (0) from the end of the string we generate + ## Initial value is -v if v is less than 0 or 4v if v>0; + my ( $re, $n, @Q ) = ( $_[0]>0 ? '..$' : '$', $_[0]<0 ? -shift : 4*shift ); + + ## Strip off all the digit pairs {the reason for the *4 is that the last 2-digits in +ve values + ## become 4 digits... + (push @Q,$n%16), $n>>=4 while $n; ## Now we strip off the digit pairs + + ## We have the values now apply some carries... + for( my $j = my $l = 0; $l < @Q; $j = ++$l ) { ## Now we sort out carries + $Q[$j]-=16, $Q[++$j]++ while $Q[$j]>12; + } + ## And return the string... + return $class->new( join( '', map {$LOOK[$_]} reverse @Q ) =~ s/^0+//r =~ s/$re//r ); +} + +sub new_from_Complex { + my( $class, $c ) = @_; + $class->new( $class->new_from_Real( $c->real )->value + + 10 * $class->new_from_Real( $c->imaginary )->value ); +} +``` diff --git a/challenge-178/james-smith/perl/ch-1.pl b/challenge-178/james-smith/perl/ch-1.pl index 7d236b8e7d..1a8ac55305 100644 --- a/challenge-178/james-smith/perl/ch-1.pl +++ b/challenge-178/james-smith/perl/ch-1.pl @@ -45,6 +45,7 @@ sub toComplex { Complex->new_from_QIB( $_[0] ) } sub new_from_Real { my $class = shift; return $class->new(0) unless $_[0]; ## Null case! + ## state @LOOK = qw(0000 0103 0102 0101 0100 0203 0202 0201 0200 0303 0302 0301 0300 0003 0002 0001); my ( $re, $n, @Q ) = ( $_[0]>0 ? '..$' : '$', $_[0]<0 ? -shift : 4*shift ); diff --git a/challenge-178/james-smith/perl/ch-2.pl b/challenge-178/james-smith/perl/ch-2.pl index 2348c8b946..6e171222c1 100644 --- a/challenge-178/james-smith/perl/ch-2.pl +++ b/challenge-178/james-smith/perl/ch-2.pl @@ -7,16 +7,32 @@ use feature qw(say); use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); +use Time::Local; -my @TESTS = ( - [ 0, 1 ], -); +add_date( '2022-08-16 04:30', 45*3 + 2*9 + 1.25 ); -is( my_function($_->[0]), $_->[1] ) foreach @TESTS; +my @months = (31,31,28,31,30,31,30,31,31,30,31,30,31); -done_testing(); +my @L = (31,31,28,31,30,31,30,31,31,30,31,30,31); -sub my_function { - return 1; +sub add_date { + my ($dur,$yr,$mth, $day,$hr,$min) = (pop,shift =~ m{(\d+)}g); + my $time = timelocal( 0,$min,$hr,$day,$mth-1,$yr); + my $dow = [localtime( $time )]->[6]; + my $weeks = int( $dur / 45 ); + my $days = int( ($dur%45) / 9 ); + my $hours = $dur - $weeks * 45 - $days * 9; + $hr = 9, $min = 0 if $hr < 9; + $hr = 18, $min = 0 if $hr > 18; + if( $hours + $hr > 18 ) { + $hr += int($hours); + $min += 60 * ( $hours - int($hours) ); + $min -= 60, $hr++ if $min > 60; + $min = ` + } + if( $days > 5 - $dow ) { + $dow = $days - 5; $weeks ++; + $row + } } |
