You're storing your data in the wrong structures.

You never use the values in the hash %a; you never use it's lookup ability; and you want to iterate it in order.

Your arrays @a1 and @a2:

1. you want to use as lookup table and have to iterate the whole thing each time with grep.
2. Dont care about the order, only the presence.
3. Iterate, only for the greps, never for the ordering.

By reversing the type of structures used you get:

#! perl -slw
use strict;

my %a=( AA=>'Y', BB=>'Y', CC=>'Y', DD=>'Y', EE=>'Y', FF=>'Y' );
my @a1=('AA','DD','EE');
my @a2=('AA','BB','CC','FF');

my @a = sort keys %a;
my %a1; @a1{ @a1 } = ();
my %a2; @a2{ @a2 } = ();

print join ',', map{ exists $a1{ $_ } ? $_ : '##' } @a;
print join ',', map{ exists $a2{ $_ } ? $_ : '##' } @a;

__END__
[11:44:17.92] P:\test>413151
AA,##,##,DD,EE,##
AA,BB,CC,##,##,FF
[download]

Small suggestion to reduce redundancy:

for my $h (\%a1, \%a2) {
    print join ',', map{ exists $h->{ $_ } ? $_ : '##' } @a;
}
[download]

Knitpicking is the only way to perfection.
--kap

You're right!

... except now that you have to explain not only why the OP should be using an array instead of a hash, and hashes instead of arrays, but also why you're escaping your percent signs and why your $h is firing an arrow at the head of a cartoon character with a one eye closed and a dollar sign in the other :)

---

Examine what is said, not who speaks.

"But you should never overestimate the ingenuity of the sceptics to come up with a counter-argument." -Myles Allen
"Think for yourself!" - Abigail        "Time is a poor substitute for thought"--theorbtwo         "Efficiency is intelligent laziness." -David Dunham
"Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

A bit more perlish. Note that %a is not really necessary. And the keys could be pre-sorted.

#!/usr/bin/perl
use strict;

my @a  = qw( AA BB CC DD EE FF );
my @a1 = qw( AA DD EE );
my @a2 = qw( AA BB CC FF );

my %a  = map { $_ => 1 } @a;
my %a1 = map { $_ => 1 } @a1;
my %a2 = map { $_ => 1 } @a2;

my (@tmp1, @tmp2);

@tmp1 = map { exists $a1{$_} ? $_ : '##' } sort keys %a;
@tmp2 = map { exists $a2{$_} ? $_ : '##' } sort keys %a;

print join(',',@tmp1);
print "\n";
print join(',',@tmp2);
print "\n";
[download]

update: removed unnecessary parentheses

There is more than one way to do it - especially in perl!

Ahhh, now I see. Ie after you updated the question.

I think that it could be simplified by noting that the two tmp-arrays can be created given only one of the input arrays - @tmp1 depends only on @a1 and @tmp2 only on @a2.

Your loop could be shortened to something like:

for my $elem (sort keys %a) {
  push @tmp1, (grep($elem eq $_} @a1) ? $elem : "##";
  push @tmp2, (grep($elem eq $_} @a2) ? $elem : "##";
}
[download]

That satisfies your explanation.

But your code seems to indicate that the value is put into the tmp-arrays also if the value is present in neither the @a1 or @a2. Unfortunately your code does not have an example of this, so it cannot be tested.

how about

print "AA,##,##,DD,EE,##\nAA,BB,CC,##,##,FF\n" # ;-)
[download]

#!/usr/local/bin/perl -w
use strict;

my @a1=('AA','DD','EE');

my @a2=('AA','BB','CC','FF');

my(@tmp1,@tmp2);

foreach my $xx ('A'..'F') {
    $xx=$xx x 2;
    $a = grep (/$xx/, @a1);
    $b = grep (/$xx/, @a2) ;
    if (($a && $b) || (!$a && !$b)) {
          push (@tmp1,$xx);
          push (@tmp2,$xx);
    } elsif ($a && !$b) {
          push (@tmp1,$xx);
          push (@tmp2,'##');
    } else {
          push (@tmp1,'##');
          push (@tmp2,$xx);
    }
}

print join(',',@tmp1);
print "\n";
print join(',',@tmp2);
print "\n";
[download]

Why the ddoouubbllee letters ? Can we do it all in single letters and double them up at print time ? Will one of the values always be present in either @a1 or @a2 ? Why not put these into hashes to save that greping ?

#!/usr/local/bin/perl -w
use strict;

my (%a1, %a2, @tmp1,@tmp2);

$a1{$_}=1 for ('AA','DD','EE');
$a2{$_}=1 for ('AA','BB','CC','FF');


foreach my $xx ('A'..'F') {
    $xx=$xx x 2;
    if (($a1{$xx} && $a2{$xx}) || (!$a1{$xx} && !$a2{$xx})) {
          push (@tmp1,$xx);
          push (@tmp2,$xx);
    } elsif ($a1{$xx}) {
          push (@tmp1,$xx);
          push (@tmp2,'##');
    } else {
          push (@tmp1,'##');
          push (@tmp2,$xx);
    }
}

print join(',',@tmp1);
print "\n";
print join(',',@tmp2);
print "\n";
[download]

This is not as simple as some of the examples above but then this one handles the case where neither a1 or a2 contains the value and correctly puts XX into both output streams.

Cheers,
R.

Here is an improvement on the above. I do not use map to fill the two tmp arrays as they would need to be itterated over again to find the case where both are blank. May as well only loop once (I added GG to test this case too).

#!/usr/bin/perl -w
use strict;

my (%a1, %a2, @tmp1,@tmp2);

$a1{$_}=1 for ('AA','DD','EE');
$a2{$_}=1 for ('AA','BB','CC','FF');


foreach my $xx ('A'..'G') {
    $xx=$xx x 2;
    push @tmp1,($a1{$xx} ? $xx : 'XX');
    push @tmp2,($a2{$xx} ? $xx : 'XX');
    $tmp1[-1]=$tmp2[-1]=$xx if $tmp1[-1] eq $tmp2[-1]
}
print join(',',@tmp1);
print "\n";
print join(',',@tmp2);
print "\n";
[download]

Cheers,
R.

print "AA,##,##,DD,EE,##\nAA,BB,CC,##,##,FF\n";
[download]

Could not resist. This is the most perlish way of accomplishing a task which should be derived from the code.

Is there a more perlish way of doing this

Dave.

If you look at the program written ,It has a lot of if ,elsif blocks ...can that be avoided ?