Blame


1 1ddd2d4e 2023-09-10 jrmu #!/usr/bin/perl
2 1ddd2d4e 2023-09-10 jrmu
3 1ddd2d4e 2023-09-10 jrmu # Get the rightmost program running (you can get the program from the
4 1ddd2d4e 2023-09-10 jrmu # Downloads section of http://www.intermediateperl.com/ if you don't want to
5 1ddd2d4e 2023-09-10 jrmu # type the whole thing yourself). Once you have the example working, modify
6 1ddd2d4e 2023-09-10 jrmu # the rightmost program, take a hash reference of patterns, and return the
7 1ddd2d4e 2023-09-10 jrmu # key of the rightmost match. Instead of calling it like:
8 1ddd2d4e 2023-09-10 jrmu #
9 1ddd2d4e 2023-09-10 jrmu # my $position = rightmost(
10 1ddd2d4e 2023-09-10 jrmu # 'There is Mrs. Howell, Ginger, and Gilligan',
11 1ddd2d4e 2023-09-10 jrmu # @patterns{ sort keys %patterns }
12 1ddd2d4e 2023-09-10 jrmu # );
13 1ddd2d4e 2023-09-10 jrmu #
14 1ddd2d4e 2023-09-10 jrmu # call it like:
15 1ddd2d4e 2023-09-10 jrmu #
16 1ddd2d4e 2023-09-10 jrmu # my $key = rightmost(
17 1ddd2d4e 2023-09-10 jrmu # 'There is Mrs. Howell, Ginger, and Gilligan',
18 1ddd2d4e 2023-09-10 jrmu # \%patterns
19 1ddd2d4e 2023-09-10 jrmu # )
20 1ddd2d4e 2023-09-10 jrmu
21 1ddd2d4e 2023-09-10 jrmu use v5.24;
22 1ddd2d4e 2023-09-10 jrmu use warnings;
23 1ddd2d4e 2023-09-10 jrmu use strict;
24 1ddd2d4e 2023-09-10 jrmu use utf8;
25 1ddd2d4e 2023-09-10 jrmu
26 1ddd2d4e 2023-09-10 jrmu sub rightmost {
27 1ddd2d4e 2023-09-10 jrmu my( $string, $pattern_ref ) = @_;
28 1ddd2d4e 2023-09-10 jrmu
29 1ddd2d4e 2023-09-10 jrmu my $rightmost = -1;
30 1ddd2d4e 2023-09-10 jrmu my $rightkey;
31 1ddd2d4e 2023-09-10 jrmu while ( my ($key, $regex) = each %$pattern_ref) {
32 1ddd2d4e 2023-09-10 jrmu my $position = $string =~ m/$regex/ ? $-[0] : -1;
33 1ddd2d4e 2023-09-10 jrmu if ($position > $rightmost) {
34 1ddd2d4e 2023-09-10 jrmu $rightmost = $position;
35 1ddd2d4e 2023-09-10 jrmu $rightkey = $key;
36 1ddd2d4e 2023-09-10 jrmu }
37 1ddd2d4e 2023-09-10 jrmu }
38 1ddd2d4e 2023-09-10 jrmu return $rightkey;
39 1ddd2d4e 2023-09-10 jrmu }
40 1ddd2d4e 2023-09-10 jrmu
41 1ddd2d4e 2023-09-10 jrmu my %patterns = (
42 1ddd2d4e 2023-09-10 jrmu Gilligan => qr/(?:Willie )?Gilligan/,
43 1ddd2d4e 2023-09-10 jrmu 'Mary Ann' => qr/Mary Ann/,
44 1ddd2d4e 2023-09-10 jrmu Ginger => qr/Ginger/,
45 1ddd2d4e 2023-09-10 jrmu Professor => qr/(?:The )?Professor/,
46 1ddd2d4e 2023-09-10 jrmu Skipper => qr/Skipper/,
47 1ddd2d4e 2023-09-10 jrmu 'A Howell' => qr/Mrs?. Howell/,
48 1ddd2d4e 2023-09-10 jrmu
49 1ddd2d4e 2023-09-10 jrmu );
50 1ddd2d4e 2023-09-10 jrmu
51 1ddd2d4e 2023-09-10 jrmu my $key = rightmost(
52 1ddd2d4e 2023-09-10 jrmu 'There is Mrs. Howell, Ginger, and Gilligan',
53 1ddd2d4e 2023-09-10 jrmu \%patterns
54 1ddd2d4e 2023-09-10 jrmu );
55 1ddd2d4e 2023-09-10 jrmu print "$key\n";