Or some iterative versions which do a little less work:

# destructive
while( my $k = each %hash ) {
    delete $hash{ $k } unless $k =~ /\d+_\d+/;
}

# nondestructive
my %hash2;
while( my( $k, $v ) = each %hash ) {
    $hash2{ $k } = $v if $k =~ /\d+_\d+/;
}
[download]

or maybe

# destructive
/\d+_\d+/ or delete $hash{ $_ } while local $_ = each %hash;

# nondestructive
my %hash2;
/\d+_\d+/ and $hash2{ $_ } = $a while local( $_, $a ) = each %hash;
[download]