How to resolve the algorithm Dinesman's multiple-dwelling problem step by step in the Perl programming language

Published on 12 May 2024 09:40 PM
#Perl

How to resolve the algorithm Dinesman's multiple-dwelling problem step by step in the Perl programming language

Table of Contents

Problem Statement

Solve Dinesman's multiple dwelling problem but in a way that most naturally follows the problem statement given below. Solutions are allowed (but not required) to parse and interpret the problem text, but should remain flexible and should state what changes to the problem text are allowed. Flexibility and ease of expression are valued. Examples may be be split into "setup", "problem statement", and "output" sections where the ease and naturalness of stating the problem and getting an answer, as well as the ease and flexibility of modifying the problem are the primary concerns. Example output should be shown here, as well as any comments on the examples flexibility.

Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors.

Where does everyone live?

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Dinesman's multiple-dwelling problem step by step in the Perl programming language

Source code in the perl programming language

use strict;
use warnings;
use feature <state say>;
use List::Util 1.33 qw(pairmap);
use Algorithm::Permute qw(permute);

our %predicates = (
#                       | object    | sprintf format for Perl expression |
#   --------------------+-----------+------------------------------------+
    'on bottom'      => [ ''        , '$f[%s] == 1'                      ],
    'on top'         => [ ''        , '$f[%s] == @f'                     ],
    'lower than'     => [ 'person'  , '$f[%s] < $f[%s]'                  ],
    'higher than'    => [ 'person'  , '$f[%s] > $f[%s]'                  ],
    'directly below' => [ 'person'  , '$f[%s] == $f[%s] - 1'             ],
    'directly above' => [ 'person'  , '$f[%s] == $f[%s] + 1'             ],
    'adjacent to'    => [ 'person'  , 'abs($f[%s] - $f[%s]) == 1'        ],
    'on'             => [ 'ordinal' , '$f[%s] == \'%s\''                 ],
);

our %nouns = (
    'person'  => qr/[a-z]+/i,
    'ordinal' => qr/1st | 2nd | 3rd | \d+th/x,
);

sub parse_and_solve {
    my @facts = @_;
    
    state $parser = qr/^(?<subj>$nouns{person}) (?<not>not )?(?|@{[
                            join '|', pairmap {
                                "(?<pred>$a)" .
                                ($b->[0] ? " (?<obj>$nouns{$b->[0]})" : '')
                            } %predicates
                        ]})$/;
    
    my (@expressions, %ids, $i);
    my $id = sub { defined $_[0] ? $ids{$_[0]} //= $i++ : () };
    
    foreach (@facts) {
        /$parser/ or die "Cannot parse '$_'\n";
        
        my $pred = $predicates{$+{pred}};
        { no warnings;
          my $expr = '(' . sprintf($pred->[1], $id->($+{subj}),
                           $pred->[0] eq 'person' ? $id->($+{obj}) : $+{obj}). ')';
          $expr = '!' . $expr if $+{not};
          push @expressions, $expr;
        }
    }
    
    my @f = 1..$i;
    eval '
          permute {
              say join(", ", pairmap { "$f[$b] $a" } %ids)
                  if ('.join(' && ', @expressions).');
          } @f;';
}


parse_and_solve(<DATA>);

__DATA__
Baker not on top
Cooper not on bottom
Fletcher not on top
Fletcher not on bottom
Miller higher than Cooper
Smith not adjacent to Fletcher
Fletcher not adjacent to Cooper

You may also check:How to resolve the algorithm Binary search step by step in the Brat programming language
You may also check:How to resolve the algorithm URL decoding step by step in the VBScript programming language
You may also check:How to resolve the algorithm Sorting algorithms/Quicksort step by step in the SETL programming language
You may also check:How to resolve the algorithm Circular primes step by step in the Raku programming language
You may also check:How to resolve the algorithm Magnanimous numbers step by step in the EasyLang programming language