File Coverage

blib/lib/Algorithm/FeatureSelection.pm

Criterion	Covered	Total	%
statement	113	126	89.6
branch	10	16	62.5
condition	5	6	83.3
subroutine	12	15	80.0
pod	8	9	88.8
total	148	172	86.0

package Algorithm::FeatureSelection;
use strict;
use warnings;
use List::Util qw(sum);

our $VERSION = '0.02';

sub new {
    my $class = shift;
    my $self = bless {@_}, $class;
    return $self;
}

sub pmi {
    my $self = shift;
    $self->pairewise_mutual_information(@_);
}

sub ig {
    my $self = shift;
    $self->information_gain(@_);
}

sub igr {
    my $self = shift;
    $self->information_gain_ratio(@_);
}

sub pairwise_mutual_information {
    my $self     = shift;
    my $features = shift;

    ## -----------------------------------------------------------------
    ##
    ## The argument is expected as below.
    ##
    ## $features = {
    ##     feature_1 => {
    ##         class_a => 10,
    ##         class_b => 2,
    ##     },
    ##     feature_2 => {
    ##         class_b => 11,
    ##         class_d => 32
    ##     },
    ##           .
    ##           .
    ##           .
    ## };
    ##
    ## -----------------------------------------------------------------
    ##
    ## Pairewise Mutual Information
    ##
    ## PMI(w, c) = log ( P( Xw = 1, C = c ) / P( Xw=1 )P( C=c ) )
    ##
    ##    c.f.  w = feature
    ##          c = Class
    ##
    ## -----------------------------------------------------------------

    my $feature_count;
    my $class_count;
    my $co_occur_count;
    my $all_features_num;
    while ( my ( $feature, $ref ) = each %$features ) {
        while ( my ( $class, $count ) = each %$ref ) {
            $feature_count->{$feature}                    += $count;
            $class_count->{$class}                        += $count;
            $co_occur_count->{ $class . "\t" . $feature } += $count;
            $all_features_num                             += $count;
        }
    }

    my $PMI;

    for ( keys %$co_occur_count ) {
        my $f12 = $co_occur_count->{$_};
        my ( $class, $feature ) = split "\t", $_;
        my $f1 = $feature_count->{$feature};
        my $f2 = $class_count->{$class};

        my $pmi_score = _log2( ( $f12 / $all_features_num )
            / ( ( $f1 / $all_features_num ) * ( $f2 / $all_features_num ) ) );

        $PMI->{$feature}->{$class} = $pmi_score;
    }

    return $PMI;
}

sub information_gain {
    my $self     = shift;
    my $features = shift;

    ## -----------------------------------------------------------------
    ##
    ## The argument is expected as below.
    ##
    ## $features = {
    ##     feature_1 => {
    ##         class_a => 10,
    ##         class_b => 2,
    ##     },
    ##     feature_2 => {
    ##         class_b => 11,
    ##         class_d => 32
    ##     },
    ##           .
    ##           .
    ##           .
    ## };
    ##
    ## -----------------------------------------------------------------
    ##
    ## Information Gain
    ##
    ## IG(w) = H(C) - ( P(Xw = 1) H(C|Xw = 1) + P(Xw = 0) H(C|Xw = 0) )
    ##
    ##    c.f. w = feature
    ##         C = class
    ##
    ## -----------------------------------------------------------------

    my $IG;

    my $classes;
    my $classes_sum;
    my $all_features_num;
    while ( my ( $feature, $ref ) = each %$features ) {
        while ( my ( $class, $count ) = each %$ref ) {
            $classes->{$class}->{$feature} += $count;
            $classes_sum->{$class}         += $count;
            $all_features_num              += $count;
        }
    }

    my @array;
    while ( my ( $class, $ref ) = each %$classes ) {
        my $sum     = sum( values %$ref );
        my $p_class = $sum / $all_features_num;
        push @array, $p_class;
    }
    my $entropy = $self->entropy( \@array );

    while ( my ( $feature, $ref ) = each %$features ) {

        my $sum = sum( values %$ref );

        # H ( C | Xw = 1)
        my $on_entropy;
        {
            my @array;
            while ( my ( $class, $count ) = each %$ref ) {
                my $p_class_feature = $count / $sum;
                push @array, $p_class_feature;
            }

            $on_entropy = $self->entropy( \@array ) || 0;
        }

        # H ( C | Xw = 0)
        my $off_entropy;
        {
            my @array;
            while ( my ( $class, $count ) = each %$ref ) {

                my $p_class_feature = ( $classes_sum->{$class} - $count )
                    / ( $all_features_num - $sum );
                push @array, $p_class_feature;
            }

            $off_entropy = $self->entropy( \@array ) || 0;
        }

        # Information Gain
        my $ig
            = $entropy
            - ( ( $sum / $all_features_num )
            * $on_entropy
                + ( ( $all_features_num - $sum ) / $all_features_num )
                * $off_entropy );

        $IG->{$feature} = $ig;
    }

    return $IG;
}

sub information_gain_ratio {
    my $self = shift;
    my $data = shift;

    my $SI = $self->split_information($data);
    my $IG = $self->information_gain($data);
    my $IGR;
    for ( sort { $IG->{$b} <=> $IG->{$a} } keys %$IG ) {
        if ( my $ratio = $IG->{$_} / $SI ) {
            $IGR->{$_} = $ratio if $ratio > 0;
        }
    }
    return $IGR;
}

sub entropy {
    my $self = shift;
    my $data = shift;

    my @ratio;
    if ( ref $data eq 'HASH' ) {
        @ratio = _ratio( [ values %$data ] );
    }
    elsif ( ref $data eq 'ARRAY' ) {
        my $s = sum(@$data) || 0;
        if ( $s == 1 ) {
            @ratio = @$data;
        }
        else {
            @ratio = _ratio($data);
        }
    }

    my $entropy;
    for my $p (@ratio) {
        if ( $p <= 0 ) {
            $p = 0.000000000000000000000001;
        }

        $entropy += -$p * _log2($p);
    }
    return $entropy;

}

sub split_information {
    my $self = shift;
    my $data = shift;

    my $all = int keys %$data;
    my $s;
    while ( my ( $w, $ref ) = each %$data ) {
        for my $category ( keys %$ref ) {
            $s->{$category}++;
        }
    }
    my @array;
    while ( my ( $category, $num ) = each %$s ) {
        push @array, $num / $all;
    }
    my $SI = $self->entropy( \@array );
    return $SI;
}

sub _ratio {
    my $arrayref = shift;
    my @ratio;
    my $sum = sum(@$arrayref);
    for (@$arrayref) {
        next if $_ <= 0;
        eval { push @ratio, $_ / $sum; };
        if ($@) {
            use Data::Dumper;
            print Dumper $arrayref;
            die($@);
        }
    }
    return @ratio;
}

sub _log2 {
    my $n = shift;
    log($n) / log(2);
}

1;
__END__