usingMaths.com
From Theory to Practice - Math You Can Use.







<< PreviousNext >>

Code for Selection with Limits to Repetitions in Perl



Conditional Selection with Limits on Repetition.

So it's Christmas, and your mum delegates you, for some mysterious reason, to go buy nine (9) balloons - of any of the colours red, orange, yellow, green, blue, indigo, violet, pink, milk, white,- for home decoration.

But here's the catch. You are to buy:
  1. a minimum of 1 red balloon and a maximum of 4 red balloons;
  2. a minimum of 1 orange balloon and a maximum of 3 orange balloons;
  3. a minimum of 1 yellow balloon and a maximum of 2 yellow balloons;
  4. a minimum of 1 green balloon and a maximum of 4 green balloons;
  5. a minimum of 1 blue balloon and a maximum of 3 blue balloons;
  6. a minimum of 1 indigo balloon and a maximum of 2 indigo balloons;
  7. a minimum of 1 violet balloon and a maximum of 4 violet balloons;
  8. a minimum of 1 pink balloon and a maximum of 3 pink balloons;
  9. a minimum of 1 gray balloon and a maximum of 2 gray balloons;
  10. a minimum of 1 white balloon and a maximum of 4 white balloons.

With these conditions, every family member's favourite colour is covered for, and the decoration mix is also kept lively.

This is quite a handful for you to handle...



Code for Limited Repetitive Selection in Perl

The code for Selection with Conditioned Repetition will be based on that for Selection with boundless Repetition.

All that is needed after Selection with limitless Repetition is a Productive, as opposed to Summative, check of the results from the Selection with unconditioned Repetition for those options that meet our conditions.

This is how our Limited Repetitive Selection algorithm in Perl will work.

Create a new Perl module file;
Call it ConditionalSelection.pm.
Type out the adjoining Perl code for Selection with Conditioned Repetition.







Perl Code for ConditionalSelection.pm Module

package CONDITIONALSELECTION;

BEGIN {
    require Exporter;

    # for the sake of standard
    our $VERSION = 2017.10;

    # Inherit from exporter to export functions and variables
    our @ISA = qw(Exporter);

    # Functions and variables to be exported by default
    our @EXPORT_OK = qw(possibleWordCombinations);
}

use warnings;
use strict;

# simulate an object construct
sub new {
    my $self = shift;
    
    my $this = {};
    bless $this, $self;
    
    return $this;
}

# point of entry
# returns an array reference of references
sub limitedSelection {
    shift;
    my $arg = shift;
    my @words = @{$arg};
    my $r = shift;
    my $minimum = shift; # array reference
    my $maximum = shift; # array reference
    my @final_elements = (); # array of references
    
    use SELECTION;
    my $call = SELECTION->new();
    # $selection receives an array reference of references
    my $selection = $call->groupSelection(\@words, $r);
    
    for my $option (@{$selection}) {
        my $state = 0;
        for my $i (0 .. $#words) {
            # get 'words[j]' frequency/count in group
            my $count = grep {$_ eq $words[$i]} @{$option};
            if ($count >= $minimum->[$i] && $count <= $maximum->[$i]) {
                 $state = 1;
            } else {
                $state = 0;
                last;
            }
        }
        # skip if already in net
        if ($state) {
            push @final_elements, $option;
        }
    }
    return \@final_elements;
}

1;

Main Class

#!/usr/bin/perl;

use strict;
use warnings;

use CONDITIONALSELECTION;

my @subjects = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9");
my @min_occurrence = (0, 0, 1, 0, 0, 1, 0, 0, 1, 0);
my @max_occurrence = (4, 3, 2, 4, 3, 2, 4, 3, 2, 4);
my $r = 9;

# Use the conditionalselection module/class
my $choose = CONDITIONALSELECTION->new();

# $result receives an array reference of references
my $result = $choose->limitedSelection(\@subjects, $r, \@min_occurrence, \@max_occurrence);

print ("[", join(", ", @subjects), "] conditioned selection ", $r, ":\n\n");
# for each array reference in a dereferenced '$result'
my $i = 0;
print (++$i, ": ", join(", ", @{$_}), "\n") for @{$result};
print ("\n\nNumber of ways is ", scalar @{$result}, ".");

print "\n\n";



<< PreviousNext >>