diff options
59 files changed, 3131 insertions, 1473 deletions
diff --git a/challenge-076/bob-lied/perl/ch-2.pl b/challenge-076/bob-lied/perl/ch-2.pl index 6a1a88fe38..3f9acd09bd 100755 --- a/challenge-076/bob-lied/perl/ch-2.pl +++ b/challenge-076/bob-lied/perl/ch-2.pl @@ -5,27 +5,52 @@ #============================================================================= # Copyright (c) 2020, Bob Lied #============================================================================= -# Perl Weekly Challenge 000 Task #2 > xxx +# Perl Weekly Challenge 076 Task #2 > Word Search +# Write a script that takes two file names. The first file would contain word +# search grid as shown below. The second file contains list of words, one +# word per line. You could even use local dictionary file. +# +# Print out a list of all words seen on the grid, looking both orthogonally +# and diagonally, backwards as well as forwards. #============================================================================= use strict; use warnings; use v5.30; -us feature qw/ signatures /; +use feature qw/ signatures /; no warnings qw/ experimental::signatures /; +use Getopt::Long; + use lib "lib"; -use Task2; +use WordSearch; + +sub Usage { "Usage: $0 [-l min-length] grid-file wordlist-file" }; + +my $MinLength = 5; +my $Verbose = 0; +GetOptions('length=i' => \$MinLength, "verbose!" => \$Verbose); + +my $gridFile = shift; +my $wordlistFile = shift; + +die Usage() unless $gridFile && $wordlistFile; +die ( Usage(). " $!" ) unless -r $gridFile; +die ( Usage(). " $!" ) unless -r $wordlistFile; -sub Usage { "Usage: $0 args" }; +die Usage() unless ( $MinLength > 0 && $MinLength < 50 ); -my $arg = shift; -my @list = @ARGV; +my $wordsearch = WordSearch->new(); +$wordsearch->loadGrid($gridFile); +$wordsearch->loadWordlist($wordlistFile, $MinLength); -die Usage() unless $arg; -die Usage() unless @list; +my $result = $wordsearch->run(); -my $task = Task2->new(); -my $result = task->run(); -say $result; +my $count = $wordsearch->numFound(); +my $foundList = $wordsearch->foundList(); +say "Found $count words of length $MinLength or longer"; +if ( $Verbose ) +{ + say "[" . ($_+1) ."] $foundList->[$_]" for 0 .. $count-1; +} diff --git a/challenge-076/bob-lied/perl/lib/Task2.pm b/challenge-076/bob-lied/perl/lib/Task2.pm deleted file mode 100644 index e210edb216..0000000000 --- a/challenge-076/bob-lied/perl/lib/Task2.pm +++ /dev/null @@ -1,38 +0,0 @@ -# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: -#============================================================================= -# Task2.pm -#============================================================================= -# Copyright (c) 2020, Bob Lied -#============================================================================= -# Description: -#============================================================================= - -package Task2; - -use strict; -use warnings; - -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT = qw(); -our @EXPORT_OK = qw(); - -sub new -{ - my $class = shift; - $class = ref($class) || $class; - my $self = { - _name1 => $_[0], - }; - bless $self, $class; - return $self; -} - -sub run -{ - my $self = shift; - return undef; -} - -1; - diff --git a/challenge-076/bob-lied/perl/lib/WordSearch.pm b/challenge-076/bob-lied/perl/lib/WordSearch.pm new file mode 100644 index 0000000000..7d03abdfca --- /dev/null +++ b/challenge-076/bob-lied/perl/lib/WordSearch.pm @@ -0,0 +1,191 @@ +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# WordSearch.pm +#============================================================================= +# Copyright (c) 2020, Bob Lied +#============================================================================= +# Description: +#============================================================================= + +package WordSearch; + +use strict; +use warnings; +use v5.30; + +use feature qw/ signatures /; +no warnings qw/ experimental::signatures /; + +use File::Slurper qw / read_lines /; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(); +our @EXPORT_OK = qw(); + +sub new($class) +{ + $class = ref($class) || $class; + my $self = { + _grid => [], + _wordlist => [], + _lastRow => 0, + _lastCol => 0, + + _numFound => 0, + _foundList => [], + }; + bless $self, $class; + return $self; +} + +sub loadGrid($self, $gridFile) +{ + my @g = read_lines($gridFile); + for my $row ( 0 .. $#g ) + { + (my @chars) = split(" ", $g[$row]); + for my $col ( 0 .. $#chars ) + { + $self->{_grid}->[$row][$col] = lc($chars[$col]); + } + } + $self->{_lastRow} = scalar( @{$self->{_grid}} ) - 1; + $self->{_lastCol} = scalar( @{$self->{_grid}->[0]} ) - 1; + return $self; +} + +sub loadWordlist($self, $wordlistFile, $minLength) +{ + my @wl = map { lc } grep { length($_) >= $minLength } read_lines($wordlistFile); + $self->{_wordlist} = \@wl; + return $self; +} + +sub numFound($self) +{ + return $self->{_numFound}; +} + +sub foundList($self) +{ + return $self->{_foundList} +} + +sub _horizontal($self) +{ + my @list; + my $g = $self->{_grid}; + + for my $row ( 0 .. $self->{_lastRow} ) + { + my $s = join('', @{$g->[$row]}); + push @list, $s, scalar(reverse($s)); + } + return \@list; +} + +sub _vertical($self) +{ + my @list; + my $g = $self->{_grid}; + + for my $col ( 0 .. $self->{_lastCol} ) + { + my @column = map { $g->[$_][$col] } 0 .. $self->{_lastRow}; + my $s = join('', @column); + push @list, $s, scalar(reverse($s)); + } + return \@list; +} + +sub _diagonal($self) +{ + my @list; + my $g = $self->{_grid}; + my $lastRow = $self->{_lastRow}; + my $lastCol = $self->{_lastCol}; + + # Top left to bottom right along the left edge + for my $row ( 0 .. $lastRow ) + { + my $s; + my ($r, $c); + for ( $r = $row, $c = 0; $r <= $lastRow && $c <= $lastCol ; $r++, $c++ ) + { + $s .= $g->[$r][$c]; + } + push @list, $s, scalar(reverse($s)); + } + + # Top left to bottom right along the top edge + for my $col ( 1 .. $self->{_lastCol} ) # + { + my $s; + my ($r, $c); + for ( $r = 0, $c = $col; $r <= $lastRow && $c <= $lastCol ; $r++, $c++ ) + { + $s .= $g->[$r][$c]; + } + push @list, $s, scalar(reverse($s)); + } + + # Bottom left to top right along left edge + for ( my $row = $lastRow; $row >= 0; $row-- ) + { + my $s; + my ($r, $c); + for ( $r = $row, $c = 0; $r >= 0 && $c <= $lastCol; $r--, $c++ ) + { + $s .= $g->[$r][$c]; + } + push @list, $s, scalar(reverse($s)); + } + + # Bottom left to top right along the bottom edge + for my $col ( 1 .. $lastCol ) + { + my $s; + my ($r, $c); + for ( $r = $lastRow, $c = $col; $r >= 0 && $c <= $lastCol ; $r--, $c++ ) + { + $s .= $g->[$r][$c]; + } + push @list, $s, scalar(reverse($s)); + } + return \@list; +} + +sub _find($self, $str) +{ + my $count = 0; + my @found; + for my $word ( @{$self->{_wordlist}} ) + { + # Is RE faster than index? + if ( index($str, $word) != -1 ) + { + $count++; + push @found, $word; + } + } + $self->{_foundList} = \@found; + + return $self->{_numFound} = $count; +} + + +sub run($self) +{ + my $h = $self->_horizontal(); + my $v = $self->_vertical(); + my $d = $self->_diagonal(); + + # Combine all the strings with a non-word character to separate + # them so that we need only one search per word. + my $all = join('.', @$h, @$v, @$d); + return $self->_find($all); +} + +1; + diff --git a/challenge-076/bob-lied/perl/t/Task2.t b/challenge-076/bob-lied/perl/t/Task2.t deleted file mode 100644 index ffb1db7c8d..0000000000 --- a/challenge-076/bob-lied/perl/t/Task2.t +++ /dev/null @@ -1,14 +0,0 @@ -# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: -# -#=============================================================================== -# FILE: Task2.t -# DESCRIPTION: Unit test for Task2 -#=============================================================================== - -use strict; -use warnings; -use v5.30; - -use Test2::V0; - -done_testing(); diff --git a/challenge-076/bob-lied/perl/t/WordSearch.t b/challenge-076/bob-lied/perl/t/WordSearch.t new file mode 100644 index 0000000000..7e1320a7ae --- /dev/null +++ b/challenge-076/bob-lied/perl/t/WordSearch.t @@ -0,0 +1,29 @@ +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +# +#=============================================================================== +# FILE: WordSearch.t +# DESCRIPTION: Unit test for WordSearch +#=============================================================================== + +use strict; +use warnings; +use v5.30; + +use Test2::V0; + +use WordSearch; + +my $ws = WordSearch->new(); +isa_ok($ws, "WordSearch"); + +$ws->loadWordlist("t/wordlist.txt", 5); +is( scalar(@{$ws->{_wordlist}}), 54, "loadWordlist size"); +is($ws->{_wordlist}->[0], "aimed", "loadWordlist first word"); +is($ws->{_wordlist}->[53], "wigged", "loadWordlist last word"); + +$ws->loadGrid("t/searchgrid.txt"); +my $g = $ws->{_grid}; +is ( scalar(@$g), 19, "loadGrid rows"); +is ( scalar(@{$g->[0]}), 16, "loadGrid cols"); + +done_testing(); diff --git a/challenge-076/bob-lied/perl/t/searchgrid.txt b/challenge-076/bob-lied/perl/t/searchgrid.txt new file mode 100644 index 0000000000..31cf2e0fd8 --- /dev/null +++ b/challenge-076/bob-lied/perl/t/searchgrid.txt @@ -0,0 +1,19 @@ +B I D E M I A T S U C C O R S T +L D E G G I W Q H O D E E H D P +U S E I R U B U T E A S L A G U +N G N I Z I L A I C O S C N U D +T G M I D S T S A R A R E I F G +S R E N M D C H A S I V E E L I +S C S H A E U E B R O A D M T E +H W O V L P E D D L A I U L S S +R Y O N L A S F C S T A O G O T +I G U S S R R U G O V A R Y O C +N R G P A T N A N G I L A M O O +E I H A C E I V I R U S E S E D +S E T S U D T T G A R L I C N H +H V R M X L W I U M S N S O T B +A E A O F I L C H T O D C A E U +Z S C D F E C A A I I R L N R F +A R I I A N Y U T O O O U T P F +R S E C I S N A B O S C N E R A +D R S M P C U U N E L T E S I L diff --git a/challenge-076/bob-lied/perl/t/wordlist.txt b/challenge-076/bob-lied/perl/t/wordlist.txt new file mode 100644 index 0000000000..e3209b2265 --- /dev/null +++ b/challenge-076/bob-lied/perl/t/wordlist.txt @@ -0,0 +1,54 @@ +aimed +align +antes +argos +arose +ashed +blunt +blunts +broad +buries +clove +cloven +constitution +constitutions +croon +depart +departed +enter +filch +garlic +goats +grieve +grieves +hazard +liens +malign +malignant +malls +margo +midst +ought +ovary +parted +patna +pudgiest +quash +quashed +raped +ruses +shrine +shrines +social +socializing +spasm +spasmodic +succor +succors +theorem +theorems +traci +tracie +virus +viruses +wigged diff --git a/challenge-077/andinus/README b/challenge-077/andinus/README index 1653e8e915..9437e98f28 100644 --- a/challenge-077/andinus/README +++ b/challenge-077/andinus/README @@ -1,102 +1,52 @@ ━━━━━━━━━━━━━━━ - CHALLENGE 076 + CHALLENGE 077 ━━━━━━━━━━━━━━━ Table of Contents ───────────────── -1 Task 1 - Prime Sum +1 Task 1 - Fibonacci Sum .. 1.1 Perl -1 Task 1 - Prime Sum -════════════════════ +1 Task 1 - Fibonacci Sum +════════════════════════ - You are given a number `$N'. Write a script to find the minimum number - of prime numbers required, whose summation gives you `$N'. + You are given a positive integer `$N'. - • For the sake of this task, please assume 1 is not a prime number. + Write a script to find the total number of Fibonacci Numbers required + to get `$N' on addition. You are NOT allowed to repeat a number. Print + 0 if none found. + + *Note*: This solution is incomplete. Others have pushed complete + solutions, look at those. 1.1 Perl ──────── • Program: [file:perl/ch-1.pl] - • Help taken from: [https://stackoverflow.com/a/35756072]. - - User input is stored in `$input'. - ┌──── - │ my $input = shift @ARGV; - │ chomp $input; - └──── - - 1 is assumed not to be a prime number so we reject numbers less than - or equal to 1. - ┌──── - │ die "Invalid input, enter numbers greater than 1.\n" if $input <= 1; - └──── - - If it's a prime number then the minimum sum is the number itself so we - just return it & exit. - ┌──── - │ say $input and exit 0 if is_prime($input) == 1; - └──── - - If `$input' is even then we loop from 2 to `$input / 2' & check if - both `$i' & `$diff' are primes. If both are primes then we have our - numbers. - Eventually we'll find 2 primes to be a sum of even numbers. From - WikiPedia, [Goldbach's conjecture] has been shown to hold for all - integers less than `4 × 10^18'. + Make a list of all possible sums of `$input'. ┌──── - │ if ($input % 2 == 0) { - │ foreach my $i (2 ... $input / 2) { - │ my $diff = $input - $i; - │ say "$i + $diff" - │ if is_prime($i) and is_prime($diff); - │ } + │ my @sums; + │ foreach my $num (0 ... $input / 2) { + │ my $diff = $input - $num; + │ push @sums, [$diff, $num]; │ } └──── - If the input is odd then we first check if `$input - 2' is a prime, if - it is then input is the sum of two primes, 2 & `$input - 2'. + Loop over `@sums' & then print those sets which have both `$sums->[0]' + & `$sums->[1]' in fibonacci series. ┌──── - │ elsif (is_prime($input - 2)) { - │ say "2 + $input"; - │ } - └──── - - If even that doesn't match then the minimum sum will have three - numbers. 3 & then we use the same function as for even numbers to find - the other two primes. - ┌──── - │ else { - │ foreach my $i (2 ... ($input - 3) / 2) { - │ my $diff = $input - 3 - $i; - │ say "3 + $i + $diff" - │ if is_prime($i) and is_prime($diff); - │ } - │ } - └──── - - If $num is divisible by any number between 2 & `sqrt($num)' then it's - not prime. - ┌──── - │ sub is_prime { - │ my $num = shift @_; + │ sub is_fib { return Math::Fibonacci::isfibonacci(@_) } │ - │ foreach my $i (2 ... sqrt($num)) { - │ return 0 if $num % $i == 0; - │ } - │ return 1; + │ foreach (@sums) { + │ next unless is_fib($_->[0]) and is_fib($_->[1]); + │ say "$_->[0] + $_->[1]"; │ } └──── - - -[Goldbach's conjecture] -https://en.wikipedia.org/wiki/Goldbach%2527s_conjecture diff --git a/challenge-077/andinus/blog-1.txt b/challenge-077/andinus/blog-1.txt new file mode 100644 index 0000000000..3758cbc1da --- /dev/null +++ b/challenge-077/andinus/blog-1.txt @@ -0,0 +1 @@ +https://andinus.tilde.institute/pwc/challenge-077/ diff --git a/challenge-077/andinus/perl/ch-1.pl b/challenge-077/andinus/perl/ch-1.pl new file mode 100755 index 0000000000..83a03c6069 --- /dev/null +++ b/challenge-077/andinus/perl/ch-1.pl @@ -0,0 +1,25 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use feature 'say'; + +use Math::Fibonacci; + +my $input = shift @ARGV; +chomp $input; + +die "Invalid input, enter numbers greater than 0.\n" if $input < 0; + +my @sums; +foreach my $num (0 ... $input / 2) { + my $diff = $input - $num; + push @sums, [$diff, $num]; +} + +sub is_fib { return Math::Fibonacci::isfibonacci(@_) } + +foreach (@sums) { + next unless is_fib($_->[0]) and is_fib($_->[1]); + say "$_->[0] + $_->[1]"; +} diff --git a/challenge-077/arne-sommer/blog.txt b/challenge-077/arne-sommer/blog.txt new file mode 100644 index 0000000000..80ea989b42 --- /dev/null +++ b/challenge-077/arne-sommer/blog.txt @@ -0,0 +1 @@ +https://raku-musings.com/lonely-sum.html diff --git a/challenge-077/arne-sommer/raku/ch-1.p6 b/challenge-077/arne-sommer/raku/ch-1.p6 new file mode 100755 index 0000000000..719e169ecf --- /dev/null +++ b/challenge-077/arne-sommer/raku/ch-1.p6 @@ -0,0 +1,60 @@ +#! /usr/bin/env raku + +subset PositiveInt of Int where * >= 1; + +unit sub MAIN (PositiveInt $N, :v(:$verbose), :u(:$upto)); + +my $label; +my $found; + + +$upto + ?? (1..$N).map({ fibonal-decomposition($_) }) + !! fibonal-decomposition($N); + +sub fibonal-decomposition($target) +{ + $found = False; + $label = 'a'; + + my @fibs; + my $fibonacci := (1, 1, * + * ... Inf); + + for $fibonacci -> $fib { last if $fib > $target; @fibs.unshift: $fib; } + @fibs.pop; + + if $verbose + { + say ": Target: $target" if $upto; + say ": Fibonacci (reverse): { @fibs.join(", ") }"; + } + + recurse(0, (), @fibs, $target); + + say "0" unless $found; + say "" if $upto; +} + +sub recurse ($value is copy, @values is copy, @fibonacci is copy, $input) +{ + if $value < $input + { + while @fibonacci + { + my $add = @fibonacci.shift; + + if $value + $add <= $input + { + my $value2 = $value + $add; + my @values2 = @values.clone.push: $add; |