diff options
| -rw-r--r-- | challenge-117/dave-jacoby/blog2.txt | 1 | ||||
| -rw-r--r-- | challenge-117/dave-jacoby/perl/ch-2b.pl | 40 |
2 files changed, 41 insertions, 0 deletions
diff --git a/challenge-117/dave-jacoby/blog2.txt b/challenge-117/dave-jacoby/blog2.txt new file mode 100644 index 0000000000..172f98a91b --- /dev/null +++ b/challenge-117/dave-jacoby/blog2.txt @@ -0,0 +1 @@ +https://jacoby.github.io/2021/06/15/perl-challenge-117-redux-permutations.html diff --git a/challenge-117/dave-jacoby/perl/ch-2b.pl b/challenge-117/dave-jacoby/perl/ch-2b.pl new file mode 100644 index 0000000000..2d1627875d --- /dev/null +++ b/challenge-117/dave-jacoby/perl/ch-2b.pl @@ -0,0 +1,40 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ postderef say signatures state }; +no warnings qw{ experimental }; + +use Carp; +use Getopt::Long; +use List::Util qw{ uniq }; +use Algorithm::Permute; + +my $n = 2; +GetOptions( 'number=i' => \$n ); +croak 'Too Small' if $n < 0; + +my @solutions = solve_triangle($n); +# say join ' ', ( scalar @solutions ), @solutions, ( scalar @solutions ); + +sub solve_triangle ( $n ) { + my @output; + my $string = 'R' x $n; + push @output, $string; + my %hash; + my $c = 1; + while ( $string =~ /R/ ) { + $string =~ s/R/LH/; + my @list = split //, $string; + my $p = Algorithm::Permute->new( \@list ); + while ( my @res = $p->next ) { + my $x = join '', @res; + next if $x =~ m{^H|L$}; + # push @output, $x; + next if $hash{$x}++; + say join "\t", $c, $x ; + $c++; + } + } + return sort { length $b <=> length $a } uniq @output; +} |