Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Re: algorithm for 'best subsets'

by Roy Johnson (Monsignor)
on Mar 03, 2005 at 04:14 UTC ( [id://436086]=note: print w/replies, xml ) Need Help??


in reply to algorithm for 'best subsets'

Update: Oh, boy, don't use this baby for high-order tuples.

Here's my entry:

use strict; use warnings; my %items = ( a => [ qw/one six/ ], b => [ qw/two three five/ ], c => [ qw/one two five/ ], d => [ qw/one seven five/ ], e => [ qw/one two five/ ], f => [ qw/one two four seven/ ], g => [ qw/one two five/ ], h => [ qw/one two three five/ ], ); my $tuple = 2; # Build a reverse HoH my %rHoH; while (my ($k,$v) = each %items) { $rHoH{$_}{$k} = undef for @$v; } # Determine all possible n-tuples my @accum = (); for my $elem (keys %rHoH) { push @accum, ([$elem], map { @$_ < $tuple ? [@$_, $elem] : () } @a +ccum); } @accum = grep { @$_ == $tuple } @accum; # For each tuple in @accum, mark which items contained each member # then count how many got marked for all of them my @count; for my $a (0..$#accum) { my %ic; # item counter for my $n (@{$accum[$a]}) { ++$ic{$_} for keys %{$rHoH{$n}}; } $count[$a] = grep {$ic{$_} == $tuple} keys %ic; } # print the tuples out, with their counts, highest to lowest printf "[%s]: $count[$_]\n", join(',', @{$accum[$_]}) for sort {$count[$b] <=> $count[$a]} grep { $count[$_] > 1 } 0..$#accum;

Caution: Contents may have been coded under pressure.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://436086]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (3)
As of 2024-04-19 05:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found