From 46be4e92480297f18f53e46eb0c97bc2304c05cf Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Mon, 11 Mar 2024 09:55:32 -0500 Subject: Week 260 solutions --- challenge-260/bob-lied/README | 6 ++-- challenge-260/bob-lied/perl/ch-1.pl | 56 ++++++++++++++++++++++++++++++++ challenge-260/bob-lied/perl/ch-2.pl | 65 +++++++++++++++++++++++++++++++++++++ 3 files changed, 124 insertions(+), 3 deletions(-) create mode 100644 challenge-260/bob-lied/perl/ch-1.pl create mode 100644 challenge-260/bob-lied/perl/ch-2.pl diff --git a/challenge-260/bob-lied/README b/challenge-260/bob-lied/README index 0353728dfd..4ba7ab0b4f 100644 --- a/challenge-260/bob-lied/README +++ b/challenge-260/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 259 by Bob Lied +Solutions to weekly challenge 260 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-259/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-259/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-260/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-260/bob-lied diff --git a/challenge-260/bob-lied/perl/ch-1.pl b/challenge-260/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..ae96d1a815 --- /dev/null +++ b/challenge-260/bob-lied/perl/ch-1.pl @@ -0,0 +1,56 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2024, Bob Lied +#============================================================================= +# +# ch-1.pl Perl Weekly Challenge 260 Task 1 Unique Occurrences +#============================================================================= +# You are given an array of integers, @ints. +# Write a script to return 1 if the number of occurrences of each value +# in the given array is unique or 0 otherwise. +# Example 1 Input: @ints = (1,2,2,1,1,3) +# Output: 1 +# The number 1 occurred 3 times. +# The number 2 occurred 2 times. +# The number 3 occurred 1 time. +# All occurrences are unique, therefore the output is 1. +# Example 2 Input: @ints = (1,2,3) +# Output: 0 +# Example 3 Input: @ints = (-2,0,1,-2,1,1,0,1,-2,9) +# Output: 1 +#============================================================================= + +use v5.38; + +use builtin qw/true false/; no warnings "experimental::builtin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say uniqOcc(@ARGV); + +sub uniqOcc(@ints) +{ + use List::MoreUtils qw/frequency all/; + + my %intFrequency = frequency(@ints); + my %occurFreq = frequency( values %intFrequency ); + + return ( all { $_ == 1 } values %occurFreq ) ? 1 : 0; +} + +sub runTest +{ + use Test2::V0; + + is( uniqOcc(1,2,2,1,1,3), 1, "Example 1"); + is( uniqOcc(1,2,3) , 0, "Example 2"); + is( uniqOcc(-2,0,1,-2,1,1,0,1,-2,9), 1, "Example 3"); + + done_testing; +} diff --git a/challenge-260/bob-lied/perl/ch-2.pl b/challenge-260/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..37a7a8d921 --- /dev/null +++ b/challenge-260/bob-lied/perl/ch-2.pl @@ -0,0 +1,65 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2024, Bob Lied +#============================================================================= +# ch-2.pl Perl Weekly Challenge 260 Task 2 Dictionary Rank +#============================================================================= +# You are given a word, $word. +# Write a script to compute the dictionary rank of the given word. +# Example 1 Input: $word = 'CAT' +# Output: 3 +# All possible combinations of the letters: +# CAT, CTA, ATC, TCA, ACT, TAC +# Arrange them in alphabetical order: +# ACT, ATC, CAT, CTA, TAC, TCA +# CAT is the 3rd in the list. +# Therefore the dictionary rank of CAT is 3. +# +# Example 2 Input: $word = 'GOOGLE' +# Output: 88 +# Example 3 Input: $word = 'SECRET' +# Output: 255 +#============================================================================= + +use v5.38; + +use builtin qw/true false/; no warnings "experimental::builtin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say dictOrder($_) for @ARGV; + +sub dictOrder($word) +{ + use List::Permutor; + + my $perm = List::Permutor->new( sort { $a cmp $b } split(//, $word) ); + my $place = 0; + my %seen; # Skip duplicate letters + while ( my $p = join("", $perm->next()) ) + { + next if $seen{$p}; + $place++; + say "$place $p" if $Verbose; + last if $p eq $word; + $seen{$p} = true; + } + return $place; +} + +sub runTest +{ + use Test2::V0; + + is( dictOrder("CAT"), 3, "Example 1"); + is( dictOrder("GOOGLE"), 88, "Example 2"); + is( dictOrder("SECRET"), 255, "Example 3"); + + done_testing; +} -- cgit