From 21ad6d798917678bdb9eff34f2a458dadf15dd60 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:34:13 +0000 Subject: Update README.md --- challenge-136/james-smith/README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/challenge-136/james-smith/README.md b/challenge-136/james-smith/README.md index 3fa420f2e3..8842778f33 100644 --- a/challenge-136/james-smith/README.md +++ b/challenge-136/james-smith/README.md @@ -1,5 +1,8 @@ # Perl Weekly Challenge #136 +

[< Previous 135](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-135/james-smith) | +[Next 137 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-137/james-smith)

+ You can find more information about this weeks, and previous weeks challenges at: https://theweeklychallenge.org/ -- cgit From 661c9de67be505faacfa0017e0dec7bdbbedc881 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:34:29 +0000 Subject: Update README.md --- challenge-136/james-smith/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-136/james-smith/README.md b/challenge-136/james-smith/README.md index 8842778f33..e51779dfb4 100644 --- a/challenge-136/james-smith/README.md +++ b/challenge-136/james-smith/README.md @@ -1,7 +1,7 @@ # Perl Weekly Challenge #136 -

[< Previous 135](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-135/james-smith) | -[Next 137 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-137/james-smith)

+[< Previous 135](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-135/james-smith) | +[Next 137 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-137/james-smith) You can find more information about this weeks, and previous weeks challenges at: -- cgit From e37ecac58f493871f9efea468ae6b977b908133d Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:35:41 +0000 Subject: Update README.md --- challenge-136/james-smith/README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/challenge-136/james-smith/README.md b/challenge-136/james-smith/README.md index e51779dfb4..742f1c6c9e 100644 --- a/challenge-136/james-smith/README.md +++ b/challenge-136/james-smith/README.md @@ -1,8 +1,9 @@ -# Perl Weekly Challenge #136 - [< Previous 135](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-135/james-smith) | [Next 137 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-137/james-smith) +# Perl Weekly Challenge #136 + + You can find more information about this weeks, and previous weeks challenges at: https://theweeklychallenge.org/ -- cgit From bb1c91a70a444a8da786788ee36d7486a71961fa Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:36:09 +0000 Subject: Update README.md --- challenge-137/james-smith/README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/challenge-137/james-smith/README.md b/challenge-137/james-smith/README.md index 9bdd58ce27..bb01232ab2 100644 --- a/challenge-137/james-smith/README.md +++ b/challenge-137/james-smith/README.md @@ -1,3 +1,6 @@ +[< Previous 136](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-136/james-smith) | +[Next 138 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-138/james-smith) + # Perl Weekly Challenge #137 You can find more information about this weeks, and previous weeks challenges at: -- cgit From 40d11b3b75607061aca9f5dcfb9e2c0f3484cd12 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:37:02 +0000 Subject: Update README.md --- challenge-138/james-smith/README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/challenge-138/james-smith/README.md b/challenge-138/james-smith/README.md index fa191ce639..a83432cddb 100644 --- a/challenge-138/james-smith/README.md +++ b/challenge-138/james-smith/README.md @@ -1,3 +1,6 @@ +[< Previous 137](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-137/james-smith) | +[Next 139 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-139/james-smith) + # Perl Weekly Challenge #138 You can find more information about this weeks, and previous weeks challenges at: -- cgit From 5fbbfdaf4efc3965c167852bfb4b8623b7df68cd Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:37:34 +0000 Subject: Update README.md --- challenge-139/james-smith/README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/challenge-139/james-smith/README.md b/challenge-139/james-smith/README.md index 12cbf5c99d..4997590fe9 100644 --- a/challenge-139/james-smith/README.md +++ b/challenge-139/james-smith/README.md @@ -1,3 +1,6 @@ +[< Previous 138](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-138/james-smith) | +[Next 140 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-140/james-smith) + # Perl Weekly Challenge #139 - "Whats recurring" You can find more information about this weeks, and previous weeks challenges at: -- cgit From 81d7f4e5661592f225ca66fcd457a72fef27aa1d Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:37:59 +0000 Subject: Update README.md --- challenge-140/james-smith/README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/challenge-140/james-smith/README.md b/challenge-140/james-smith/README.md index ed48cd9b3e..c80fdc8c5e 100644 --- a/challenge-140/james-smith/README.md +++ b/challenge-140/james-smith/README.md @@ -1,3 +1,6 @@ +[< Previous 139](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-139/james-smith) | +[Next 141 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-141/james-smith) + # Perl Weekly Challenge #140 You can find more information about this weeks, and previous weeks challenges at: -- cgit From 945a7afe100e6f841746c0400bd194953a066a78 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 26 Nov 2021 12:38:17 +0000 Subject: Update README.md --- challenge-138/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-138/james-smith/README.md b/challenge-138/james-smith/README.md index a83432cddb..81fcfca2be 100644 --- a/challenge-138/james-smith/README.md +++ b/challenge-138/james-smith/README.md @@ -17,7 +17,7 @@ https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-138/ja # Task 1 - Workdays -***Write a script to calculate the total number of workdays in the given year. (Monday to Friday) +***Write a script to calculate the total number of workdays in the given year. (Monday to Friday)*** ## Notes -- cgit From 5d92143764fb5c8fce90edd16f6938a8470622b3 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 29 Nov 2021 07:12:59 +0000 Subject: links in blogs < & > --- challenge-111/james-smith/perl/ch-1.pl | 50 ++++++++++++++------- challenge-111/james-smith/perl/ch-2.pl | 46 ++++++++++++++++++- challenge-113/james-smith/perl/BinaryTree.pm | 66 ++++++++++++++++++++++++++-- challenge-113/james-smith/perl/ch-2.pl | 42 +++++++++++++----- challenge-115/james-smith/perl/ch-1.pl | 3 +- challenge-115/james-smith/perl/ch-2.pl | 27 +++++++++++- challenge-121/james-smith/perl/ch-2.pl | 2 +- challenge-125/james-smith/perl/BinaryTree.pm | 10 ++--- challenge-126/james-smith/perl/ch-1.pl | 1 + challenge-130/james-smith/perl/ch-1.pl | 24 +++++++++- challenge-131/james-smith/perl/ch-2.pl | 35 ++++++++++----- challenge-133/james-smith/c/ch-2.c | 30 ++++++------- challenge-136/james-smith/perl/ch-1.pl | 3 ++ challenge-136/james-smith/perl/ch-2.pl | 10 ++--- challenge-137/james-smith/perl/ch-2.pl | 16 +++---- challenge-140/james-smith/perl/ch-1.pl | 12 +++-- challenge-140/james-smith/perl/ch-2.pl | 17 +++---- 17 files changed, 298 insertions(+), 96 deletions(-) diff --git a/challenge-111/james-smith/perl/ch-1.pl b/challenge-111/james-smith/perl/ch-1.pl index 927633a2c0..4e3efa32ed 100644 --- a/challenge-111/james-smith/perl/ch-1.pl +++ b/challenge-111/james-smith/perl/ch-1.pl @@ -87,29 +87,44 @@ my %TEST_SET = map { $_ => 0 } (my @KEYS = -10..60); $TEST_SET{$_} = 1 foreach map { @{$_} } @{$matrix}; +sub search_rows { + my($row,$val,$mat)=(0,@_); + return 0 if $val > $mat->[-1]->[-1]; + $row++ while ($val > $mat->[$row]->[-1]); + return 1 if ( $val == $mat->[$row]->[0] + || $val == $mat->[$row]->[1] + || $val == $mat->[$row]->[2] + || $val == $mat->[$row]->[3] + || $val == $mat->[$row]->[4] ); + return 0; +} + + my $tests = { - 'Search' => sub { find_val_search ( $_, $matrix ) foreach @KEYS; }, - 'GrepGrep' => sub { find_val_grep_grep( $_, $matrix ) foreach @KEYS; }, - 'GrepMap' => sub { find_val_grep_map( $_, $matrix ) foreach @KEYS; }, - 'GrepExt' => sub { find_val_grep_grep_ext( $_, $matrix ) foreach @KEYS; }, - 'Flatten' => sub { flatten( $_, $matrix ) foreach @KEYS; }, + 'SR' => sub { search_rows ( $_, $matrix ) foreach @KEYS; }, +# 'Search' => sub { find_val_search ( $_, $matrix ) foreach @KEYS; }, +# 'GrepGrep' => sub { find_val_grep_grep( $_, $matrix ) foreach @KEYS; }, +# 'GrepMap' => sub { find_val_grep_map( $_, $matrix ) foreach @KEYS; }, +# 'GrepExt' => sub { find_val_grep_grep_ext( $_, $matrix ) foreach @KEYS; }, +# 'Flatten' => sub { flatten( $_, $matrix ) foreach @KEYS; }, 'DNF' => sub { find_val_dnf( $_, $matrix ) foreach @KEYS; }, 'DNFOpt' => sub { find_val_dnf_optimal( $_, $matrix ) foreach @KEYS; }, - 'DNFGen' => sub { find_val_general_dnf( $_, $matrix ) foreach @KEYS; }, - 'Binary' => sub { find_val_binary( $_, $matrix ) foreach @KEYS; }, - - 'Hash' => sub { find_val_hash( $_, $matrix ) foreach @KEYS; }, - 'Flatten@' => sub { flatten_array( $_, @M ) foreach @KEYS; }, - - 'ListUtil' => sub { find_val_list_util( $_, $matrix ) foreach @KEYS; }, - 'AnyAny' => sub { find_val_any_any( $_, $matrix ) foreach @KEYS; }, - 'AANaive' => sub { find_val_any_any_naive( $_, $matrix ) foreach @KEYS; }, - - 'preHash' => sub { find_val_hash_pre( $_, $H ) foreach @KEYS; }, - 'preGrep' => sub { find_val_grep_pre( $_, $A ) foreach @KEYS; }, +# 'DNFGen' => sub { find_val_general_dnf( $_, $matrix ) foreach @KEYS; }, +# 'Binary' => sub { find_val_binary( $_, $matrix ) foreach @KEYS; }, + +# 'Hash' => sub { find_val_hash( $_, $matrix ) foreach @KEYS; }, +# 'Flatten@' => sub { flatten_array( $_, @M ) foreach @KEYS; }, + +# 'ListUtil' => sub { find_val_list_util( $_, $matrix ) foreach @KEYS; }, +# 'AnyAny' => sub { find_val_any_any( $_, $matrix ) foreach @KEYS; }, +# 'AANaive' => sub { find_val_any_any_naive( $_, $matrix ) foreach @KEYS; }, +# +# 'preHash' => sub { find_val_hash_pre( $_, $H ) foreach @KEYS; }, +# 'preGrep' => sub { find_val_grep_pre( $_, $A ) foreach @KEYS; }, }; +=cut is( find_val_binary( 35, $matrix ), 0 ); is( find_val_binary( 39, $matrix ), 1 ); is( find_val_binary( $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS; @@ -155,6 +170,7 @@ is( find_val_general_dnf( $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS; done_testing(); +=cut cmpthese( $N, $tests ); sub find_val_grep_grep_ext { diff --git a/challenge-111/james-smith/perl/ch-2.pl b/challenge-111/james-smith/perl/ch-2.pl index 2671043056..232ee7fc1f 100644 --- a/challenge-111/james-smith/perl/ch-2.pl +++ b/challenge-111/james-smith/perl/ch-2.pl @@ -4,6 +4,7 @@ use strict; use warnings; use feature qw(say); +use Benchmark qw(timethese cmpthese); ## Ubuntu supplies a number of different dictionaries ## I have installed all four of the english (UK) @@ -20,16 +21,59 @@ use feature qw(say); ## insane: 654,299 427,891 ## +#foreach (1..10) { +#say longest_u( '/usr/share/dict/british-english-small' ); +#say longest_u( '/usr/share/dict/british-english-large' ); +#say longest_u( '/usr/share/dict/british-english-huge' ); +#say longest_u( '/usr/share/dict/british-english-insane' ); +#} +# +cmpthese( 10,{ + 's' => sub { say longest( '/usr/share/dict/british-english-small' ); say longest( '/usr/share/dict/british-english-large' ); say longest( '/usr/share/dict/british-english-huge' ); say longest( '/usr/share/dict/british-english-insane' ); - +}, + 'u' => sub { +say longest_u( '/usr/share/dict/british-english-small' ); +say longest_u( '/usr/share/dict/british-english-large' ); +say longest_u( '/usr/share/dict/british-english-huge' ); +say longest_u( '/usr/share/dict/british-english-insane' ); +}, +}); #say longest_no_comments( '/usr/share/dict/british-english-small' ); #say longest_no_comments( '/usr/share/dict/british-english-large' ); #say longest_no_comments( '/usr/share/dict/british-english-huge' ); #say longest_no_comments( '/usr/share/dict/british-english-insane' ); +sub longest_u { + open my $fh, q(<), $_[0]; + my @max = (0); + (chomp) ## Remove newline character + #&& !/\W/ ## Remove words with non-alpha chars + && !/[^a-z]/ ## Remove words starting with a capital + && ( $max[0] <= length $_ ) + ## Remove words that are too short + && ( $_ eq join q(), sort unpack '(A)*' ) + ## Check the word is unchanged when the + ## letters are sorted + && ( $max[0] == length $_ + ? ( push @max, $_ ) + : ( @max = (length $_, $_) ) + ) + ## If the word is the same length as the maximal word + ## push it onto @max - so we store all the longest words + ## with maximum length. + ## If the word is longer than the max length (1st entry + ## in @max - reset max to include the new max length and + ## the word. + while <$fh>; + return "$_[0] > @max"; + ## Return the name of the file used, the size of the words + ## and a complete list of the words of that length. +} + sub longest { open my $fh, q(<), $_[0]; my @max = (0); diff --git a/challenge-113/james-smith/perl/BinaryTree.pm b/challenge-113/james-smith/perl/BinaryTree.pm index e28307765a..711dde9039 100644 --- a/challenge-113/james-smith/perl/BinaryTree.pm +++ b/challenge-113/james-smith/perl/BinaryTree.pm @@ -64,19 +64,67 @@ sub add_child_right { return $self; } +## Define walk method.... sub walk { + my $self = shift; + $self->walk_pre( @_ ); + return; +} + +## +## Pre-order walk process node then the left and right sub-trees +## + +sub walk_pre { + my( $self, $fn, $global, $local, $dir ) = @_; + $local = $fn->( $self, $global, $local, $dir||'' ); + $self->left->walk_pre( $fn, $global, $local, 'left' ) if $self->has_left; + $self->right->walk_pre( $fn, $global, $local, 'right' ) if $self->has_right; + return; +} + +## +## In-order walk process left sub-tree, then the node and finally the right sub-tree +## + +sub walk_in { + my( $self, $fn, $global, $local, $dir ) = @_; + $self->left->walk_in( $fn, $global, $local, 'left' ) if $self->has_left; + $local = $fn->( $self, $global, $local, $dir||'' ); + $self->right->walk_in( $fn, $global, $local, 'right' ) if $self->has_right; + return; +} + +## +## Reverse-order walk process right sub-tree, then the node and finally the left sub-tree +## + +sub walk_reverse { my( $self, $fn, $global, $local, $dir ) = @_; + $self->right->walk_reverse( $fn, $global, $local, 'right' ) if $self->has_right; + $local = $fn->( $self, $global, $local, $dir||'' ); + $self->left->walk_reverse( $fn, $global, $local, 'left' ) if $self->has_left; + return; +} + +## +## Post-order walk the left and right subtrees before processing the node... +## + +sub walk_post { + my( $self, $fn, $global, $local, $dir ) = @_; + $self->left->walk_post( $fn, $global, $local, 'left' ) if $self->has_left; + $self->right->walk_post( $fn, $global, $local, 'right' ) if $self->has_right; $local = $fn->( $self, $global, $local, $dir||'' ); - $self->left->walk( $fn, $global, $local, 'left' ) if $self->has_left; - $self->right->walk( $fn, $global, $local, 'right' ) if $self->has_right; return; } sub flatten { - my( $self,$dump_fn ) = @_; + my( $self,$dump_fn, $method ) = @_; $dump_fn ||= sub { $_[0] }; + $method = $self->can( 'walk_'.($method||'pre') ) || 'walk'; my $arrayref = []; - $self->walk( sub { + $self->$method( sub { my($node,$global) = @_; push @{$global}, $dump_fn->( $node->value ); }, $arrayref ); @@ -95,6 +143,16 @@ sub dump { } sub clone { + my( $self, $clone_fn ) = @_; + $self->walk_post( sub { my ($node, $global, $local, $dir ) = @_ + my $new_node = BinaryTree->new( $clone_fn( $node->value ) ); + $new_node->add_child_left( $self->left->walk_post( $node, $global ) ) if $self->has_left; + $new_node->add_child_right( $self->right->walk_post( $node, $global ) ) if $self->has_right; + return $new_node; + }); + return +} +sub clonez { my( $self, $clone_fn ) = @_; $clone_fn ||= sub { $_[0] }; my $clone = {}; diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl index bb453db985..cbc18d00fe 100644 --- a/challenge-113/james-smith/perl/ch-2.pl +++ b/challenge-113/james-smith/perl/ch-2.pl @@ -89,31 +89,51 @@ $x = BinaryTree->new(1) $y; say ' +======================================================================== + +BinaryTree.pm +============= + Now using the binary specific code - with clone/dump/flatten methods added into the class implemented by walk - '; say 'Dump $x'; $x->dump; say ''; -say 'Clone $x as $y'; -$y = $x->clone; -say 'Dump $y (clone of $x)'; -$y->dump; -say ''; -say 'Now get total value and adjust each node... for $y'; +say 'Now get total value'; my $glob = { 'total' => 0 }; -$y->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->value; }, $glob ); -$y->walk( sub { my( $node, $global ) = @_; $node->update( $global->{'total'} - $node->value ); }, $glob ); +$x->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->value; }, $glob ); +say ' TOTAL is ',$glob->{'total'}; +say ''; +## Clone x into y -> but with the value as total - value' +say 'Clone $x as $y - and set value as "total" - value'; +$y = $x->clone( sub { $glob->{'total'} - $_[0]; } ); say ''; say 'Dump $y (clone of $x)'; $y->dump; -say ''; +say ' +------------------------------------------------------------------------ +'; +say "@{[ $x->flatten ]}"; +say "@{[ $y->flatten ]}"; +say ' +Dump in different orders: +'; +say "Pre-order @{[ $x->flatten( undef, 'pre' ) ]}"; +say "In order @{[ $x->flatten( undef, 'in' ) ]}"; +say "Reverse order @{[ $x->flatten( undef, 'reverse' ) ]}"; +say "Post order @{[ $x->flatten( undef, 'post' ) ]}"; +say ' +------------------------------------------------------------------------ +'; say 'Running tests'; is( "@{[ $x->flatten ]}", '1 2 4 7 3 5 6' ); is( "@{[ $y->flatten ]}", '27 26 24 21 25 23 22' ); done_testing(); -say ''; +say ' +======================================================================== + +'; diff --git a/challenge-115/james-smith/perl/ch-1.pl b/challenge-115/james-smith/perl/ch-1.pl index df88d84a2c..a3410a80ac 100644 --- a/challenge-115/james-smith/perl/ch-1.pl +++ b/challenge-115/james-smith/perl/ch-1.pl @@ -23,12 +23,13 @@ my @examples = ( #); @examples = ( [ [qw(pk fz iy oz cf xm gm uy ur te ct zz rw jm aq oq xy mi me rv jc iv sx pq lz nd cm vj uf rq ij zk ef wm bb cj vv oo og ft fq mj os uh gn ml mz fm az yr zh wa bm gj xn df yf er xc xb bl uw ri nq nn oi pc ym jr da rz bq vm sr ni jz po oj wf iu ja tu lk yt nc sl wi zb hm uv th kn hk pv yq ez we im gt za sj nh qr bt rr ok ai xx qs lg ue fc ws vc vy ki xi wy fv lt rl xw nj gu dz ip zl je pf hn uk di mv ug vf uz wt yn qx rh sz fh pm sa qz gp gw jp ve le fe ia nw pu km uo gy li pe hj mn ew hg qg se mq by vh ca hd bn nl xu dd ji bd ol vp wp yo st ac bh bx fa md zx mm ox qi mc lc jx wz jd xt vr yj pn uj zy ih ul pb id xh wb qq xg ou sp bo yz bu ec vz fy io hl jo cl zs ge tz qp mf zf kq sk qw as vs rm jw yk tr cw tk xz kt ra qo tj fu dy hx ic ej nt jt gf ko rd od ep qn sg ek ui bg iw zm at dv fx kb xr nu xl xs lr xk na ne xe rt jf ga hv kf xq sq pt cp rj fr fp qf gg ii ey tn ce ya kl wc ks qh em gc ts dn wk is fo pa sd ly uc zn dk wq bw tq kg xf vn ea hh ik lm nr wd kc mu ru co kx nb gl fs bi hu fk ld qa qy qm wl cn cr zd ke jl gz wr xp tm tl kj no ex wj su dc sh ee hf dw ax ms hq jj sb ed qj vw ha ju wx yi sf ln jy rx ei sy ar dm hr al ah mb on ob uq ps lv ad jk rb fb gk cc rp jq ka my ix nv re vk tp zw rg tb up pp uu ds ho zv nf ty cu kp eg in lu hy mk um zt hc qt yp tv rk hb pj ph bk af to lq qe ib gi bz jh iz lo yv ci jg gh yx bj il cz gx ro ff kk vd ub et bs tw si qd ql au ti xj yh yl kr om nx lw wo gs gq ku mw py tx ll fl xd ch rc go dt lx zu ry hz bc lj la lh ux sc fn it ir tt mo pr gd sm mx jn cd vl vb mt pz vt he eh ss dh dj yw xv be ov wh ww pg ao es ye xa vq hs yc yd vu ns zr lf rs pl cs eo zi qb qk so oc wn el zc yb de mg fw cx cv wv ot cb qu wu nm ow zp rn hw lp ma en vg cy rf tc am ut cq sv kv oh jb np us ck mh ny gr gb op an kw aa vo zq iq ba px dr un or ze bp zg eb ud if dl dq zj ky bf vi cg ua br yu mp bv sn pi db ae of kh pd hp qc jv xo du fg ta do kd dx av ys tg ls fi kz tf eu aj sw vx oa pw fd ab hi va lb dg ig dp nz js qv ag aw eq mr zo yy ie nk yg ap oe gv oy ht ev ak td ay fj ng wg)], 1 ], ); +pop @examples; is(circ_single_connected(@{$_->[0]}),$_->[1]) foreach @examples; is(circ_single(@{$_->[0]}),$_->[1]) foreach @examples; done_testing(); -cmpthese( 400, { +cmpthese( 10000, { nr => sub { circ_single_connected(@{$_->[0]}) foreach @examples; }, r => sub { circ_single(@{$_->[0]}) foreach @examples; }, } ); diff --git a/challenge-115/james-smith/perl/ch-2.pl b/challenge-115/james-smith/perl/ch-2.pl index ba5bed2831..2c8878ba1e 100644 --- a/challenge-115/james-smith/perl/ch-2.pl +++ b/challenge-115/james-smith/perl/ch-2.pl @@ -5,6 +5,8 @@ use strict; use warnings; use feature qw(say); use Test::More; +use Data::Dumper qw(Dumper); +use Benchmark qw(cmpthese); my @TESTS = ( [[qw(4 1 7 6)], 7614], @@ -16,7 +18,16 @@ my @TESTS = ( [[qw(2 4 6 8)], 8642], ); -is( biggest_even( $_->[0] ), $_->[1] ) foreach @TESTS; +is( biggest_even( $_->[0] ), $_->[1] ) foreach @TESTS; +is( biggest_even_short( $_->[0] ), $_->[1] ) foreach @TESTS; +is( biggest_even_local( $_->[0] ), $_->[1] ) foreach @TESTS; +done_testing(); + +cmpthese(100_000,{ + 's' => sub { biggest_even_short( $_->[0] ) foreach @TESTS; }, + 'n' => sub { biggest_even( $_->[0] ) foreach @TESTS; }, + 'l' => sub { biggest_even_local( $_->[0] ) foreach @TESTS; }, +}); sub biggest_even { my $ptr = my @digits = reverse sort @{$_[0]}; @@ -36,3 +47,17 @@ sub biggest_even { return ''; } + +sub biggest_even_short { + my $T = my @T = reverse sort @{$_[0]}; + $T[$T]&1 || return join '',@T[0..$T-1,$T+1..$#T,$T] while $T--; + return ''; +} + + +sub biggest_even_local { + local $_ = @_ = reverse sort @{$_[0]}; + $_[$_]&1 || return join '',@_[0..$_-1,$_+1..$#_,$_] while $_--; + return ''; +} + diff --git a/challenge-121/james-smith/perl/ch-2.pl b/challenge-121/james-smith/perl/ch-2.pl index 6b67d6d78a..d00016f6c5 100644 --- a/challenge-121/james-smith/perl/ch-2.pl +++ b/challenge-121/james-smith/perl/ch-2.pl @@ -23,7 +23,7 @@ if(@ARGV) { $N = shift @ARGV; $dist_maps = []; foreach my $r (0..$N-1) { - $dist_maps->[$r][$_] = $r == $_ ? 0 : int rand(20) foreach 0..$N-1; + $dist_maps->[$r][$_] = $r == $_ ? 0 : 1+int rand(20) foreach 0..$N-1; } } $comb*=$_ foreach 2..($N-1); diff --git a/challenge-125/james-smith/perl/BinaryTree.pm b/challenge-125/james-smith/perl/BinaryTree.pm index 05703c9b26..9363849bbf 100644 --- a/challenge-125/james-smith/perl/BinaryTree.pm +++ b/challenge-125/james-smith/perl/BinaryTree.pm @@ -21,12 +21,12 @@ sub new { bless $self, $class; } -sub depth { +sub max_length { my $self = shift; my $d = 0; - $d = $self->left->depth if $self->has_left; + $d = $self->left->max_length if $self->has_left; return 1+$d unless $self->has_right; - my $t = $self->right->depth; + my $t = $self->right->max_length; return $t > $d ? 1+$t : 1+$d; } @@ -34,8 +34,8 @@ sub diameter { my $self = shift; my $global = { 'diameter' => 0 }; $self->walk( sub { - my $d = ($_[0]->has_left ? $_[0]->left->depth : 0 ) + - ($_[0]->has_right ? $_[0]->right->depth : 0 ); + my $d = ($_[0]->has_left ? $_[0]->left->max_length : 0 ) + + ($_[0]->has_right ? $_[0]->right->max_length : 0 ); $_[1]{'diameter'} = $d if $d > $_[1]->{'diameter'}; }, $global ); return $global->{'diameter'}; diff --git a/challenge-126/james-smith/perl/ch-1.pl b/challenge-126/james-smith/perl/ch-1.pl index a42ad642c7..5e519c5822 100644 --- a/challenge-126/james-smith/perl/ch-1.pl +++ b/challenge-126/james-smith/perl/ch-1.pl @@ -8,6 +8,7 @@ use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); +timethis( 2_000_000, sub { get_no_one_count_9( 0xFFFFFFFFFFFFFFFF ); } );exit; my @TESTS = ( [ 15, 8 ], [ 25, 13 ], diff --git a/challenge-130/james-smith/perl/ch-1.pl b/challenge-130/james-smith/perl/ch-1.pl index a1c4b5280e..eab6f82ddb 100644 --- a/challenge-130/james-smith/perl/ch-1.pl +++ b/challenge-130/james-smith/perl/ch-1.pl @@ -13,13 +13,33 @@ my @TESTS = ( [ [1, 2, 3, 4, 3, 2, 1, 4, 4], 4 ], ); -is( find_odd($_->[0]), $_->[1] ) foreach @TESTS; +is( find_odd_not($_->[0]), $_->[1] ) foreach @TESTS; +is( find_odd_xor($_->[0]), $_->[1] ) foreach @TESTS; +is( find_odd_sum($_->[0]), $_->[1] ) foreach @TESTS; + +cmpthese(100_000,{ + 'sum' => sub { find_odd_sum( $_->[0] ) foreach @TESTS; }, + 'xor' => sub { find_odd_xor( $_->[0] ) foreach @TESTS; }, + 'not' => sub { find_odd_not( $_->[0] ) foreach @TESTS; }, +}); done_testing(); -sub find_odd { +sub find_odd_sum { + my %x; + $x{$_}++ foreach @{$_[0]}; + return ( grep { $x{$_} & 1 } keys %x )[0]; +} + +sub find_odd_xor { my %x; $x{$_}^=1 foreach @{$_[0]}; return ( grep { $x{$_} } keys %x )[0]; } +sub find_odd_not { + my %x; + $x{$_} = !$x{$_} foreach @{$_[0]}; + return ( grep { $x{$_} } keys %x )[0]; +} + diff --git a/challenge-131/james-smith/perl/ch-2.pl b/challenge-131/james-smith/perl/ch-2.pl index 5af21335e2..86096aac26 100644 --- a/challenge-131/james-smith/perl/ch-2.pl +++ b/challenge-131/james-smith/perl/ch-2.pl @@ -8,20 +8,33 @@ use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); -my @TESTS = ( - [ [ '""[]()', '"I like (parens) and the Apple ][+" they said.' ], [ '"(["','")]"' ] ], - [ [ '**//<>', '/* This is a comment (in some languages) */ ' ], [ '/**/<','/**/>' ] ], +my @player_ages = ( + [20, "Alex" ], + [28, "Joe" ], + [38, "Mike" ], + [18, "Alex" ], + [25, "David" ], + [18, "Simon" ], ); +my @player_names = ( + ["Alex", "Stewart"], + ["Joe", "Root" ], + ["Mike", "Gatting"], + ["Joe", "Blog" ], + ["Alex", "Jones" ], + ["Simon","Duane" ], +); -is( join( ' - ', find_pairs( @{$_->[0]})), join( ' - ', @{$_->[1]} ) ) foreach @TESTS; - -done_testing(); +my $MAX = @ARGV ? $ARGV[0] : 4; -sub find_pairs { - map { join '', $_[1] =~m{$_}g } - map { '['.quotemeta( $_ ).']' } - map { join '', $_[0] =~ /$_/g } - qr((.).?), qr(.(.?)); +my @res; +while( my @pns = splice @player_names, 0, $MAX ) { + my %cache = (); + push @{$cache{$_->[0]}},$_->[1] foreach @pns; + foreach my $p (@player_ages) { + push @res, [$p->[0], $p->[1], $_] foreach @{$cache{$p->[1]}}; + } } +printf "%4d\t%-20s\t%-20s\n", @{$_} foreach @res; diff --git a/challenge-133/james-smith/c/ch-2.c b/challenge-133/james-smith/c/ch-2.c index 19b76857e3..e5b3bc0752 100644 --- a/challenge-133/james-smith/c/ch-2.c +++ b/challenge-133/james-smith/c/ch-2.c @@ -8,8 +8,8 @@ // #define MAX_N 1000000 // #define PSIZE 42000 // Have to guess this! // 10^8 - #define MAX_N 100000000 - #define PSIZE 3200000 // Have to guess this! + #define MAX_N 10000 + #define PSIZE 5000 // Have to guess this! // 10^9 //#define MAX_N 1000000000 //#define PSIZE 28000000 // Have to guess this! @@ -29,19 +29,20 @@ int sum_digits(int n) { } // Get the sum of prime factors - -// as we build this in order we only need to find a -// factorisation then we just add together the -// digit sum of the two factors (Here for speed we -// know one will be prime. -// We go through all primes we have until prime^2 -// is greater than the number itself. // -// To make the last bit easier IF we have a prime -// we return 0 as not composite... +// as we build this in order we only need to find a factorisation then +// we just add together the digit sum of the two factors (Here for +// speed we know one will be prime. // -// Note to save memory we only store the sum if -// n < MAX_N/2 as we won't need it again (can't -// be a factor of a larger number less than MAX_N +// We go through all primes we have until prime^2 is greater than the +// number itself. +// +// To make the last bit easier IF we have a prime we return 0 as not +// composite... +// +// Note to save memory we only store the sum if // n < MAX_N/2 as we +// won't need it again (can't be a factor of a larger number less than +// MAX_N ) int sum_prime_factors( int n ) { int p; @@ -63,8 +64,7 @@ int sum_prime_factors( int n ) { return 0; } -// Main is simple just loop and search, printing out -// Smith numbers +// Main is simple just loop and search, printing out Smith numbers int main() { int count = 0, n = 1; while( n++ <= MAX_N ) { diff --git a/challenge-136/james-smith/perl/ch-1.pl b/challenge-136/james-smith/perl/ch-1.pl index 3638053bc6..d686187e24 100644 --- a/challenge-136/james-smith/perl/ch-1.pl +++ b/challenge-136/james-smith/perl/ch-1.pl @@ -9,6 +9,8 @@ use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); my @TESTS = ( + [ [1000001,9991], 0 ], + [ [1000000,9991], 0 ], [ [31,96], 0 ], [ [8,24], 1 ], [ [26,39], 0 ], @@ -21,6 +23,7 @@ done_testing(); sub friendly { my($a,$b) = @_; + return 0 if 1 & ($a | $b); ($a,$b) = ($b,$a%$b) while $b; ## Get GCD return 0 if $a == 1; ## Numbers are co-prime so not friendly $a>>=1 until $a&1; ## Remove trailing binary 0 digits diff --git a/challenge-136/james-smith/perl/ch-2.pl b/challenge-136/james-smith/perl/ch-2.pl index be1466063e..78d9777777 100644 --- a/challenge-136/james-smith/perl/ch-2.pl +++ b/challenge-136/james-smith/perl/ch-2.pl @@ -30,11 +30,11 @@ sub fib_sum { sub sum { local $_; - my ( $t, @n) = @_; - return 1 unless $t; - return 0 if $t < 0; - my $c = 0; + my( $t, @n ) = @_; + return 1 unless $t; ## Return 1 - as we have a combination which totals to $n; + return 0 if $t < 0; ## Return 0 - we've gone past $n - so no combinations + my $c = 0; ## We now have to sum up all combinations $c += sum( $t-$_, @n ) while $_ = shift @n; - return $c; + return $c; ## And return the sum; } diff --git a/challenge-137/james-smith/perl/ch-2.pl b/challenge-137/james-smith/perl/ch-2.pl index 12637c00b5..54be96fd59 100644 --- a/challenge-137/james-smith/perl/ch-2.pl +++ b/challenge-137/james-smith/perl/ch-2.pl @@ -9,7 +9,7 @@ use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); my $MAX = 1e9; -my $S_MAX = 1e6; +my $S_MAX = 1e7; my $MULT = 100; my $COUNT = 500; my @TESTS = ( @@ -63,9 +63,9 @@ sub lychrel_large_seed { use Time::HiRes qw(time); my $time = time; -print "Simple:"; +print "\n\nSimple:"; print " $_" for grep { lychrel $_ } 10..1000; -print "** time ", time - $time; +print "\n\n** time ", time - $time; foreach my $n (10..$S_MAX) { if( defined $seeds{$n} ) { @@ -74,15 +74,15 @@ foreach my $n (10..$S_MAX) { } $lychrel{$n}=1 if lychrel_large_seed($n); } -print "\nSieve: "; +print "\n\nSieve: "; print join " ", sort { $a <=> $b } keys %lychrel; -print "** time ", time - $time; +print "\n\n** time ", time - $time; print "\n\n"; - +exit; $time = time; -print "\nLarge: "; +print "\n\nLarge: "; print " $_" for grep { lychrel_large $_ } 10..$S_MAX; -print "** time ", time - $time; +print "\n\n** time ", time - $time; print "\n\n"; $time = time; diff --git a/challenge-140/james-smith/perl/ch-1.pl b/challenge-140/james-smith/perl/ch-1.pl index 9483b8e9bb..7d83ccee5b 100644 --- a/challenge-140/james-smith/perl/ch-1.pl +++ b/challenge-140/james-smith/perl/ch-1.pl @@ -14,13 +14,17 @@ my @TESTS = ( [ [ 100, 11 ] , 111 ], ); +my Tie $x, 'DecBin'; +my Tie $y, 'DecBin'; +my Tie $z, 'DecBin'; + foreach(@TESTS) { - my $x = DecBin->new($_->[0][0]); - my $y = DecBin->new($_->[0][1]); - my $z = DecBin->new($_->[1]); + $x = $_->[0][0]; + $y = $_->[0][1]; + $z = $_->[1]; say join "\t", $x, $y, $x+$y, $z, $x+$y==$z ? 'OK' : 'FAIL'; } - +exit; foreach(@TESTS) { my $x = DecBinExp->new($_->[0][0]); my $y = DecBinExp->new($_->[0][1]); diff --git a/challenge-140/james-smith/perl/ch-2.pl b/challenge-140/james-smith/perl/ch-2.pl index dc99f6ad04..c37be1e0cf 100644 --- a/challenge-140/james-smith/perl/ch-2.pl +++ b/challenge-140/james-smith/perl/ch-2.pl @@ -24,18 +24,15 @@ is( get_num_exp(@{$_->[0]}), $_->[1] ) for @TESTS; done_testing(); sub get_num { - my($i,$j,$k,$t,%h) = @_; - $t=$_, map { $h{$t*$_}++ } 1..$j for 1..$i; - $k-=$h{$_}, ($k<1) && (return $_) for sort { $a<=>$b } keys %h; + my($i,$j,$k,$t) = @_; + (sort{$a<=>$b}map{++$t;map{$t*$_}1..$i}1..$j)[$k-1]; } sub get_num_exp { - my($i,$j,$k,$t,%h) = @_; - for $t (1..$i) { - $h{$t*$_}++ for 1..$j; - } - for (sort {$a<=>$b} keys %h) { - $k -= $h{$_}; - return $_ if $k<1; + my($i,$j,$k,@A) = @_; + foreach my $t (1..$j) { + push @A,map{$t*$_} 1..$i; } + @A = sort @A; + return $A[ $k-1 ]; } -- cgit From 3741053244609ad8f60a7e561076cbccfe5e4d61 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 29 Nov 2021 07:25:53 +0000 Subject: Update README.md --- challenge-140/james-smith/README.md | 43 +++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/challenge-140/james-smith/README.md b/challenge-140/james-smith/README.md index c80fdc8c5e..ef0bbca2d0 100644 --- a/challenge-140/james-smith/README.md +++ b/challenge-140/james-smith/README.md @@ -104,38 +104,39 @@ with output: ## The solution -Obviously there are two parts to this - a first pass which finds all the numbers and a second pass which counts to find the `$k`th element. +This is written as a 1-liner as so: ```perl sub get_num { - my($i,$j,$k,$t,%h) = @_; - $t=$_, map { $h{$t*$_}++ } 1..$j for 1..$i; - $k-=$h{$_}, ($k<1) && (return $_) for sort { $a<=>$b } keys %h; + my($i,$j,$k,$t) = @_; + (sort{$a<=>$b}map{++$t;map{$t*$_}1..$i}1..$j)[$k-1]; } ``` -Here we do some *naughty* code (as in challenge 1), using `,` to perform multiple commands in one line; using `map` to perform a `for` -loop (altering values & ignoring the result) and using `&&` to simulate an `if` statement. +We loop through the each row for each column and create an array of the results -In this function each of these is written as a single line. We can expand each of these functions out to see how the algorithm works: +```perl +map{++$t;map{$t*$_}1..$i}1..$j +``` + +We sort the resultant array which gives a list. We wrap this in `()` to convert it into an array. + +We then and take the `$k-1` element of the array (the array is `0` based, where the question is `1` based) + +There is one bit of *naughty* where we have two statements in the outer `map` because we can't refer to both the value of the inner and outer loop as they would both be `$_`. + +We can expand the procedure out to a more readable form: ```perl sub get_num { - my($i,$j,$k,$t,%h) = @_; - for $t (1..$i) { - $h{$t*$_}++ for 1..$j; - } - for (sort {$a<=>$b} keys %h) { - $k -= $h{$_}; - return $_ if $k<1; + my($i,$j,$k,@A) = @_; + foreach my $t (1..$j) { + push @A,map{$t*$_} 1..$i; } + @A = sort @A; + return $A[ $k-1 ]; } ``` -## Notes - * In the `my` statement we initalise the first 3 parameters with the values passed in, the remaining 2 values `$t` and `%h` are not assigned a value. - * The first `for` loop (`for` can be used in place of `foreach` in perl, simply stores the numbers as keys to a hash, whose values are the "frequency" of the number occuring. - * The second one finds the answer. We first thing we do is sort the numbers into order as the keys of the hash are un-ordered. - * Rather than working up to `$k` we can work down from it to `0`. So we subtract the frequency of the current number and if the - value is less than `1` then we know this is the number we are looking for and return it's value. - * Note we always return in the `for` loop unless there is no answer - so don't need a return at the end. + +where we do each of the code blocks above as separate statements, and avoid the double `map` by using `for`/`push` to create the array. -- cgit From d2e730fcb0e99a21a32f973ca412331c53fde731 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 29 Nov 2021 07:28:15 +0000 Subject: shorter --- challenge-140/james-smith/perl/ch-2.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-140/james-smith/perl/ch-2.pl b/challenge-140/james-smith/perl/ch-2.pl index c37be1e0cf..74114cf551 100644 --- a/challenge-140/james-smith/perl/ch-2.pl +++ b/challenge-140/james-smith/perl/ch-2.pl @@ -24,8 +24,8 @@ is( get_num_exp(@{$_->[0]}), $_->[1] ) for @TESTS; done_testing(); sub get_num { - my($i,$j,$k,$t) = @_; - (sort{$a<=>$b}map{++$t;map{$t*$_}1..$i}1..$j)[$k-1]; + my$t; + (sort{$a<=>$b}map{++$t;map{$t*$_}1..$_[0]}1..$_[1])[$_[2]-1]; } sub get_num_exp { -- cgit From 751f6a10698e0c6720a97bb7bab62beefd551adb Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 29 Nov 2021 07:29:01 +0000 Subject: Update README.md --- challenge-140/james-smith/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-140/james-smith/README.md b/challenge-140/james-smith/README.md index ef0bbca2d0..8689d712fd 100644 --- a/challenge-140/james-smith/README.md +++ b/challenge-140/james-smith/README.md @@ -108,8 +108,8 @@ This is written as a 1-liner as so: ```perl sub get_num { - my($i,$j,$k,$t) = @_; - (sort{$a<=>$b}map{++$t;map{$t*$_}1..$i}1..$j)[$k-1]; + my$t; + (sort{$a<=>$b}map{++$t;map{$t*$_}1..$_[0]}1..$_[1])[$_[2]-1]; } ``` -- cgit From fb0b052f476665a5378dc85348fe987f50267cc7 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Fri, 3 Dec 2021 08:11:35 +0000 Subject: ch-2.pl solution at last --- challenge-141/james-smith/perl/ch-2.pl | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 challenge-141/james-smith/perl/ch-2.pl diff --git a/challenge-141/james-smith/perl/ch-2.pl b/challenge-141/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..5e4af7babb --- /dev/null +++ b/challenge-141/james-smith/perl/ch-2.pl @@ -0,0 +1,28 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @TESTS = ( + [ [1234,2], 9 ], + [ [ 768,4], 3 ], +); + +is( like_numbers(@{$_->[0]}), $_->[1] ) foreach @TESTS; + +done_testing(); + +sub like_numbers { + scalar grep { !($_%$_[1]) } get_nums( $_[0] ); +} + +sub get_nums { + my @nums = split //, my $m = shift; + return map { my $n=$_<<1; join '',grep{($n>>=1)&1} @nums } 1..(1<<@nums)-2; +} + -- cgit From b8d51613cbf4d730e62425abcb555583612ed677 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Fri, 3 Dec 2021 08:12:08 +0000 Subject: ch1 soln --- challenge-141/james-smith/perl/ch-1.pl | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 challenge-141/james-smith/perl/ch-1.pl diff --git a/challenge-141/james-smith/perl/ch-1.pl b/challenge-141/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..69282db686 --- /dev/null +++ b/challenge-141/james-smith/perl/ch-1.pl @@ -0,0 +1,32 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @primes = (2,3,5,7,11,13); +my @vals; + +## +## We know that all such numbers must have the form: +## p^3.q, p.q.r +## where p, q, r are all primes... +## +## We therefore constuct all such combinations of the primes <= 13 +## this should include the 10 numbers we are looking for! + +while(@primes) { + my $p1 = shift @primes; + my @t = @primes; + while( @t ) { + my $p2 = shift @t; + push @vals, $p1*$p2*$p2*$p2, $p2*$p1*$p1*$p1, map {$p1*$p2*$_} @t; + } +} + +say join "\n",(sort{$a<=>$b}@vals)[0..9]; + -- cgit From 03c1c9b48c5f66ce643a15d20c164469ee5ea251 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 3 Dec 2021 09:34:35 +0000 Subject: Update README.md --- challenge-141/james-smith/README.md | 134 ++++++++++-------------------------- 1 file changed, 35 insertions(+), 99 deletions(-) diff --git a/challenge-141/james-smith/README.md b/challenge-141/james-smith/README.md index ed48cd9b3e..c7b2fe4662 100644 --- a/challenge-141/james-smith/README.md +++ b/challenge-141/james-smith/README.md @@ -1,4 +1,4 @@ -# Perl Weekly Challenge #140 +# Perl Weekly Challenge #141 You can find more information about this weeks, and previous weeks challenges at: @@ -10,129 +10,65 @@ 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-140/james-smith/perl +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-141/james-smith/perl -# Challenge 1 - Add binary +# Challenge 1 - Number Divisors -***Write a script to simulate the addition of the given binary numbers. The script should simulate something like `$a + $b`. (operator overloading)*** +***Write a script to find lowest 10 positive integers having exactly 8 divisors.*** ## The solution -To allow for operator overloading we need to create a class. `DecBin` will be that class. We have to override to functions: +For a number 2 have exactly 8 divisors it must be of the form: -* `+` - addition -* `==` - comparison + * `p1 * p2 * p3` + * `p1 * p2^3` + * `p1^8` -We also override `""` - stringify so we can print the numbers if we want. +So to find the list of integers with 8 divisors we can generate a list of such numbers (for a set of small primes) and take the lowest 10... -Our object is simple a scalar reference. So in `new` we just bless the reference to the number than is passed, and show and comparison just return the scalar pointed to by the reference or compares two of these. - -The add function is the more complex function. Working backwards digit by digit - -* we add the *carry bit* and the last digit of the remaining string; -* we then use the last digit of this to update the total, but multiplying this by the position multiplier; -* we then move the multiplier one digit to the left by multiplying by 10; -* we then divide the *carry bit* by 2, to see if we need to carry to the next number; -* remove the last digit of the two numbers - -We repeat this until we no longer have a carry AND we have processed all digits of the two numbers. - -* Note - the *carry bit* will always be 0,1,2,3 after the first addition, as the digits of the two numbers can only be 1 or 0 and the *carry bit* will only ever be 0 and 1 as well. - -```perl -package DecBin; - -use overload ('+'=>'bin_add','=='=>'comp','""'=>'show'); - -sub new { bless \$_[1], $_[0] } -sub show { ${$_[0]} } -sub comp { ${$_[0]} == ${$_[1]} } - -sub bin_add { - my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); - $c+=$a%10+$b%10,$t+=$m*($c&1),$m*=10,$c>>=1,$a=int$a/10,$b=int$b/10 while $a||$b||$c; - DecBin->new($t); -} -``` -The long line may be unreadable - so I also include a multi-line version +So the code is written as ```perl -sub bin_add { - my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); - while ($a||$b||$c) { - $c += $a%10 + $b%10; - $t += $m * ($c&1); - $m *= 10; - $c >>= 1; - $a = int $a/10; - $b = int $b/10; +my @primes = (2,3,5,7,11,13); +my @vals; + +while(@primes) { + push @vals, (my $p1 = shift @primes) ** 8; + my @t = @primes; + while( @t ) { + my $p2 = shift @t; + push @vals, $p1*$p2**3, $p2*$p1**3, map {$p1*$p2*$_} @t; } - DecBin->new($t); } -``` -To show that the overloading works - we use the following test script: - -```perl -my @TESTS = ( - [ [ 11, 1 ] , 100 ], - [ [ 101, 1 ] , 110 ], - [ [ 100, 11 ] , 111 ], -); -foreach(@TESTS) { - my $x = DecBin->new($_->[0][0]); - my $y = DecBin->new($_->[0][1]); - my $z = DecBin->new($_->[1]); - say join "\t", $x, $y, $x+$y, $z, $x+$y==$z ? 'OK' : 'FAIL'; -} +say for (sort{$a<=>$b}@vals)[0..9]; ``` -with output: +The `shift` operator on both `@primes` and `@t` means we don't get duplicate values (`$p1`<`$p2`<`$_`), but does mean that we have to find `p1 * p2^3` and `p1^3 * p2`. -``` -11 1 100 100 OK -101 1 110 110 OK -100 11 111 111 OK -``` +As someone pointed out last week on Perl Programmers Facebook group `say` without any parameters operates on `$_` so the printing for loop simplifies to `say for ...`; -# Challenge 2 - Multiplication Table -***You are given 3 positive integers, `$i`, `$j` and `$k`. Write a script to print the `$k`th element in the sorted multiplication table of `$i` and `$j`.*** +# Challenge 2 - Like Numbers -## The solution +***You are given positive integers, `$m` and `$n`. Write a script to find total count of integers created using the digits of `$m` which is also divisible by `$n`. Repeating of digits are not allowed. Order/Sequence of digits can’t be altered. You are only allowed to use (n-1) digits at the most. For example, 432 is not acceptable integer created using the digits of 1234. Also for 1234, you can only have integers having no more than three digits.*** -Obviously there are two parts to this - a first pass which finds all the numbers and a second pass which counts to find the `$k`th element. +## The solution +The solution is here... but as it's so compact let us expand out the stages. Note as these are nested functions we will need to work backwards through the statement. ```perl -sub get_num { - my($i,$j,$k,$t,%h) = @_; - $t=$_, map { $h{$t*$_}++ } 1..$j for 1..$i; - $k-=$h{$_}, ($k<1) && (return $_) for sort { $a<=>$b } keys %h; +sub like_numbers { + my @digits = split//,$_[0]; + 0 + grep { !($_%$_[1]) } + map { my $n=$_<<1; join '',grep{($n>>=1)&1} @digits } + 1 .. (1<<@digits) - 2; } ``` -Here we do some *naughty* code (as in challenge 1), using `,` to perform multiple commands in one line; using `map` to perform a `for` -loop (altering values & ignoring the result) and using `&&` to simulate an `if` statement. +(line 1) The first thing we do is convert the number into an array of digits. -In this function each of these is written as a single line. We can expand each of these functions out to see how the algorithm works: +(line 4) We can enumarate the numbers made of the digits (in order) from `1` to `2^n-1` - the last though is the full number to so we reduce the loop to `1` to `2^n-2`. -```perl -sub get_num { - my($i,$j,$k,$t,%h) = @_; - for $t (1..$i) { - $h{$t*$_}++ for 1..$j; - } - for (sort {$a<=>$b} keys %h) { - $k -= $h{$_}; - return $_ if $k<1; - } -} -``` -## Notes - * In the `my` statement we initalise the first 3 parameters with the values passed in, the remaining 2 values `$t` and `%h` are not assigned a value. - * The first `for` loop (`for` can be used in place of `foreach` in perl, simply stores the numbers as keys to a hash, whose values are the "frequency" of the number occuring. - * The second one finds the answer. We first thing we do is sort the numbers into order as the keys of the hash are un-ordered. - * Rather than working up to `$k` we can work down from it to `0`. So we subtract the frequency of the current number and if the - value is less than `1` then we know this is the number we are looking for and return it's value. - * Note we always return in the `for` loop unless there is no answer - so don't need a return at the end. +(line 3) We use the binary representation of this number to work out which digits to use. Here we use the right shift operator (with `&1` to check to see if the digit is to be included. We have to do `$n=$_<<1;` in the map as the first thing we do is `$n>>=1`. +(line 2) We filter out numbers not divisible by `$n` using `grep`. We could use the `scalar` to explicitly cast the list to it's length or we can use the shorter 0+ which does it implicitly. -- cgit From 04f0ba9606d809c14752470659b956134209d190 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 3 Dec 2021 09:44:33 +0000 Subject: Update README.md --- challenge-141/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-141/james-smith/README.md b/challenge-141/james-smith/README.md index c7b2fe4662..f61f2d0a52 100644 --- a/challenge-141/james-smith/README.md +++ b/challenge-141/james-smith/README.md @@ -61,7 +61,7 @@ sub like_numbers { my @digits = split//,$_[0]; 0 + grep { !($_%$_[1]) } map { my $n=$_<<1; join '',grep{($n>>=1)&1} @digits } - 1 .. (1<<@digits) - 2; + 1 .. (1<<@digits) - 2 } ``` -- cgit From cc1e200e05cfd8fda451a2b68c66445500569d4c Mon Sep 17 00:00:00 2001 From: Paulo Custodio Date: Fri, 3 Dec 2021 10:37:53 +0000 Subject: Add Python solution to challenge 23 --- .../paulo-custodio/check_challenge_title.pl | 10 ++-- challenge-023/paulo-custodio/Makefile | 2 + challenge-023/paulo-custodio/perl/ch-1.pl | 4 +- challenge-023/paulo-custodio/perl/ch-2.pl | 7 +-- challenge-023/paulo-custodio/python/ch-1.py | 32 +++++++++++++ challenge-023/paulo-custodio/python/ch-2.py | 38 +++++++++++++++ challenge-023/paulo-custodio/t/test-1.yaml | 15 ++++++ challenge-023/paulo-custodio/t/test-2.yaml | 55 ++++++++++++++++++++++ challenge-023/paulo-custodio/test.pl | 30 ------------ 9 files changed, 153 insertions(+), 40 deletions(-) create mode 100644 challenge-023/paulo-custodio/Makefile create mode 100644 challenge-023/paulo-custodio/python/ch-1.py create mode 100644 challenge-023/paulo-custodio/python/ch-2.py create mode 100644 challenge-023/paulo-custodio/t/test-1.yaml create mode 100644 challenge-023/paulo-custodio/t/test-2.yaml delete mode 100644 challenge-023/paulo-custodio/test.pl diff --git a/challenge-001/paulo-custodio/check_challenge_title.pl b/challenge-001/paulo-custodio/check_challenge_title.pl index cd36c62e87..02a8d1babd 100644 --- a/challenge-001/paulo-custodio/check_challenge_title.pl +++ b/challenge-001/paulo-custodio/check_challenge_title.pl @@ -33,10 +33,10 @@ for my $chall_dir (path(".")->children(qr/challenge-\d+/)) { next unless $dir->is_dir; for my $sol ($dir->children(qr/^ch[-_]\d\.$LANG{$lang}$/)) { - my $text = $sol->slurp; - if ($text !~ /Challenge 0*$chall\b/) { - say $sol; - } - } + my $text = $sol->slurp; + if ($text !~ /Challenge 0*$chall\b/) { + say $sol; + } + } } } diff --git a/challenge-023/paulo-custodio/Makefile b/challenge-023/paulo-custodio/Makefile new file mode 100644 index 0000000000..c3c762d746 --- /dev/null +++ b/challenge-023/paulo-custodio/Makefile @@ -0,0 +1,2 @@ +all: + perl ../../challenge-001/paulo-custodio/test.pl diff --git a/challenge-023/paulo-custodio/perl/ch-1.pl b/challenge-023/paulo-custodio/perl/ch-1.pl index ee500f38dc..581caa45f9 100644 --- a/challenge-023/paulo-custodio/perl/ch-1.pl +++ b/challenge-023/paulo-custodio/perl/ch-1.pl @@ -1,4 +1,4 @@ -#!/usr/bin/env perl +#!/usr/bin/perl # Challenge 023 # @@ -19,7 +19,7 @@ use Modern::Perl; my($n, @seq) = @ARGV; -say join(", ", nth_forward_diff($n, @seq)), "."; +say join(", ", nth_forward_diff($n, @seq)); sub forward_diff { diff --git a/challenge-023/paulo-custodio/perl/ch-2.pl b/challenge-023/paulo-custodio/perl/ch-2.pl index 62f450ba8d..695e54128d 100644 --- a/challenge-023/paulo-custodio/perl/ch-2.pl +++ b/challenge-023/paulo-custodio/perl/ch-2.pl @@ -1,16 +1,17 @@ -#!/usr/bin/env perl +#!/usr/bin/perl # Challenge 023 # # Task #2 # Create a script that prints Prime Decomposition of a given number. The prime # decomposition of a number is defined as a list of prime numbers which when -# all multiplied together, are equal to that number. For example, the Prime decomposition of 228 is 2,2,3,19 as 228 = 2 * 2 * 3 * 19. +# all multiplied together, are equal to that number. For example, the Prime +# decomposition of 228 is 2,2,3,19 as 228 = 2 * 2 * 3 * 19. use Modern::Perl; my($n) = @ARGV; -say join(", ", prime_decomposition($n)), "."; +say join(", ", prime_decomposition($n)); # check if number is prime diff --git a/challenge-023/paulo-custodio/python/ch-1.py b/challenge-023/paulo-custodio/python/ch-1.py new file mode 100644 index 0000000000..5baa57d74a --- /dev/null +++ b/challenge-023/paulo-custodio/python/ch-1.py @@ -0,0 +1,32 @@ +#!/usr/bin/python3 + +# Challenge 023 +# +# Task #1 +# Create a script that prints nth order forward difference series. You should +# be a able to pass the list of numbers and order number as command line +# parameters. Let me show you with an example. +# +# Suppose we have list (X) of numbers: 5, 9, 2, 8, 1, 6 and we would like to +# create 1st order forward difference series (Y). So using the formula +# Y(i) = X(i+1) - X(i), we get the following numbers: +# (9-5), (2-9), (8-2), (1-8), (6-1). +# In short, the final series would be: 4, -7, 6, -7, 5. +# If you noticed, it has one less number than the original series. +# Similarly you can carry on 2nd order forward difference series like: +# (-7-4), (6+7), (-7-6), (5+7) => -11, 13, -13, 12. + +import sys + +def forward_diff(seq): + return [seq[i+1]-seq[i] for i in range(len(seq)-1)] + +def nth_forward_diff(n ,seq): + for i in range(n): + seq = forward_diff(seq) + return seq + +n = int(sys.argv[1]) +seq = [int(x) for x in sys.argv[2:]] +seq = nth_forward_diff(n ,seq) +print(", ".join([str(x) for x in seq])) diff --git a/challenge-023/paulo-custodio/python/ch-2.py b/challenge-023/paulo-custodio/python/ch-2.py new file mode 100644 index 0000000000..4438d1af8a --- /dev/null +++ b/challenge-023/paulo-custodio/python/ch-2.py @@ -0,0 +1,38 @@ +#!/usr/bin/python3 + +# Challenge 023 +# +# Task #2 +# Create a script that prints Prime Decomposition of a given number. The prime +# decomposition of a number is defined as a list of prime numbers which when +# all multiplied together, are equal to that number. For example, the Prime +# decomposition of 228 is 2,2,3,19 as 228 = 2 * 2 * 3 * 19. + +import sys +from primePy import primes + +def next_prime(n): + if n <= 1: + return 2 + else: + n += 1 + while not primes.check(n): + n += 1 + return n + +def prime_decomposition(n): + if n<2: + return [n] + + f = [] + p = 2 + while n>1: + if n%p == 0: + f.append(p) + n //= p + else: + p = next_prime(p) + return f + +f = prime_decomposition(int(sys.argv[1])) +print(", ".join([str(x) for x in f])) diff --git a/challenge-023/paulo-custodio/t/test-1.yaml b/challenge-023/paulo-custodio/t/test-1.yaml new file mode 100644 index 0000000000..d93bef9607 --- /dev/null +++ b/challenge-023/paulo-custodio/t/test-1.yaml @@ -0,0 +1,15 @@ +- setup: + cleanup: + args: 1 5 9 2 8 1 6 + input: + output: 4, -7, 6, -7, 5 +- setup: + cleanup: + args: 2 5 9 2 8 1 6 + input: + output: -11, 13, -13, 12 +- setup: + cleanup: + args: 1 4 -7 6 -7 5 + input: + output: -11, 13, -13, 12 diff --git a/challenge-023/paulo-custodio/t/test-2.yaml b/challenge-023/paulo-custodio/t/test-2.yaml new file mode 100644 index 0000000000..f94852e4f0 --- /dev/null +++ b/challenge-023/paulo-custodio/t/test-2.yaml @@ -0,0 +1,55 @@ +- setup: + cleanup: + args: 1 + input: + output: 1 +- setup: + cleanup: + args: 2 + input: + output: 2 +- setup: + cleanup: + args: 3 + input: + output: 3 +- setup: + cleanup: + args: 4 + input: + output: 2, 2 +- setup: + cleanup: + args: 5 + input: + output: 5 +- setup: + cleanup: + args: 6 + input: + output: 2, 3 +- setup: + cleanup: + args: 7 + input: + output: 7 +- setup: + cleanup: + args: 8 + input: + output: 2, 2, 2 +- setup: + cleanup: + args: 9 + input: + output: 3, 3 +- setup: + cleanup: + args: 10 + input: + output: 2, 5 +- setup: + cleanup: + args: 228 + input: + output: 2, 2, 3, 19 diff --git a/challenge-023/paulo-custodio/test.pl b/challenge-023/paulo-custodio/test.pl deleted file mode 100644 index bc90aec76b..0000000000 --- a/challenge-023/paulo-custodio/test.pl +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -use Modern::Perl; -use Test::More; -use Path::Tiny; - -is capture("perl perl/ch-1.pl 1 5 9 2 8 1 6"), "4, -7, 6, -7, 5.\n"; -is capture("perl perl/ch-1.pl 2 5 9 2 8 1 6"), "-11, 13, -13, 12.\n"; -is capture("perl perl/ch-1.pl 1 4 -7 6 -7 5"), "-11, 13, -13, 12.\n"; - -is capture("perl perl/ch-2.pl 1"), "1.\n"; -is capture("perl perl/ch-2.pl 2"), "2.\n"; -is capture("perl perl/ch-2.pl 3"), "3.\n"; -is capture("perl perl/ch-2.pl 4"), "2, 2.\n"; -is capture("perl perl/ch-2.pl 5"), "5.\n"; -is capture("perl perl/ch-2.pl 6"), "2, 3.\n"; -is capture("perl perl/ch-2.pl 7"), "7.\n"; -is capture("perl perl/ch-2.pl 8"), "2, 2, 2.\n"; -is capture("perl perl/ch-2.pl 9"), "3, 3.\n"; -is capture("perl perl/ch-2.pl 10"), "2, 5.\n"; -is capture("perl perl/ch-2.pl 228"), "2, 2, 3, 19.\n"; - -done_testing; - -sub capture { - my($cmd) = @_; - my $out = `$cmd`; - $out =~ s/[ \t\v\f\r]*\n/\n/g; - return $out; -} -- cgit From fe57a0405720a40beaeb75100e069aaa13e4c49e Mon Sep 17 00:00:00 2001 From: Paulo Custodio Date: Fri, 3 Dec 2021 11:22:43 +0000 Subject: Perl Smallest Script --- challenge-024/paulo-custodio/perl/ch-1.pl | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 challenge-024/paulo-custodio/perl/ch-1.pl diff --git a/challenge-024/paulo-custodio/perl/ch-1.pl b/challenge-024/paulo-custodio/perl/ch-1.pl new file mode 100644 index 0000000000..e69de29bb2 -- cgit From 47768994608d093456a638bdd1001e3f2e8af732 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Fri, 3 Dec 2021 14:07:57 +0000 Subject: fixes --- challenge-141/james-smith/perl/ch-1.pl | 8 ++++---- challenge-141/james-smith/perl/ch-2.pl | 10 ++++------ 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/challenge-141/james-smith/perl/ch-1.pl b/challenge-141/james-smith/perl/ch-1.pl index 69282db686..5ee8bbe11b 100644 --- a/challenge-141/james-smith/perl/ch-1.pl +++ b/challenge-141/james-smith/perl/ch-1.pl @@ -13,20 +13,20 @@ my @vals; ## ## We know that all such numbers must have the form: -## p^3.q, p.q.r +## p^8, p^3.q, p.q.r ## where p, q, r are all primes... ## ## We therefore constuct all such combinations of the primes <= 13 ## this should include the 10 numbers we are looking for! while(@primes) { - my $p1 = shift @primes; + push @vals,(my $p1 = shift @primes)**8; my @t = @primes; while( @t ) { my $p2 = shift @t; - push @vals, $p1*$p2*$p2*$p2, $p2*$p1*$p1*$p1, map {$p1*$p2*$_} @t; + push @vals, $p1*$p2**3, $p2*$p1**3, map {$p1*$p2*$_} @t; } } -say join "\n",(sort{$a<=>$b}@vals)[0..9]; +say for (sort{$a<=>$b}@vals)[0..9]; diff --git a/challenge-141/james-smith/perl/ch-2.pl b/challenge-141/james-smith/perl/ch-2.pl index 5e4af7babb..8ff4a87996 100644 --- a/challenge-141/james-smith/perl/ch-2.pl +++ b/challenge-141/james-smith/perl/ch-2.pl @@ -18,11 +18,9 @@ is( like_numbers(@{$_->[0]}), $_->[1] ) foreach @TESTS; done_testing(); sub like_numbers { - scalar grep { !($_%$_[1]) } get_nums( $_[0] ); -} - -sub get_nums { - my @nums = split //, my $m = shift; - return map { my $n=$_<<1; join '',grep{($n>>=1)&1} @nums } 1..(1<<@nums)-2; + my @digits = split//,$_[0]; + 0 + grep { !($_%$_[1]) } + map { my $n=$_<<1; join '',grep{($n>>=1)&1} @digits } + 1 .. (1<<@digits) - 2; } -- cgit From 35e89da28fa5acf448dde4127c093031888e2fde Mon Sep 17 00:00:00 2001 From: drbaggy Date: Fri, 3 Dec 2021 14:10:52 +0000 Subject: removed ; --- challenge-141/james-smith/perl/ch-2.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-141/james-smith/perl/ch-2.pl b/challenge-141/james-smith/perl/ch-2.pl index 8ff4a87996..e606314b33 100644 --- a/challenge-141/james-smith/perl/ch-2.pl +++ b/challenge-141/james-smith/perl/ch-2.pl @@ -21,6 +21,6 @@ sub like_numbers { my @digits = split//,$_[0]; 0 + grep { !($_%$_[1]) } map { my $n=$_<<1; join '',grep{($n>>=1)&1} @digits } - 1 .. (1<<@digits) - 2; + 1 .. (1<<@digits) - 2 } -- cgit From 81f50c4150062cbd787a33583a53f7e32a4a2835 Mon Sep 17 00:00:00 2001 From: Roger Bell_West Date: Mon, 6 Dec 2021 09:14:28 +0000 Subject: Solutions for challenge #142 --- challenge-142/roger-bell-west/perl/ch-1.pl | 36 +++++++++++++++++++ challenge-142/roger-bell-west/perl/ch-2.pl | 35 +++++++++++++++++++ challenge-142/roger-bell-west/postscript/ch-1.ps | 44 ++++++++++++++++++++++++ challenge-142/roger-bell-west/python/ch-1.py | 35 +++++++++++++++++++ challenge-142/roger-bell-west/python/ch-2.py | 35 +++++++++++++++++++ challenge-142/roger-bell-west/raku/ch-1.p6 | 31 +++++++++++++++++ challenge-142/roger-bell-west/raku/ch-2.p6 | 27 +++++++++++++++ challenge-142/roger-bell-west/ruby/ch-1.rb | 40 +++++++++++++++++++++ challenge-142/roger-bell-west/ruby/ch-2.rb | 26 ++++++++++++++ challenge-142/roger-bell-west/rust/ch-1.rs | 44 ++++++++++++++++++++++++ challenge-142/roger-bell-west/rust/ch-2.rs | 41 ++++++++++++++++++++++ 11 files changed, 394 insertions(+) create mode 100755 challenge-142/roger-bell-west/perl/ch-1.pl create mode 100755 challenge-142/roger-bell-west/perl/ch-2.pl create mode 100644 challenge-142/roger-bell-west/postscript/ch-1.ps create mode 100755 challenge-142/roger-bell-west/python/ch-1.py create mode 100755 challenge-142/roger-bell-west/python/ch-2.py create mode 100755 challenge-142/roger-bell-west/raku/ch-1.p6 create mode 100755 challenge-142/roger-bell-west/raku/ch-2.p6 create mode 100755 challenge-142/roger-bell-west/ruby/ch-1.rb create mode 100755 challenge-142/roger-bell-west/ruby/ch-2.rb create mode 100755 challenge-142/roger-bell-west/rust/ch-1.rs create mode 100644 challenge-142/roger-bell-west/rust/ch-2.rs diff --git a/challenge-142/roger-bell-west/perl/ch-1.pl b/challenge-142/roger-bell-west/perl/ch-1.pl new file mode 100755 index 0000000000..04ccf574dc --- /dev/null +++ b/challenge-142/roger-bell-west/perl/ch-1.pl @@ -0,0 +1,36 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 2; + +is(dld(24,2),2,'example 1'); +is(dld(30,5),2,'example 2'); + +sub factor { + my $n=shift; + if ($n==1) { + return [1]; + } + my @ff; + my $s=int(sqrt($n)); + if ($s*$s == $n) { + push @ff,$s; + $s--; + } + foreach my $pf (2..$s) { + if ($n % $pf == 0) { + unshift @ff,$pf; + push @ff,$n/$pf; + } + } + unshift @ff,1; + push @ff,$n; + return \@ff; +} + +sub dld { + my ($m,$n)=@_; + return scalar grep {$_ % 10 == $n} @{factor($m)}; +} diff --git a/challenge-142/roger-bell-west/perl/ch-2.pl b/challenge-142/roger-bell-west/perl/ch-2.pl new file mode 100755 index 0000000000..a3f7178bee --- /dev/null +++ b/challenge-142/roger-bell-west/perl/ch-2.pl @@ -0,0 +1,35 @@ +#! /usr/bin/perl +