Toy demo program illustrating the use of a multi-dimensional associative array (hash) as a sparse lookup table.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment