aboutsummaryrefslogtreecommitdiff
path: root/challenge-178
diff options
context:
space:
mode:
authordrbaggy <js5@sanger.ac.uk>2022-08-26 22:33:34 +0100
committerdrbaggy <js5@sanger.ac.uk>2022-08-26 22:33:34 +0100
commit307c8dd5ab60c2c8f4dc9d84dfd87999fd475edf (patch)
tree6507fbd26a6b4064fc6d1a85d69fe1ebc424b3cc /challenge-178
parent0e2abad9cf792a42a5c2d486de429979b0c147e5 (diff)
downloadperlweeklychallenge-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.md111
-rw-r--r--challenge-178/james-smith/perl/ch-1.pl1
-rw-r--r--challenge-178/james-smith/perl/ch-2.pl30
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
+ }
}