diff options
| -rwxr-xr-x | challenge-083/alexander-pankoff/perl/ch-1.pl | 52 | ||||
| -rwxr-xr-x | challenge-083/alexander-pankoff/perl/ch-2.pl | 84 |
2 files changed, 136 insertions, 0 deletions
diff --git a/challenge-083/alexander-pankoff/perl/ch-1.pl b/challenge-083/alexander-pankoff/perl/ch-1.pl new file mode 100755 index 0000000000..b851e4bdfe --- /dev/null +++ b/challenge-083/alexander-pankoff/perl/ch-1.pl @@ -0,0 +1,52 @@ +#!/usr/bin/env perl +use v5.20; +use utf8; +use strict; +use warnings; +use autodie; +use feature qw(say signatures); +no warnings 'experimental::signatures'; + +use List::Util qw(sum0); + +use Pod::Usage; + +pod2usage( + -message => "$0: Expects exactly one argument", + -exitval => 1, +) if @ARGV != 1; + +my ($S) = @ARGV; + +say words_length($S); + +sub words_length($str) { + my @words = grep { length $_ } split( /\s+/, $str ); + die "need 3 or more words\n" unless @words >= 3; + return sum0( map { length $_ } @words[ 1 .. $#words - 1 ] ); +} + +=pod + +=head1 NAME + +wk-083 ch-1 - Words Length + +=head1 SYNOPSIS + +You are given a string $S with 3 or more words. + +Write a script to find the length of the string except the first and last words ignoring whitespace. + +ch-1.pl <S> + +=head1 ARGUMENTS + +=over 8 + +=item B<S> The input string + + +=back + +=cut diff --git a/challenge-083/alexander-pankoff/perl/ch-2.pl b/challenge-083/alexander-pankoff/perl/ch-2.pl new file mode 100755 index 0000000000..2e3ca72fca --- /dev/null +++ b/challenge-083/alexander-pankoff/perl/ch-2.pl @@ -0,0 +1,84 @@ +#!/usr/bin/env perl +use v5.20; +use utf8; +use strict; +use warnings; +use autodie; +use feature qw(say signatures); +no warnings 'experimental::signatures'; + +use Carp qw(croak); +use List::Util qw(any first sum0); +use Scalar::Util qw(looks_like_number); + +use Pod::Usage; + +pod2usage( + -message => "$0: Expects a list of positive numbers", + -exitval => 1, +) if !@ARGV || any { !looks_like_number($_) || $_ < 1 } @ARGV; + +say flip_array(@ARGV); + +sub flip_array(@numbers) { + my $sum = sum0(@numbers); + my $ceiling = int( $sum / 2 ); + + for my $target ( reverse( 0 .. $ceiling ) ) { + my $count = first( + sub { + any { sum0(@$_) eq $target } combinations( $_, @numbers ); + }, + 1 .. @numbers + ); + + return $count if $count; + } + + return 0; +} + +# returns possible combinations of $length elements from @pool. +sub combinations ( $count, @pool ) { + croak "cannot build combinations with $count elements from a list of " + . scalar(@pool) + . " elements" + if $count > @pool; + return () if $count == 0; + return map { [$_] } @pool if $count == 1; + + my @combinations; + while ( @pool && $count <= @pool ) { + my $elem = shift @pool; + my @sub_combinations = combinations( $count - 1, @pool ); + push @combinations, map { [ $elem, @$_, ] } @sub_combinations; + } + + return @combinations; +} + +=pod + +=head1 NAME + +wk-083 ch-2 - Flip Array + +=head1 SYNOPSIS + +You are given an array @A of positive numbers. + +Write a script to flip the sign of some members of the given array so that the sum of the all members is minimum non-negative. + +Given an array of positive elements, you have to flip the sign of some of its elements such that the resultant sum of the elements of array should be minimum non-negative(as close to zero as possible). Return the minimum no. of elements whose sign needs to be flipped such that the resultant sum is minimum non-negative. + +ch-2.pl <A> <A> ... + +=head1 ARGUMENTS + +=over 8 + +=item B<A> a list of positive numbers + +=back + +=cut |
