diff options
| -rw-r--r-- | ch-1.pl | 82 | ||||
| -rw-r--r-- | ch-2.pl | 174 |
2 files changed, 256 insertions, 0 deletions
diff --git a/ch-1.pl b/ch-1.pl new file mode 100644 index 0000000000..fa13f555f8 --- /dev/null +++ b/ch-1.pl @@ -0,0 +1,82 @@ +#!/usr/bin/perl + +use strict; +use Data::Dumper; +use List::Util qw/sum/; + +# $steps : a string looks like DDDDRRRR, DDRRRR, RDRDRD... + +# my @ms = ([1,2,3], [4,5,6], [7,8,9]); # ms = shorthand of matrixrows +# ans = 21 +# my @ms = ([1, 4, 7], [2, 0, 8], [3, 6, 9]); +# ans = 21 + my @ms = ([1, 4, 7, 12], [2, 0, 8, 9], [3, 6, 9, 8]); +# ans = 26 + +my @min_path; + +my $M = $#ms+1; +my $N = $#{$ms[0]} + 1; +my $totsteps = $M+$N-2; + +# a starting minimum +my $refmin = sum @{$ms[0]}; +for (1..$M-1) { + $refmin += ${$ms[$_]}[$N-1]; +} + +sub go { + my $steps = $_[0]; + my $hardship = $_[1]; + $hardship += ${$ms[otimes($steps, 'D')]}[otimes($steps,'R')]; + myseek($steps, $hardship) if ($hardship <= $refmin); +} + + + +sub myseek { + my $steps = $_[0]; + my $hardship = $_[1]; + # print $steps, " ", $hardship, "\n"; for testing + if ( (length $steps) < $totsteps ) { + go($steps.'D', $hardship) if $M-1 > otimes($steps, 'D'); + go($steps.'R', $hardship) if $N-1 > otimes($steps, 'R'); + } + elsif ( $hardship <= $refmin) { + @min_path = tour($steps); + $refmin = $hardship; + } +} + + +sub otimes { + my $t = 0; + for my $x (split //, $_[0]) { + if ($x eq $_[1]) { + $t++; + } + } + return $t; +} + +sub tour { + my $steps = $_[0]; + my @_a = ( ${ms[0]}[0] ); + my $x = 0; + my $y = 0; + my @ways = split //, $steps; + for my $w (@ways) { + if ($w eq 'D') {$y++;} + if ($w eq 'R') {$x++;} + push @_a, ${ms[$y]}[$x]; + } +# push @_a, ${ms[$M-1]}[$N-1]; + return @_a; +} + + +myseek('',${$ms[0]}[0]); + +print $refmin, "\n"; +print join " -> ", @min_path; +print "\n"; diff --git a/ch-2.pl b/ch-2.pl new file mode 100644 index 0000000000..2c04455b3a --- /dev/null +++ b/ch-2.pl @@ -0,0 +1,174 @@ +#!/usr/bin/perl +use strict; +use Math::Combinatorics; +use List::Util qw{sum}; + + +#ref Challenge-051 task-1 3 Sum +#brute force + +#my $S = "perlweeklychallenge"; +#my @W = ("weekly", "challenge", "perl"); +my $S; +my @W; + +if ($ARGV[0] eq undef) { + $S = "thequickbrownfoxjumpsoverthelazydogwooyousee"; + @W = split / /, "theq uickb rownf ox jumps over the lazy dog"; +} else { + $S = shift @ARGV; + @W = @ARGV; +} + +my $target = length $S; + +my $noofsoln = 0; + +for my $r (1..$#W+1) { + my $subject = Math::Combinatorics->new( count => $r , data => [@W] ); + while (my @tsum = $subject->next_combination) { + if ($target == sum map {length $_} @tsum) { + my $psubject = Math::Combinatorics->new( count => $r, data => [@tsum]); + while (my @ptsum = $psubject->next_permutation) { + if ( $S eq (join "", @ptsum)) { + print "\""; + print join "\",\"", @ptsum; + print "\"\n"; + $noofsoln++; + } + } + } + } +} + +print "0\n" if $noofsoln == 0; + + +=pod +Input + +my $S = "thequickbrownfoxjumpsoverthelazydog"; +my @W = split / /, "the quick brown fox jumps over the lazy dog"; +push @W, "theq", "uickb", "rownf", "ox"; + +$ time perl ch-2.pl +"the","quick","brown","fox","jumps","over","the","lazy","dog" +"the","quick","brown","fox","jumps","over","the","lazy","dog" +"theq","uickb","rownf","ox","jumps","over","the","lazy","dog" +"theq","uickb","rownf","ox","jumps","over","the","lazy","dog" + +real 5m7.153s +user 5m6.496s +sys 0m0.076s + + +--- +on performance + +$S = "thequickbrownfoxjumpsoverthelazydog"; +@W = split / /, "theq uickb rownf ox jumps over the lazy dog"; +$ time perl ch-2.pl +"theq","uickb","rownf","ox","jumps","over","the","lazy","dog" + +real 0m2.729s +user 0m2.727s +sys 0m0.001s + + +$S = "thequickbrownfoxjumpsoverthelazydogwoo"; +@W = split / /, "theq uickb rownf ox jumps over the lazy dog woo"; +$ time perl ch-2.pl +"theq","uickb","rownf","ox","jumps","over","the","lazy","dog","woo" + +real 0m22.516s +user 0m22.499s +sys 0m0.009s + + + +$S = "thequickbrownfoxjumpsoverthelazydogwooyousee"; +@W = split / /, "theq uickb rownf ox jumps over the lazy dog woo you see"; +$ time perl ch-2.pl +"theq","uickb","rownf","ox","jumps","over","the","lazy","dog","woo","you","see" + +real 46m17.928s +user 46m14.609s +sys 0m0.448s + + + + +see the performance on single alphabet: + +$ time perl ch-2.pl abc a b c +"a","b","c" + +real 0m0.019s +user 0m0.015s +sys 0m0.004s + + +$ time perl ch-2.pl abcd a b c d +"a","b","c","d" + +real 0m0.024s +user 0m0.024s +sys 0m0.000s + + +$ time perl ch-2.pl abcde a b c d e +"a","b","c","d","e" + +real 0m0.021s +user 0m0.018s +sys 0m0.004s + + +$ time perl ch-2.pl abcdef a b c d e f +"a","b","c","d","e","f" + +real 0m0.027s +user 0m0.027s +sys 0m0.000s + + +$ time perl ch-2.pl abcdefg a b c d e f g +"a","b","c","d","e","f","g" + +real 0m0.048s +user 0m0.048s +sys 0m0.000s + + +$ time perl ch-2.pl abcdefgh a b c d e f g h +"a","b","c","d","e","f","g","h" + +real 0m0.202s +user 0m0.197s +sys 0m0.004s + + +$ time perl ch-2.pl abcdefghi a b c d e f g h i +"a","b","c","d","e","f","g","h","i" + +real 0m1.692s +user 0m1.691s +sys 0m0.000s + + +$ time perl ch-2.pl abcdefghij a b c d e f g h i j +"a","b","c","d","e","f","g","h","i","j" + +real 0m18.022s +user 0m17.954s +sys 0m0.028s + + +$ time perl ch-2.pl abcdefghijk a b c d e f g h i j k +"a","b","c","d","e","f","g","h","i","j","k" + +real 3m21.870s +user 3m21.691s +sys 0m0.004s + +=cut |