aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-111/james-smith/perl/ch-1.pl50
-rw-r--r--challenge-111/james-smith/perl/ch-2.pl46
-rw-r--r--challenge-113/james-smith/perl/BinaryTree.pm66
-rw-r--r--challenge-113/james-smith/perl/ch-2.pl42
-rw-r--r--challenge-115/james-smith/perl/ch-1.pl3
-rw-r--r--challenge-115/james-smith/perl/ch-2.pl27
-rw-r--r--challenge-121/james-smith/perl/ch-2.pl2
-rw-r--r--challenge-125/james-smith/perl/BinaryTree.pm10
-rw-r--r--challenge-126/james-smith/perl/ch-1.pl1
-rw-r--r--challenge-130/james-smith/perl/ch-1.pl24
-rw-r--r--challenge-131/james-smith/perl/ch-2.pl35
-rw-r--r--challenge-133/james-smith/c/ch-2.c30
-rw-r--r--challenge-136/james-smith/perl/ch-1.pl3
-rw-r--r--challenge-136/james-smith/perl/ch-2.pl10
-rw-r--r--challenge-137/james-smith/perl/ch-2.pl16
-rw-r--r--challenge-140/james-smith/perl/ch-1.pl12
-rw-r--r--challenge-140/james-smith/perl/ch-2.pl17
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 );
@@ -96,6 +144,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 = {};
$self->walk( sub { my( $node, $global, $local, $dir ) = @_;
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) */ <could be a tag>' ], [ '/**/<','/**/>' ] ],
+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 ];
}
generated by cgit (git 2.34.1) at 2026-06-30 23:00:16 +0000