Passing a complex array to a function

[Anonymous Monk]

This will look a lot lot like homework. But I assure you it is not. I am trying to learn how to think about Algorithims, and I sometimes do it with corny brainteaser questions.

Anyway I got the following problem off the web, and while it took me about two minutes to solve on paper using trial and error, I figured I would try it in perl in a more systematic way.

The problem creeps in after I have an array of every possible combo of man and wife. My thought was to split up the array by the square root of the total number of man-wife combos(in this case giving me three separate arrays, Where each array has one man and each possible wife.) Then to run those three arrays by reference through the original permutation sub to get references for each possible combo of Man-Wife:Man-Wife:Man-Wife which I could then process.

I had trouble passing these array slices to the permutation sub. And now I'm stuck. My work so far follows. All I really need to know is how I should do the second permutation.

#!/usr/bin/perl -w

use strict;
use Data::Dumper; #for Debugging

=head1 Stupid question
    A man left a legacy of $10,000 to three relatives and their wives.
+ 
    Together, the wives received $3960. June received $100 more than 
    Camille, and Martha received $100 more than June. Jack Smith was 
    given just as much as his wife, Horace Saunders got half as much 
    again as his wife, and Terry Conners received twice as much as his
+ 
    wife. What was the first name of each man's wife? 
=cut

#given
my $legacy = 10000;
my $wife_total = 3960;

#postulate
my %wives;
$wives{"Camille"} = 0;
$wives{"June"} = $wives{"Camille"} + 100;
$wives{"Martha"} = $wives{"June"} + 100;
my $husband_total = $legacy - $wife_total;
my $wife_share = ($wife_total / 3)-($wives{"June"}+$wives{"Martha"}+$w
+ives{"Camille"});

#get the amount of money for each wife
for my $woman (keys %wives){
    $wives{$woman} += $wife_share; 
}

#key each husband to the multiple given in the example
my %husbands = ("Jack Smith"=>1,"Horace Saunders"=>1.5,"Terry White"=>
+2);


my @husband_list = (keys %husbands);
my @wife_list = (keys %wives);
my @couples;

#get every possible man and wife combo
push @couples,$_ for (permute(\@husband_list, \@wife_list));

my $number_of_couples = sqrt scalar @couples;

print join(",",@$_),"\n" for (@couples);

=head1 2d array of husband and wife combos
    At this poit we have this array....
    @couples =(
    [Horace Saunders,Martha]
    [Horace Saunders,June]
    [Horace Saunders,Camille]
    [Terry White,Martha]
    [Terry White,June]
    [Terry White,Camille]
    [Jack Smith,Martha]
    [Jack Smith,June]
    [Jack Smith,Camille]
    )
    But what to do next?
=cut

#I stole this function from a perlmonks snippet from Merlyn
sub permute{
    my $last = pop @_;
    unless(@_){
        return map [$_], @$last;
    }
    return map {my $left =$_; map [@$left, $_],@$last} permute(@_);
}

[japhy]

While this isn't a response to your question, it is an enlightenment. This task is ("is" => "can be") a case for a regex, which has been updated as per the responses below:

# solving math puzzles with regexes is FUN!
("." x 10_000) =~ m{
  ^
   
  # camille
  (.{0,3960})
  (?(?{ length($1) >= 3960 })(?!))
  
  # june
  (.{100} \1)
  (?(?{ length($1.$2) >= 3960 })(?!))
  
  # martha
  (.{100} \2)
  (?(?{ length($1.$2.$3) != 3960 })(?!))
  
  (?{ print join(" ", map length, $1, $2, $3), "\n" })
  
  (?:
    \1 (?:
      \2 \2 (??{ ".{" . 1.5*length($3) . "}" })
      $ (?{ print join(" ", map .5 * length, $1 x 2, $3 x 4, $2 x 3), 
+"\n" })
      |
      \3 \3 (??{ ".{" . 1.5*length($2) . "}" })
      $ (?{ print join(" ", map .5 * length, $1 x 2, $2 x 4, $3 x 3), 
+"\n" })
    )
    |
    \2 (?:
      \1 \1 (??{ ".{" . 1.5*length($3) . "}" })
      $ (?{ print join(" ", map .5 * length, $2 x 2, $3 x 4, $1 x 3), 
+"\n" })
      |
      \3 \3 (??{ ".{" . 1.5*length($1) . "}" })
      $ (?{ print join(" ", map .5 * length, $2 x 2, $1 x 4, $3 x 3), 
+"\n" })
    )
    |
    \3 (?:
      \1 \1 (??{ ".{" . 1.5*length($2) . "}" })
      $ (?{ print join(" ", map .5 * length, $3 x 2, $2 x 4, $1 x 3), 
+"\n" })
      |
      \2 \2 (??{ ".{" . 1.5*length($1) . "}" })
      $ (?{ print join(" ", map .5 * length, $3 x 2, $1 x 4, $2 x 3), 
+"\n" })
    )
  )
}x;

This code prints two rows of three columns. The first row is Camille, Jane, and Martha; the second row is the money of their respective husbands, whose names can then be determined by the allotment clues.

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

[particle]

i believe the order of the second row of your output is incorrect.

in order to output the husbands money respectively, the affected part of your regex should read:

  (?:
    \1 (?:
      \2 \2 (??{ ".{" . 1.5*length($3) . "}" })
      $ (?{ print join(" ", map .5 * length, $1 x 2, $3 x 3, $2 x 4), 
+"\n" })
      |
      \3 \3 (??{ ".{" . 1.5*length($2) . "}" })
      $ (?{ print join(" ", map .5 * length, $1 x 2, $2 x 3, $3 x 4), 
+"\n" })
    )
    |
    \2 (?:
      \1 \1 (??{ ".{" . 1.5*length($3) . "}" })
      $ (?{ print join(" ", map .5 * length, $2 x 2, $3 x 3, $1 x 4), 
+"\n" })
      |
      \3 \3 (??{ ".{" . 1.5*length($1) . "}" })
      $ (?{ print join(" ", map .5 * length, $2 x 2, $1 x 3, $3 x 4), 
+"\n" })
    )
    |
    \3 (?:
      \1 \1 (??{ ".{" . 1.5*length($2) . "}" })
      $ (?{ print join(" ", map .5 * length, $3 x 2, $2 x 3, $1 x 4), 
+"\n" })
      |
      \2 \2 (??{ ".{" . 1.5*length($1) . "}" })
      $ (?{ print join(" ", map .5 * length, $3 x 2, $1 x 3, $2 x 4), 
+"\n" })
    )
  )

the affected areas are in the print statements. the order of the multipliers (2, 4, 3) in your original code should be (2, 3, 4,) which will make the output:


1220 1320 1420
1220 1980 2840

which is, left to right, in format: names (multipliers)
first row: Camille, June, Martha
second row: Jack Smith (x100%), Horace Sanders (x150%), Terry Conners (x200%)

i must say, i'm still trying to wrap my brain around this code. it's quite a lot for me to process. in fact, i'm amazed to learn that these type of problems can be attacked by regular expressions. brilliant! now, if i can only understand how to do it, then i can use it.

as far as my mechanical engineering background allows me to understand your algorithm, this is what i've been able to figure out. you've created a vector of 10_000 '.' characters. your first regexes work within the first 3_960 elements to determine the answer to the equation:

Camille + June + Martha = Total wives = 3_960
or, after a bit of algebra:
C + ( C + 100 ) + ( C + 200 ) = 3 * C + 300 = 3_960

although i don't understand your advanced regex magic, the algorithm is quite clear. the length of the matches is printed, and the elements are discarded, leaving the remainder of the vector as the husbands' total.

enter the second stage of regex magic. i think you are basically using vector products in this bit of code. i can explain the print statement pretty well (the tricky bit is the map .5 * length, ... which translates the multipliers (2, 3, 4) into the problem multipliers of (100%, 150%, 200%).

what i don't understand is what seems to me to be superfulous code. i hope you can explain this to me. if i modify your second section of your regex to read:

  (?:
    \1 (?:
      \2 \2 (??{ ".{" . 1.5*length($3) . "}" })
      $ (?{ print join(" ", map .5 * length, $1 x 2, $3 x 3, $2 x 4), 
+"\n" })
      |
      \3 \3 (??{ ".{" . 1.5*length($2) . "}" })
      $ (?{ print join(" ", map .5 * length, $1 x 2, $2 x 3, $3 x 4), 
+"\n" })
    )
  )

(i've removed everything after the \1 block) the answer remains the same. what are the consequences of the removal of this code?

again, i've never seen this type of problem approached in this manner, and i'm awed by the power, beauty, and simplicity of a well-crafted solution using perl's regular expression engine. i know understanding your method (and madness) will make me a better coder, and an even bigger fan of Perl.

~Particle

[japhy]

The first part partitions the first 3960 characters to the wives. The second chunk uses those values and attempts to figure out how they mesh again (at ratios of 1:1, 3:2, and 2:1).

It could be considered cheating that I hard-wired the permutations of the \1, \2, and \3 part. I'll have another stab at it that has the regex engine do the permutations on its own.

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

[trs80]

I ran this and the columns didn't line up. I got:

1220 1320 1420
1220 2840 1980

it should be:

1220 1320 1420
1220 1980 2840
I am still amazed by the process however.

[trs80]

I hesitated to post a reply since even the poster admits it looks like homework. However my curiousity took over and I decided to write a program to solve the problem.
Since it isn't homework I used an external module that does the permutations for me List::Permutor.


use strict;
use List::Permutor;

=head1 Stupid question
           A man left a legacy of $10,000 to three relatives and their
+ wives. 
           Together, the wives received $3960. June received $100 more
+ than 
           Camille, and Martha received $100 more than June. Jack Smit
+h was 
           given just as much as his wife, Horace Saunders got half as
+ much 
           again as his wife, and Terry Conners received twice as much
+ as his 
           wife. What was the first name of each man's wife? 
=cut

# there is $300 difference between
# the most and least given each wife
# so we subtract the 300 and divide by for
# 3 for the base point for each wife

my $total_for_wives = 3960;
my $am = (($total_for_wives - 300) / 3);
my %wives = (
    Camille => $am,
    June    => $am + 100,
    Martha  => $am + 200,
            );

my @wives_combo;

my $perm = List::Permutor->new( sort keys %wives );
while (my @set = $perm->next) {
    push ( @wives_combo  , \@set) ;
}

my %husbands = ( 'Terry Conners'   => 2 ,
                 'Horace Saunders' => 1.5 ,
                 'Jack Smith'      => 1  );

foreach my $array (@wives_combo) {
    my $total;
    my $count;
    foreach (sort { $b <=> $a } values %husbands ) {
       $total += ($wives{$array->[$count++]} * $_);
    }

    if ( ($total += $total_for_wives) == 10000) {
        my $num;
        foreach (sort {
            $husbands{$b} <=> $husbands{$a}
                } keys %husbands) {
        printf "$_ wife's name is: $array->[$num++]\n";
        }
        last;
        }
    
}

Update: Code has been replaced after a bug was spotted by Anonymous Monk.

[Anonymous Monk]

trs++ to you on this answer. I was heading down a long and sloppy road with my attempt.I'm sure that this was probably someone's homework at some point :-) If only I could be so lucky as to have a good Perl course availible. Otherwise I learn from books, at my job, and from silly practices like this.(and of couse from staying tuned to perlmonks)

One Question, This looked like a possible typo, but I haven't tried to use your code yet.

'Jack Smith'      => 0     # same amount as his wife

Should that be a 1?
japhy I'm truly impressed. ...and a little frightened.

[trs80]

Thanks for pointing that out. I had a conditional when I didn't need one because I forgot I could * by 1 and get the same value. DOH!
The code in the initial post I made has been updated to the working version.