commit a75730c8e44e52d2df37de85115a28d58e613bd2
parent 67062e2429a8393940d93c2ad6f90131c4cf8a57
Author: Samir Parikh <noreply@samirparikh.com>
Date: Fri, 28 Jan 2022 15:45:05 +0000
initial commit for strain
Diffstat:
4 files changed, 175 insertions(+), 0 deletions(-)
diff --git a/strain/HELP.md b/strain/HELP.md
@@ -0,0 +1,35 @@
+# Help
+
+## Running the tests
+
+There is a Perl 5 script with the extension `.t`, which will be used to test
+your solution. You can run through the tests by using the command:
+
+```bash
+`prove .`
+```
+
+## Submitting your solution
+
+You can submit your solution using the `exercism submit Strain.pm` command.
+This command will upload your solution to the Exercism website and print the solution page's URL.
+
+It's possible to submit an incomplete solution which allows you to:
+
+- See how others have completed the exercise
+- Request help from a mentor
+
+## Need to get help?
+
+If you'd like help solving the exercise, check the following pages:
+
+- The [Perl 5 track's documentation](https://exercism.org/docs/tracks/perl5)
+- [Exercism's support channel on gitter](https://gitter.im/exercism/support)
+- The [Frequently Asked Questions](https://exercism.org/docs/using/faqs)
+
+Should those resources not suffice, you could submit your (incomplete) solution to request mentoring.
+
+To get help if you're having trouble, you can use one of the following resources:
+
+- [/r/perl5](https://www.reddit.com/r/perl5) is the perl5 subreddit.
+- [StackOverflow](http://stackoverflow.com/questions/tagged/perl5) can be used to search for your problem and see if it has been answered already. You can also ask and answer questions.
+\ No newline at end of file
diff --git a/strain/README.md b/strain/README.md
@@ -0,0 +1,55 @@
+# Strain
+
+Welcome to Strain on Exercism's Perl 5 Track.
+If you need help running the tests or submitting your code, check out `HELP.md`.
+
+## Instructions
+
+Implement the `keep` and `discard` operation on collections. Given a collection
+and a predicate on the collection's elements, `keep` returns a new collection
+containing those elements where the predicate is true, while `discard` returns
+a new collection containing those elements where the predicate is false.
+
+For example, given the collection of numbers:
+
+- 1, 2, 3, 4, 5
+
+And the predicate:
+
+- is the number even?
+
+Then your keep operation should produce:
+
+- 2, 4
+
+While your discard operation should produce:
+
+- 1, 3, 5
+
+Note that the union of keep and discard is all the elements.
+
+The functions may be called `keep` and `discard`, or they may need different
+names in order to not clash with existing functions or concepts in your
+language.
+
+## Restrictions
+
+Keep your hands off that filter/reject/whatchamacallit functionality
+provided by your standard library! Solve this one yourself using other
+basic tools instead.
+
+## Source
+
+### Created by
+
+- @bistik
+
+### Contributed to by
+
+- @kytrinyx
+- @m-dango
+- @rfilipo
+
+### Based on
+
+Conversation with James Edward Gray II - https://twitter.com/jeg2
+\ No newline at end of file
diff --git a/strain/Strain.pm b/strain/Strain.pm
@@ -0,0 +1,17 @@
+package Strain;
+use strict;
+use warnings;
+use Exporter qw<import>;
+our @EXPORT_OK = qw<keep discard>;
+
+sub keep {
+ my ( $input, $function ) = @_;
+ return undef;
+}
+
+sub discard {
+ my ( $input, $function ) = @_;
+ return undef;
+}
+
+1;
diff --git a/strain/strain.t b/strain/strain.t
@@ -0,0 +1,66 @@
+#!/usr/bin/env perl
+use Test2::V0;
+
+use FindBin qw<$Bin>;
+use lib $Bin, "$Bin/local/lib/perl5";
+
+use Strain qw<keep discard>;
+
+imported_ok qw<keep discard> or bail_out;
+
+my ( $input, $expected, $function );
+
+$input = [];
+$expected = [];
+$function = sub { my $x = shift; $x % 2 == 0 };
+is( keep( $input, $function ), $expected, "empty list" );
+
+$input = [ 2, 4, 6, 8, 10 ];
+$expected = [];
+$function = sub { my $x = shift; $x % 2 == 1 };
+is( keep( $input, $function ),
+ $expected, "keep odd numbers. empty result " );
+
+$input = [ 2, 4, 6, 8, 10 ];
+$expected = [];
+$function = sub { my $x = shift; $x % 2 == 0 };
+is( discard( $input, $function ),
+ $expected, "discard even numbers. empty result" );
+
+$input = [ 2, 4, 6, 8, 10 ];
+$expected = [ 2, 4, 6, 8, 10 ];
+$function = sub { my $x = shift; $x % 2 == 0 };
+is( keep( $input, $function ),
+ $expected, "keep even numbers. result == input" );
+
+$input = [qw(dough cash plough though through enough)];
+$expected = ['cash'];
+$function = sub { my $x = shift; $x =~ m/ough$/ };
+is( discard( $input, $function ),
+ $expected, "discard input endswith 'ough'" );
+
+$input = [qw(zebra arizona apple google mozilla)];
+$expected = [qw(zebra arizona mozilla)];
+$function = sub { my $x = shift; $x =~ /z/ };
+is( keep( $input, $function ), $expected, "keep input with 'z'" );
+
+$input = [ '1,2,3', 'one', 'almost!', 'love' ];
+$expected = [];
+$function = sub { my $x = shift; $x =~ /\p{IsAlpha}/ };
+is( discard( keep( $input, $function ) // [], $function ),
+ $expected, "keep then discard" );
+
+$input = [ '1,2,3', 'one', 'almost!', 'love' ];
+$expected = [ '1,2,3', 'one', 'almost!', 'love' ];
+$function = sub { my $x = shift; $x =~ /\p{Alpha}/ };
+my $combined = [
+ @{ keep( $input, $function ) // [] },
+ @{ discard( $input, $function ) // [] }
+];
+is(
+ [ sort @$combined ],
+ [ sort @$expected ],
+ "combine keep and discard results. keep + discard"
+);
+
+done_testing;
