From a7c58da7a3b34ebac2e8700067828491c798e681 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Mon, 19 Dec 2022 18:22:14 -0600 Subject: Solve PWC196 --- challenge-196/wlmb/blog.txt | 1 + challenge-196/wlmb/perl/ch-1.pl | 16 ++++++++++++++++ challenge-196/wlmb/perl/ch-2.pl | 28 ++++++++++++++++++++++++++++ 3 files changed, 45 insertions(+) create mode 100644 challenge-196/wlmb/blog.txt create mode 100755 challenge-196/wlmb/perl/ch-1.pl create mode 100755 challenge-196/wlmb/perl/ch-2.pl diff --git a/challenge-196/wlmb/blog.txt b/challenge-196/wlmb/blog.txt new file mode 100644 index 0000000000..6d63cb6435 --- /dev/null +++ b/challenge-196/wlmb/blog.txt @@ -0,0 +1 @@ +https://wlmb.github.io/2022/12/19/PWC196/ diff --git a/challenge-196/wlmb/perl/ch-1.pl b/challenge-196/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..f6862e7826 --- /dev/null +++ b/challenge-196/wlmb/perl/ch-1.pl @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +# Perl weekly challenge 196 +# Task 1: Pattern 132 +# +# See https://wlmb.github.io/2022/12/19/PWC196/#task-1-pattern-132 +use v5.36; +use Algorithm::Combinatorics qw(combinations); +say(<<"FIN"), exit unless @ARGV && @ARGV>=3; +Usage: $0 N1 N2 N3 [N4...] +to find the first 132 pattern in the sequence N1 N2... +FIN +my $c=combinations(\@ARGV, 3); +while(my $n=$c->next){ + say(join " ", @ARGV, "->", @$n), exit if $n->[0]<$n->[2]<$n->[1]; +} +say join " ", @ARGV, "->"; diff --git a/challenge-196/wlmb/perl/ch-2.pl b/challenge-196/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..2c2d389626 --- /dev/null +++ b/challenge-196/wlmb/perl/ch-2.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl +# Perl weekly challenge 196 +# Task 2: Range List +# +# See https://wlmb.github.io/2022/12/19/PWC196/#task-2-range-list +use v5.36; +use List::Util qw(all pairmap); + +say(<<"FIN"), exit unless @ARGV > 0; +Usage: $0 N1 [N2...] +to identify subsequences of contiguous intgers +FIN +say("Expected integer arguments"), exit unless all {/^[+-]?\d+$/} @ARGV; +my @input=my @rest=sort {$a <=> $b} @ARGV; # make sure list is sorted and make copies +my $previous=my $first=shift @rest; +say join " ", @input, "->", + pairmap {"[$a, $b]"} + map{subseq($_)} @rest, undef; # finish inputs with undef + +sub subseq($current){ # identify and output complete contiguous subsequences + my @output = $first<$previous ? ($first, $previous): (); + return @output if + !defined $current # input is consumed + && $first < $previous; # and a range has been found + $previous = $current, return () if $current==$previous+1; # not done yet + $first=$previous=$current; # prepare next sequence + return @output; +} -- cgit