Bill-Costa/car-options.pl

## car-options.pl
#!/usr/bin/env perl
#
#         File:	car-options.pl
#     Abstract:	Demonstrate sparse lookup table as multi-dimensional hash.
#        Usage: ./car-options [keyword ...]
#       Author:	Bill.Costa@alumni.unh.edu
#      License:	Perl Artistic
#          See: https://dev.to/billcosta/way-too-many-if-then-elses-try-a-lookup-table-3j2o
#       Beware: https://perlmaven.com/autovivification
#

my $HELP_TEXT = <<'EOM';

This program is designed to demonstrate a technique where a sparse
lookup table can be easily represented using a multi-dimensional
'associative array'.  This particular implementation uses Perl hash
tables, but the general technique should be applicable to other
programming languages with associative array support.

The motivation for the demo is validating selected options for a
particular make and model of automobile with five trim lines.  The
allowed combination of options can be represented as:

    ---------  -------------  ---------------  --------------  ------
      Trim       Interior         Wheels        Transmission   Cruise
    ---------  -------------  ---------------  --------------  ------
    Base          cloth         steel|alloy        manual       n/a
    Premium    cloth|leather       alloy        manual|auto     std
    Sport       sport-cloth   18" black-alloy  6-speed manual   opt
    Limited    cloth|leather       alloy        manual|auto     std
    Touring      leather         18" alloy          auto        std
    ---------  -------------  ---------------  --------------  ------

For example, the only option available for the 'Base' trim line is
alloy wheels instead of the stock steel wheels.  Likewise the only
option for the 'Sport' trim is cruise-control, but the 'Sport' trim
comes with exclusive two-tone seats, special alloy wheels, and a
special manual transmission, none of which are available for any other
trim lines.  In contrast the 'Premium' can be had with a cloth or
leather interior and a choice of a manual or automatic transmission.

The interactive demonstration allows you to enter a trim line,
followed by the desired interior, wheels, transmission, and if cruise
control is wanted.  If that set of options is allowed, the 'Bundle ID'
is displayed, otherwise an exception is thrown.  Enter at least the
trim line keyword (or its abbreviation) on the command line.  Any
missing options will be prompted for.

    $ ./car-options.pl b

    Enter desired options for the BASE trim

           Interior? (cloth leather sport): c
       Wheels? (steel alloy sport touring): st
         Transmission? (manual auto sport): m
                     Cruise Control? (0 1): 0

        Given:            Trim: base
                      Interior: cloth
                        Wheels: steel
                  Transmission: manual
                Cruise Control: 0

    Selected Bundle: B1
    $

The following full command line would be equivalent to the above:

    $ ./car-options.pl b c st m 0

Note that invalid keywords may be entered for testing the lookup
validation, and ambiguous abbreviations are accepted as-is.

EOM

use warnings;
use strict;
use Text::Abbrev;	# For command line abbreviations
use Carp;		# For logic error stack trace.

#==============================================================================
#  The following code segment demonstrates the technique being
#  illustrated.  An exception is thrown if an invalid option
#  combination is proved or an expected keyword is misspelled.

#---------------------------------------+
# Set of valid bundle combinations.	|
#---------------------------------------+

my %bundle = ();
#       Trim      Interior  Wheels    Trannie  Cruise  Bundle
#       --------- --------- --------- -------- ------  ------
$bundle {base}    {cloth}   {steel}   {manual} {0}   = 'B1';
$bundle {base}    {cloth}   {alloy}   {manual} {0}   = 'B2';
$bundle {premium} {cloth}   {alloy}   {manual} {0}   = 'P1';
$bundle {premium} {leather} {alloy}   {manual} {0}   = 'P2';
$bundle {premium} {cloth}   {alloy}   {auto}   {0}   = 'P3';
$bundle {premium} {leather} {alloy}   {auto}   {0}   = 'P4';
$bundle {sport}   {sport}   {sport}   {sport}  {0}   = 'S1';
$bundle {sport}   {sport}   {sport}   {sport}  {1}   = 'S2';
$bundle {limited} {cloth}   {alloy}   {manual} {1}   = 'L1';
$bundle {limited} {leather} {alloy}   {manual} {1}   = 'L2';
$bundle {limited} {cloth}   {alloy}   {auto}   {1}   = 'L3';
$bundle {limited} {leather} {alloy}   {auto}   {1}   = 'L4';
$bundle {touring} {leather} {touring} {auto}   {1}   = 'T1';

#---------------------------------------+
# Supports validation of keyword sets.	|
#---------------------------------------+

$bundle {ANY}     {cloth}   {ANY}     {ANY}    {ANY} = 1;
$bundle {ANY}     {sport}   {ANY}     {ANY}    {ANY} = 1;
$bundle {ANY}     {leather} {ANY}     {ANY}    {ANY} = 1;
$bundle {ANY}     {ANY}     {steel}   {ANY}    {ANY} = 1;
$bundle {ANY}     {ANY}     {alloy}   {ANY}    {ANY} = 1;
$bundle {ANY}     {ANY}     {sport}   {ANY}    {ANY} = 1;
$bundle {ANY}     {ANY}     {touring} {ANY}    {ANY} = 1;
$bundle {ANY}     {ANY}     {ANY}     {manual} {ANY} = 1;
$bundle {ANY}     {ANY}     {ANY}     {sport}  {ANY} = 1;
$bundle {ANY}     {ANY}     {ANY}     {auto}   {ANY} = 1;
$bundle {ANY}     {ANY}     {ANY}     {ANY}    {0}   = 1;
$bundle {ANY}     {ANY}     {ANY}     {ANY}    {1}   = 1;

#---------------------------------------+
# Function to validate option mix and	|
# return the Trim's Bundle code.	|
#---------------------------------------+

sub fail ( $ $ ) { confess("Invalid ", uc($_[0]), " keyword: '$_[1]'\n_") }

sub bundleLookup ( $ $ $ $ $ )
{
  foreach my $param (@_)  # this modifies contents of array @_
    {
      confess("Required parameter is undefined") if (not defined($param));
      $param = lc($param);
    }

  my($trim, $seats, $wheels, $trans, $cruise) = @_;

  confess("Not a recognized trim line: $trim\n_")
    if (not exists($bundle{$trim}));

  return($bundle{$trim}{$seats}{$wheels}{$trans}{$cruise})
    if (exists($bundle{$trim}{$seats}{$wheels}{$trans}{$cruise}));

  # Uh, oh -- still here.  Was there a bad keyword?

  fail('seats',$seats)   if (not exists($bundle{ANY}{$seats}{ANY}{ANY}{ANY}));
  fail('wheels',$wheels) if (not exists($bundle{ANY}{ANY}{$wheels}{ANY}{ANY}));
  fail('trans',$trans)   if (not exists($bundle{ANY}{ANY}{ANY}{$trans}{ANY}));
  fail('cruise',$cruise) if (not exists($bundle{ANY}{ANY}{ANY}{ANY}{$cruise}));

  # Must have been an invalid bundle.

  confess("Invalid option combination for trim line: $trim\n_");
}

#==============================================================================
# The following code is used to support the interactive testing of
# bundleLookup() function from the command line.  The lookup table
# keywords sets are defined here only to allow the convenience of
# abbreviation while testing and are not used to validate the input.
# The user can (and is encouraged) to enter invalid trim and option
# data for testing the bundleLookup() response.

my @trimKeyWord     = qw(base premium sport limited touring);
my @interiorKeyWord = qw(cloth leather sport);
my @wheelsKeyWord   = qw(steel alloy sport touring);
my @trannieKeyWord  = qw(manual auto sport);
my @cruiseKeyWord   = qw(0 1);

sub isMissing { return(not (defined($_[0]) and  $_[0] !~ m/^\s*$/)) }

#------------------------------------------------------------------------------

sub askFor # prompt user and return entered value; expand valid abbreviations
{
  my($field, $val, $expected) = @_;
  die("? Missing required \$field param\n_") if (isMissing($field));
  die("? missing keywords list\n_")          if (scalar(@{$expected}) < 1);

  if (not defined($val))
    {
      printf("%40s", "$field? (" . join(' ', @{$expected}) . "): ");
      $val = <STDIN>;
      chomp($val);
    }

  my %kwAbbrev = abbrev(@{$expected});
  my $keyWord  = $kwAbbrev{$val};
  $keyWord = $val if (not defined($keyWord));
  return($keyWord);
}

#------------------------------------------------------------------------------

sub echoParams # echo entered data
{
  foreach my $param (@_) { $param = 'NUL' if (not defined($param)) }
  my($trim, $seats, $wheels, $trans, $cruise) = @_;

  print <<ECHO

    Given:            Trim: $trim
                  Interior: $seats
                    Wheels: $wheels
              Transmission: $trans
            Cruise Control: $cruise

ECHO
}

#------------------------------------------------------------------------------
# Main Line: get values from command line and/or prompt.

if (scalar(@ARGV) < 1)
  {
    print($HELP_TEXT);
    exit(0);
  }

foreach my $arg (@ARGV) { $arg = lc($arg) };

my $trim   = askFor('Trim',           shift(@ARGV), \@trimKeyWord);

print("\nEnter desired options for the ", uc($trim), " trim\n\n")
  if (scalar(@ARGV) == 0);

my $seats  = askFor('Interior',       shift(@ARGV), \@interiorKeyWord);
my $wheels = askFor('Wheels',         shift(@ARGV), \@wheelsKeyWord);
my $trans  = askFor('Transmission',   shift(@ARGV), \@trannieKeyWord);
my $cruise = askFor('Cruise Control', shift(@ARGV), \@cruiseKeyWord);

warn("? ignoring: '", join("', '", @ARGV), "'") if (scalar(@ARGV) > 0);

echoParams($trim, $seats, $wheels, $trans, $cruise);
my $bundleCode = bundleLookup($trim, $seats, $wheels, $trans, $cruise);
print("Selected Bundle: $bundleCode\n\n");

# EOF: car-options.pl
	#!/usr/bin/env perl
	#
	# File: car-options.pl
	# Abstract: Demonstrate sparse lookup table as multi-dimensional hash.
	# Usage: ./car-options [keyword ...]
	# Author: Bill.Costa@alumni.unh.edu
	# License: Perl Artistic
	# See: https://dev.to/billcosta/way-too-many-if-then-elses-try-a-lookup-table-3j2o
	# Beware: https://perlmaven.com/autovivification
	#

	my $HELP_TEXT = <<'EOM';

	This program is designed to demonstrate a technique where a sparse
	lookup table can be easily represented using a multi-dimensional
	'associative array'. This particular implementation uses Perl hash
	tables, but the general technique should be applicable to other
	programming languages with associative array support.

	The motivation for the demo is validating selected options for a
	particular make and model of automobile with five trim lines. The
	allowed combination of options can be represented as:

	--------- ------------- --------------- -------------- ------
	Trim Interior Wheels Transmission Cruise
	--------- ------------- --------------- -------------- ------
	Base cloth steel\|alloy manual n/a
	Premium cloth\|leather alloy manual\|auto std
	Sport sport-cloth 18" black-alloy 6-speed manual opt
	Limited cloth\|leather alloy manual\|auto std
	Touring leather 18" alloy auto std
	--------- ------------- --------------- -------------- ------

	For example, the only option available for the 'Base' trim line is
	alloy wheels instead of the stock steel wheels. Likewise the only
	option for the 'Sport' trim is cruise-control, but the 'Sport' trim
	comes with exclusive two-tone seats, special alloy wheels, and a
	special manual transmission, none of which are available for any other
	trim lines. In contrast the 'Premium' can be had with a cloth or
	leather interior and a choice of a manual or automatic transmission.

	The interactive demonstration allows you to enter a trim line,
	followed by the desired interior, wheels, transmission, and if cruise
	control is wanted. If that set of options is allowed, the 'Bundle ID'
	is displayed, otherwise an exception is thrown. Enter at least the
	trim line keyword (or its abbreviation) on the command line. Any
	missing options will be prompted for.

	$ ./car-options.pl b

	Enter desired options for the BASE trim

	Interior? (cloth leather sport): c
	Wheels? (steel alloy sport touring): st
	Transmission? (manual auto sport): m
	Cruise Control? (0 1): 0

	Given: Trim: base
	Interior: cloth
	Wheels: steel
	Transmission: manual
	Cruise Control: 0

	Selected Bundle: B1
	$

	The following full command line would be equivalent to the above:

	$ ./car-options.pl b c st m 0

	Note that invalid keywords may be entered for testing the lookup
	validation, and ambiguous abbreviations are accepted as-is.

	EOM

	use warnings;
	use strict;
	use Text::Abbrev; # For command line abbreviations
	use Carp; # For logic error stack trace.

	#==============================================================================
	# The following code segment demonstrates the technique being
	# illustrated. An exception is thrown if an invalid option
	# combination is proved or an expected keyword is misspelled.

	#---------------------------------------+
	# Set of valid bundle combinations. \|
	#---------------------------------------+

	my %bundle = ();
	# Trim Interior Wheels Trannie Cruise Bundle
	# --------- --------- --------- -------- ------ ------
	$bundle {base} {cloth} {steel} {manual} {0} = 'B1';
	$bundle {base} {cloth} {alloy} {manual} {0} = 'B2';
	$bundle {premium} {cloth} {alloy} {manual} {0} = 'P1';
	$bundle {premium} {leather} {alloy} {manual} {0} = 'P2';
	$bundle {premium} {cloth} {alloy} {auto} {0} = 'P3';
	$bundle {premium} {leather} {alloy} {auto} {0} = 'P4';
	$bundle {sport} {sport} {sport} {sport} {0} = 'S1';
	$bundle {sport} {sport} {sport} {sport} {1} = 'S2';
	$bundle {limited} {cloth} {alloy} {manual} {1} = 'L1';
	$bundle {limited} {leather} {alloy} {manual} {1} = 'L2';
	$bundle {limited} {cloth} {alloy} {auto} {1} = 'L3';
	$bundle {limited} {leather} {alloy} {auto} {1} = 'L4';
	$bundle {touring} {leather} {touring} {auto} {1} = 'T1';

	#---------------------------------------+
	# Supports validation of keyword sets. \|
	#---------------------------------------+

	$bundle {ANY} {cloth} {ANY} {ANY} {ANY} = 1;
	$bundle {ANY} {sport} {ANY} {ANY} {ANY} = 1;
	$bundle {ANY} {leather} {ANY} {ANY} {ANY} = 1;
	$bundle {ANY} {ANY} {steel} {ANY} {ANY} = 1;
	$bundle {ANY} {ANY} {alloy} {ANY} {ANY} = 1;
	$bundle {ANY} {ANY} {sport} {ANY} {ANY} = 1;
	$bundle {ANY} {ANY} {touring} {ANY} {ANY} = 1;
	$bundle {ANY} {ANY} {ANY} {manual} {ANY} = 1;
	$bundle {ANY} {ANY} {ANY} {sport} {ANY} = 1;
	$bundle {ANY} {ANY} {ANY} {auto} {ANY} = 1;
	$bundle {ANY} {ANY} {ANY} {ANY} {0} = 1;
	$bundle {ANY} {ANY} {ANY} {ANY} {1} = 1;

	#---------------------------------------+
	# Function to validate option mix and \|
	# return the Trim's Bundle code. \|
	#---------------------------------------+

	sub fail ( $ $ ) { confess("Invalid ", uc($_[0]), " keyword: '$_[1]'\n_") }

	sub bundleLookup ( $ $ $ $ $ )
	{
	foreach my $param (@_) # this modifies contents of array @_
	{
	confess("Required parameter is undefined") if (not defined($param));
	$param = lc($param);
	}

	my($trim, $seats, $wheels, $trans, $cruise) = @_;

	confess("Not a recognized trim line: $trim\n_")
	if (not exists($bundle{$trim}));

	return($bundle{$trim}{$seats}{$wheels}{$trans}{$cruise})
	if (exists($bundle{$trim}{$seats}{$wheels}{$trans}{$cruise}));

	# Uh, oh -- still here. Was there a bad keyword?

	fail('seats',$seats) if (not exists($bundle{ANY}{$seats}{ANY}{ANY}{ANY}));
	fail('wheels',$wheels) if (not exists($bundle{ANY}{ANY}{$wheels}{ANY}{ANY}));
	fail('trans',$trans) if (not exists($bundle{ANY}{ANY}{ANY}{$trans}{ANY}));
	fail('cruise',$cruise) if (not exists($bundle{ANY}{ANY}{ANY}{ANY}{$cruise}));

	# Must have been an invalid bundle.

	confess("Invalid option combination for trim line: $trim\n_");
	}

	#==============================================================================
	# The following code is used to support the interactive testing of
	# bundleLookup() function from the command line. The lookup table
	# keywords sets are defined here only to allow the convenience of
	# abbreviation while testing and are not used to validate the input.
	# The user can (and is encouraged) to enter invalid trim and option
	# data for testing the bundleLookup() response.

	my @trimKeyWord = qw(base premium sport limited touring);
	my @interiorKeyWord = qw(cloth leather sport);
	my @wheelsKeyWord = qw(steel alloy sport touring);
	my @trannieKeyWord = qw(manual auto sport);
	my @cruiseKeyWord = qw(0 1);

	sub isMissing { return(not (defined($_[0]) and $_[0] !~ m/^\s*$/)) }

	#------------------------------------------------------------------------------

	sub askFor # prompt user and return entered value; expand valid abbreviations
	{
	my($field, $val, $expected) = @_;
	die("? Missing required \$field param\n_") if (isMissing($field));
	die("? missing keywords list\n_") if (scalar(@{$expected}) < 1);

	if (not defined($val))
	{
	printf("%40s", "$field? (" . join(' ', @{$expected}) . "): ");
	$val = <STDIN>;
	chomp($val);
	}

	my %kwAbbrev = abbrev(@{$expected});
	my $keyWord = $kwAbbrev{$val};
	$keyWord = $val if (not defined($keyWord));
	return($keyWord);
	}

	#------------------------------------------------------------------------------

	sub echoParams # echo entered data
	{
	foreach my $param (@_) { $param = 'NUL' if (not defined($param)) }
	my($trim, $seats, $wheels, $trans, $cruise) = @_;

	print <<ECHO

	Given: Trim: $trim
	Interior: $seats
	Wheels: $wheels
	Transmission: $trans
	Cruise Control: $cruise

	ECHO
	}

	#------------------------------------------------------------------------------
	# Main Line: get values from command line and/or prompt.

	if (scalar(@ARGV) < 1)
	{
	print($HELP_TEXT);
	exit(0);
	}

	foreach my $arg (@ARGV) { $arg = lc($arg) };

	my $trim = askFor('Trim', shift(@ARGV), \@trimKeyWord);

	print("\nEnter desired options for the ", uc($trim), " trim\n\n")
	if (scalar(@ARGV) == 0);

	my $seats = askFor('Interior', shift(@ARGV), \@interiorKeyWord);
	my $wheels = askFor('Wheels', shift(@ARGV), \@wheelsKeyWord);
	my $trans = askFor('Transmission', shift(@ARGV), \@trannieKeyWord);
	my $cruise = askFor('Cruise Control', shift(@ARGV), \@cruiseKeyWord);

	warn("? ignoring: '", join("', '", @ARGV), "'") if (scalar(@ARGV) > 0);

	echoParams($trim, $seats, $wheels, $trans, $cruise);
	my $bundleCode = bundleLookup($trim, $seats, $wheels, $trans, $cruise);
	print("Selected Bundle: $bundleCode\n\n");

	# EOF: car-options.pl