diff options
| author | drbaggy <js5@sanger.ac.uk> | 2022-04-19 16:52:49 +0100 |
|---|---|---|
| committer | drbaggy <js5@sanger.ac.uk> | 2022-04-19 16:52:49 +0100 |
| commit | 5c74ac3a3499745b3c613a3babaf491a383ce0b4 (patch) | |
| tree | 05304ae5e7c88b8512d1dd9f8756d059dd494143 | |
| parent | c89eb7292f6b5517201178dd44f3b2d0b2066e85 (diff) | |
| parent | 6b9d7c0b66ade4bdb685e5294f7a3c1a574bb749 (diff) | |
| download | perlweeklychallenge-club-5c74ac3a3499745b3c613a3babaf491a383ce0b4.tar.gz perlweeklychallenge-club-5c74ac3a3499745b3c613a3babaf491a383ce0b4.tar.bz2 perlweeklychallenge-club-5c74ac3a3499745b3c613a3babaf491a383ce0b4.zip | |
Merge remote-tracking branch 'upstream/master'
| -rw-r--r-- | challenge-161/pokgopun/perl/ch-1.pl | 31 | ||||
| -rw-r--r-- | challenge-161/pokgopun/perl/ch-2.pl | 52 |
2 files changed, 83 insertions, 0 deletions
diff --git a/challenge-161/pokgopun/perl/ch-1.pl b/challenge-161/pokgopun/perl/ch-1.pl new file mode 100644 index 0000000000..f792a41e4d --- /dev/null +++ b/challenge-161/pokgopun/perl/ch-1.pl @@ -0,0 +1,31 @@ +use strict; +use warnings; + +my $dict = @ARGV ? shift : "../../../data/dictionary.txt"; + +sub abc{ + my $dict = shift; + my $IN; + unless (open $IN, "<$dict"){ + $IN = [qw/forty hippy bees buzz a dirty nosy chimps/]; + } + my @abc; + while (my $line = ref $IN eq 'GLOB' ? <$IN> : shift @$IN){ + chomp $line; + my @a = split //,$line; + my @b; + { + push @b, shift @a; + last unless @a; + last if $b[-1] gt $a[0]; + redo; + } + push @abc,$line if length($line)==@b; + } + @abc = sort{ length $b <=> length $a} @abc unless ref $IN eq 'ARRAY'; + return @abc +} + +printf "%s\n", join(", ",abc($dict)); + + diff --git a/challenge-161/pokgopun/perl/ch-2.pl b/challenge-161/pokgopun/perl/ch-2.pl new file mode 100644 index 0000000000..31d2154131 --- /dev/null +++ b/challenge-161/pokgopun/perl/ch-2.pl @@ -0,0 +1,52 @@ +use strict; +use warnings; + +my $debug = 1; + +my $dict = @ARGV ? shift : "../../../data/dictionary.txt"; +my $i = 0; +{ + my $IN; + unless (open $IN, "<$dict"){ + $IN = [qw/the quick brown fox jumps over the lazy dog/]; + } + my @w; + my %seen; + my $best; + my $seen = ""; + while (my $line = ref $IN eq 'GLOB' ? <$IN> : shift @$IN){ + next unless ord(substr($line,0,1)) >= 97 + $i; + chomp $line; + $best = $line unless defined $best; + if (substr($best,0,1) eq substr($line,0,1)){ + next if scalar( grep{ $seen !~ /\b$_\b/ } split //, $best ) >= scalar( grep{ $seen !~ /\b$_\b/ } split //, $line ); + $best = $line; + next; + } + #print "$best,$line\n"; + ($line,$best) = ($best,$line); + push @w,$line; + $seen{$_}++ foreach split //, $line; + last if keys %seen == 26; + $seen = join(" ",keys %seen); + } + if (keys %seen < 26) { + push @w, $best; + $seen{$_}++ foreach split //, $best; + } + last if keys %seen < 26; + printf "%s\n", join(" ",@w); + if ($debug) { + printf "=> %d words, %d letters and %d unique letters\n", scalar @w, length(join "", @w), scalar keys %seen; + if ($debug > 1) { + foreach (sort keys %seen) { + my $p = join(" ", @w); + $p =~ s/($_)/\U$1/g; + printf "%s => %s\n", $_, $p; + } + } + } + print "\n"; + $i++; + redo if ref $IN eq 'GLOB'; +} |
