Counting Array in an Array of HoA

monkfan has asked for the wisdom of the Perl Monks concerning the following question:

Revered Monks,

Here I am trying to count the support of an array within an array in HoA. A count is considered valid if:
1. Each element of array occur together
2. Order of the array is maintained

Currently this is the solution I have, which I use Regex approach. Yet it still _failed_ to give my desired answer (see answer below). Is there anyway I can solve this problem? Am I right in taking regex approach?

#!/usr/bin/perl -w
use strict;
use Data::Dumper;

# While matching the hash, elem of each array must occur together
# and in order

my @ar1   = ('A','B');      #Answer: 3
my @ar2   = ('B','A');      #Answer: 1
my @ar3   = ('A','B','C');  #Answer: 2

my $hash = {
            'S1' => [ 'A', 'B', 'C', 'A' ],
            'S2' => [ 'A', 'C', 'D', 'B' ],
            'S3' => [ 'C', 'A', 'D', 'H' ],
            'S4' => [ 'A', 'B', 'I', 'C' ]
           };

print "Total Support: ", count_support_order_based($hash,\@ar1), "\n";
print "Total Support: ", count_support_order_based($hash,\@ar2), "\n";

sub count_support_order_based
{
    my ($hash,$array) = @_;
    my $tmp_support;
    my $support;
    my $total_support;

    my $array_string = join("", @{$array});
    
    for my $key ( keys %{$hash}  )
    {
        my $hash_string = join("",@{$hash->{$key}} );
        $tmp_support = () = $hash_string =~ m/[\Q$array_string\E]/g;

        $support = sprintf("%.0d", 
                            $tmp_support/ (length $array_string));

        print "$support - $hash_string\n";
        if ( $support )
        {
         $total_support += $support;
        }
    }                               # -----  end foreach  -----


    return $total_support;
}
[download]

Currently the answers it gives are:

Substring to Count: AB   |  Substring to Count: BA   
                         |
1 - ABCA                 |  1 - ABCA
1 - ACDB                 |  1 - ACDB
1 - ABIC                 |  1 - ABIC
  - CADH                 |    - CADH
Total Support: 3         | Total Support: 3
 **CORRECT**                **WRONG**
[download]

The desired answers for "BA" are

Substring to Count: BA
1 - ABCA
0 - ACDB
0 - ABIC
  - CADH
Total Support: 1
[download]

Regards,
Edward

Comment on Counting Array in an Array of HoA Select or Download Code

Replies are listed 'Best First'.
Re: Counting Array in an Array of HoA by Hena (Friar) on May 09, 2005 at 09:06 UTC
If the caps is always large, then I would use foreach loop instead of above to test existence. Btw. this just says it is there or not, not how many times. `foreach my $key (keys %{$hash}) { my $ar = $hash{$key}; foreach (@{$ar}) { $_ eq $array->[0] && shift @{$array} && !@{$array} && last; } if (!@{$array}) { # was found in the hashes array } }` [download] Note the above is untested. Also deletes the given array (not the ones in hash). If you want count of how many times, then need to continue to end of array in hash and recreate tester array when it is completely deleted. Also if multiple counting, then the if needs to be done differently. EDIT: Fixed one obvious bug	[reply] [d/l]
Re^2: Counting Array in an Array of HoA by monkfan (Curate) on May 15, 2005 at 10:06 UTC
Hi Hena, I am attempting to generalize the problem above, such that now it can count support based on "string mismatch" paramaters. The code below is inspired by your posting above, and it already gives the correct answer. I know that the my code is a "idiot" solution to your ingenious approach above. I don't understand much of your code (especially that one-liner with many '&&'). I wonder how would you make my code compact like yours? I really want to learn to write my code briefly. Read more... (3 kB) Regards, Edward	[reply] [d/l]
Re: Counting Array in an Array of HoA by reneeb (Chaplain) on May 09, 2005 at 09:22 UTC
you can use this: #!/usr/bin/perl -w use strict; use Data::Dumper; # While matching the hash, elem of each array must occur together # and in order my @ar1 = ('A','B'); #Answer: 3 my @ar2 = ('B','A'); #Answer: 1 my @ar3 = ('A','B','C'); #Answer: 2 my $hash = { 'S1' => [ 'A', 'B', 'C', 'A' ], 'S2' => [ 'A', 'C', 'D', 'B' ], 'S3' => [ 'C', 'A', 'D', 'H' ], 'S4' => [ 'A', 'B', 'I', 'C' ] }; count_($hash,\@ar1); count_($hash,\@ar2); sub count_ { my ($hashref,$arref) = @_; my $counter = 0; my $test = join('.*?',@$arref); print "Query: ",join('',@$arref),"\n"; for my $key(sort{$a cmp $b}keys(%$hashref)){ my $string = join('',@{$hashref->{$key}}); print $string," - "; if($string =~ $test){ print "1\n"; $counter++; } else{ print "0\n"; } } print "Total counter: ",$counter,"\n" }# end count_ [download] output: `Query: AB ABCA - 1 ACDB - 1 CADH - 0 ABIC - 1 Total counter: 3 Query: BA ABCA - 1 ACDB - 0 CADH - 0 ABIC - 0 Total counter: 1` [download]	[reply] [d/l] [select]
Re^2: Counting Array in an Array of HoA by monkfan (Curate) on May 09, 2005 at 14:13 UTC
reneeb, Thanks so much for your reply. I wonder what do these two lines do? `my $test = join('.*?',@$arref); $string =~ $test # this is the first time # I see "=~" used in non-regex context # what's the purpose?` [download] Regards, Edward	[reply] [d/l]
Re^3: Counting Array in an Array of HoA by omega_monk (Scribe) on May 09, 2005 at 16:03 UTC
No, I believe the "=~" is used in regex there, from my minimal understanding $test is the string that contains the regex. I am still trying to understand the how on the rest of the script, though. Update: After some testing, I used a much simpler version to get to this. `#!/usr/bin/perl -w use strict; my $string='ABCD'; my $string1='DCBA'; my $test='.?AB'; print "Matched in $string" if $string =~ $test; # Prints Match. print "Matched in $string1" if $string1 =~ $test; # Does not print + Match.` [download] So $test does contain the regex '.?AB' or '.?BA'. If I am not correct here, please let me know. Update:* Adjusted code to differentiate the output.	[reply] [d/l]