in reply to Match key and return value in some order

I tweaked your answer format a little to simplify things. See comment below. 

#! perl -sw
use strict;
local $\=$/;

#! Added leading and removed trailing /'s for consistancy
my %answers = ( 
    '/WRB1/JJ1/VBZ1/NP1/IN1/NP2'    => '/NP1/VBZ1(so)/JJ1 : /NP1/IN1/N
+P2/VBZ1(really)/JJ1',
    '/WP/NP1/VB1/VBN1/PP1'          => '/PP1/PP2/NP1(are)/VB1',
);

my $question = 'How/WRB1 hot/JJ1 is/VBZ1 the core/NP1 of/IN1 the earth
+/NP2 ?/';

my @keys = $question =~ m!(/[A-Z0-9]+)!g; # Parse markers

# Update: Fixed problem not capturing all words between tags
#my @values = $question =~ m!(\w+)(?=/)!g; # Parse values
my @values = $question =~ m!(.*?)(?:/[A-Z0-9]+\s+)!g;

my %lookup; @lookup{@keys} = @values;     # Build lookup

my $key = join'',@keys;
my $answer = $answers{$key};

$answer =~ s!\s*$_\s*! $lookup{$_} !g for keys %lookup;
$answer =~ s!\s+:\s+! and the !g;
#$answer = 'The' . $answer; # Update: No longer needed.
print $answer;

[download]

Output: (revised after changes) 

C:\test>210085
the core is (so) hot and the core of the earth is (really) hot
C:\test>

[download]
Nah! Your thinking of Simon Templar, originally played by Roger Moore and later by Ian Ogilvy

Replies are listed 'Best First'.
Re: Re: Match key and return value in some order
by Anonymous Monk on Nov 04, 2002 at 00:57 UTC
    Thanks Monks

    I did not think in create another hash for each question

    my %lookup; @lookup{@keys} = @values;

    [download]

    Some doubts:
    Why concatenate a space to the key?
     my $key = join'',@keys;
    and Why $answer = 'The' . $answer;
    NP1 have 'the'core even it is not in uppercase the first character.

    Thanks this has helped me a lot!!
[reply]
[d/l]
[select]

      Why concatenate a space to the key? my $key = join'',@keys;

      That isn't a space, it's the null string. Ie. Two single quotes, with nothing in between.

      and Why $answer = 'The' . $answer; NP1 have 'the'core even it is not in uppercase the first character.

      That's because I didn't recognise that each /tag applied to everything between it and the preceeding tag. My mistake. I'll amend the code above in a few minutes.

      Nah! Your thinking of Simon Templar, originally played by Roger Moore and later by Ian Ogilvy
[reply]
[d/l]
Re: Re: Match key and return value in some order
by Anonymous Monk on Nov 04, 2002 at 18:57 UTC
    Hello Monk

    I hope you can help me, yesterday I tried your code as it is and it was ok, but when I use it in with my program where I have my hash of array and my files with questions, the results I got were the following:

    How/WRB1 hot/JJ1 is/VBZ1 the core/NP1 of/IN1 the earth +/NP2 ?/
    ARRAY(0x8152bb0) or

    the values of my hash /NP1/VBZ1(so)/JJ1 and /NP1/IN1/NP2/VBZ1(really)/JJ1 when I changed...
    print "@$answer";
    I know is a problem of dereference of the var, but I have tried the whole night but I am blocked!! , I even read the perlref.

    Thanks for any help
[reply]
[d/l]

      I would willingly try to help, but you will have to help me by making your question/problem a little clearer.

      The easiest way to do this would be to post (the relevant bits of) your code plus the inputs and failing output. If it is difficult to extract the relevant parts, and too big to post it all, then perhaps you could make the code visible on the net somewhere and post or /msg a url and I will try to take a look.

      Nah! Your thinking of Simon Templar, originally played by Roger Moore and later by Ian Ogilvy
[reply]
        Here my program it is really short, so I will post it here 

        #!/usr/bin/perl -sw

use Data::Dumper;
use strict;
local $\=$/;
my %patterns;
open(PFILE, "whatpattern.txt")|| die "Cannot open whatpattern.txt file
+";
while (<PFILE>) {
    chomp;
    next unless $_;
    my @tags = split /; |:/;
    my $key = shift @tags;
    $patterns{$key} = \@tags;
}
open(TESTFILE, "alltestfile")|| die "Cannot open alltestfile";

while(defined(my $question=<TESTFILE>))
{

my @qkeys = $question =~ m!(/[A-Z0-9]+)!g;
my @qvalues = $question =~ m!(.*?)(?:/[A-Z0-9]+\s+)!g;


my %questionlookup;
@questionlookup{@qkeys} = @qvalues;   

my $key = join'',@qkeys;

print $question."\n\n";
if (my $answer = $patterns{$key})
{

  $answer =~ s!\s*$_\s*! $questionlookup{$_} !g for qkeys %questionloo
+kup;
  $answer =~ s/\:/\n\n/g;
  print $answer;

} else{

print "No Match\n";

}
}

        [download]

        As you see I did not change much your code. Do I have to pass the array of values as a reference? Thanks
[reply]
[d/l]

In Section Seekers of Perl Wisdom