view release on metacpan or  search on metacpan

lib/Pheno/Ranker/Graph.pm  view on Meta::CPAN

package Pheno::Ranker::Graph;

use strict;
use warnings;
use autodie;
use feature qw(say);
use JSON::XS;
use Sort::Naturally qw(nsort);
use Pheno::Ranker::IO;
use Pheno::Ranker::Metrics;
use Exporter 'import';
our @EXPORT = qw(binary_hash2graph cytoscape2graph);
use constant DEVEL_MODE => 0;

############################
############################
#  SUBROUTINES FOR GRAPHS  #
############################
############################

sub binary_hash2graph {
    my $arg                 = shift;
    my $ref_binary_hash     = $arg->{ref_binary_hash};
    my $output              = $arg->{json};
    my $metric_name         = $arg->{metric};
    my $verbose             = $arg->{verbose};
    my $graph_stats         = $arg->{graph_stats};
    my $graph_min_weight    = $arg->{graph_min_weight};
    my $graph_max_weight    = $arg->{graph_max_weight};
    my @ids                 = nsort( keys %$ref_binary_hash );
    my @strings             = map { $ref_binary_hash->{$_}{binary_digit_string_weighted} } @ids;
    my %similarity_function = (
        hamming => \&hd_fast,
        jaccard => \&jaccard_similarity_formatted,
    );
    my $metric = $similarity_function{$metric_name};

    my @nodes = map { { data => { id => $_ } } } @ids;
    my @edges;

    for my $i ( 0 .. $#ids ) {
        say "Creating graph edges for <" . $ids[$i] . ">..." if $verbose;
        my $str1 = $strings[$i];

        for my $j ( $i + 1 .. $#ids ) {
            my $weight = $metric->( $str1, $strings[$j] );
            next unless _keep_edge( $weight, $graph_min_weight, $graph_max_weight );

            push @edges,
              {
                data => {
                    source => $ids[$i],
                    target => $ids[$j],
                    weight => $weight,
                }
              };
        }
    }

    my %graph = (
        elements => {
            nodes => \@nodes,
            edges => \@edges,
        }
    );

    say "Writting <$output> file " if $verbose;
    write_json( { filepath => $output, data => \%graph } );