Peter’s blog ✴ Week 303 ✴ 6 January 2025

THE WEEKLY CHALLENGE
Even and earn

The Perl Camel

Task 1

3-digits even

You are given a list (3 or more) of positive integers, @ints. Write a script to return all even 3-digits integers that can be formed using the integers in the given list.

Examples


Example 1
Input: @ints = (2, 1, 3, 0)
Output: (102, 120, 130, 132, 210, 230, 302, 310, 312, 
   320)

Example 2
Input: @ints = (2, 2, 8, 8, 2)
Output: (222, 228, 282, 288, 822, 828, 882)

Analysis

This is an interesting challenge in there are two generic classes of solution.

Firstly we could use subsets and permutations, say from Algorithm::Combinatorics. In step 1 we take all subsets from @ints, and then all permutations of each subset. For each permutation we concatenate the members and see if the result is 3 digits long, even and unique. There's a lot of calculation in that, but it works and gives the correct result within a couple of seconds for up to 10 members in @ints. It then gets rapidly slower.

The second method, which is what I have submitted, is more complicated, but it does handle @ints even up to 100 members in a few seconds.

In summary, it:

  • Discards any input number with 4 or more digits.
  • Adds any even 3-digit number to the list of results.
  • Discards any odd 3-digit number.
  • Makes lists of odd or even one- or two-digit numbers, ie 4 such lists.
  • Adds to the list of results any 1-digit number followed by any even 2-digit number.
  • Adds to the list of results any 2-digit number followed by any even 1-digit number.
  • Adds to the list of results any 3 1-digit numbers where the third one is even.

That's rather messy, but it is pretty fast.

Perl Weekly’s review

from PW issue 703

Breakdown of a task into smaller subtask is very handy and easy to follow. Nice to see the use of new Perl camel.

This review may cover either or both challenges for this week.

Try it 

Try running the script with any input:



example: 1, 2, 3, 4, 5

Script


#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2025-01-06
use utf8;     # Week 303 - task 1 - 3-digits even
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

three_digits_even(2, 2, 8, 8, 2);
three_digits_even(12, 7, 99, 9);
three_digits_even(22, 44, 66);
three_digits_even(122, 244, 366);
three_digits_even(1, 2, 3, 4, 5);
three_digits_even(1, 12, 124, 1234, 4, 2);

# longer example
my @ints;
push @ints, int(rand(100)) for 0 .. 30;
three_digits_even(@ints);

sub three_digits_even {
    
    my (@ints, $j, $int, %results, @even_ones, @even_twos, @odd_ones, @odd_twos,
        @all_ones, $a, $b, $k, $l);
    
    @ints = @_;
    
    # first pass through
    for $j (0 .. $#ints) {
        $int = $ints[$j];
        
        # anything longer than 3 digits can be discarded
        next if length($int) > 3;
        
        # anything 3 digits long and even can be added to results
        if (length($int) == 3) {
            $results{$int} = 1 if ($int & 1) == 0;
            next;
        }
        
        # now make lists of twos and ones
        if ($int =~ m|^[24680]$|) {
            push @even_ones, $int;
        } elsif ($int =~ m|^[13579]$|) {
            push @odd_ones, $int;
        } elsif ($int =~ m|[24680]$|) {
            push @even_twos, $int;
        } else {
            push @odd_twos, $int;
        }
    }
        
    # valid results are any one followed by an even two
    for $a (@even_ones, @odd_ones) {
        for $b (@even_twos) {
            $results{"$a$b"} = 1;
        }
    }
    
    # or any two followed by an even one
    for $a (@even_twos, @odd_twos) {
        for $b (@even_ones) {
            $results{"$a$b"} = 1;
        }
    }
    
    # or any two ones followed by an even one
    @all_ones = (@even_ones, @odd_ones);
    for $j (0 .. scalar @all_ones - 1) {
        for $k (0 .. scalar @all_ones - 1) {
            next if $j == $k;
            for $l (0 ... scalar @all_ones - 1) {
                next if $l == $j or $l == $k or ($all_ones[$l] & 1);
                $results{"$all_ones[$j]$all_ones[$k]$all_ones[$l]"} = 1;
            }
        }
    }

    say qq[\nInput:  \@ints = (] . join(', ', @ints) . ')';
    say qq[Output: (] . join(', ', sort keys %results) . ')';
}

33 lines of code

Output from script


Input:  @ints = (2, 2, 8, 8, 2)
Output: (222, 228, 282, 288, 822, 828, 882)

Input:  @ints = (12, 7, 99, 9)
Output: (712, 912)

Input:  @ints = (22, 44, 66)
Output: ()

Input:  @ints = (122, 244, 366)
Output: (122, 244, 366)

Input:  @ints = (1, 2, 3, 4, 5)
Output: (124, 132, 134, 142, 152, 154, 214, 234, 254, 
312, 314, 324, 342, 352, 354, 412, 432, 452, 512, 514, 
524, 532, 534, 542)

Input:  @ints = (1, 12, 124, 1234, 4, 2)
Output: (112, 122, 124, 142, 212, 214, 412)

Input:  @ints = (9, 69, 63, 53, 19, 32, 43, 83, 97, 79, 
89, 5, 25, 99, 48, 90, 32, 74, 8, 74, 72, 30, 28, 58, 
38, 87, 52, 30, 88, 73, 6)
Output: (196, 198, 256, 258, 286, 288, 306, 308, 326, 
328, 386, 388, 436, 438, 486, 488, 526, 528, 530, 532, 
536, 538, 548, 552, 558, 568, 572, 574, 586, 588, 590, 
596, 598, 628, 630, 632, 636, 638, 648, 652, 658, 672, 
674, 688, 690, 696, 698, 726, 728, 736, 738, 746, 748, 
796, 798, 828, 830, 832, 836, 838, 848, 852, 856, 858, 
872, 874, 876, 878, 886, 888, 890, 896, 898, 906, 908, 
928, 930, 932, 938, 948, 952, 956, 958, 968, 972, 974, 
976, 978, 986, 988, 990, 996, 998)

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain