Scroll to navigation

Genome::Model::Tools::Music::Bmr::CalcBmr(3pm) User Contributed Perl Documentation Genome::Model::Tools::Music::Bmr::CalcBmr(3pm)

EOS
); }

sub _doc_authors {
return " Cyriac Kandoth, Ph.D."; }

sub _doc_see_also {
return <<EOS genome-music-bmr(1), genome-music(1), genome(1) EOS }

sub execute {
my $self = shift;
my $roi_file = $self->roi_file;
my $ref_seq = $self->reference_sequence;
my $bam_list = $self->bam_list;
my $output_dir = $self->output_dir;
my $maf_file = $self->maf_file;
my $show_skipped = $self->show_skipped;
my $bmr_groups = $self->bmr_groups;
my $separate_truncations = $self->separate_truncations;
my $merge_concurrent_muts = $self->merge_concurrent_muts;
my $genes_to_ignore = $self->genes_to_ignore;
my $skip_non_coding = $self->skip_non_coding;
my $skip_silent = $self->skip_silent;

    # Check on all the input data before starting work
    print STDERR "ROI file not found or is empty: $roi_file\n" unless( -s $roi_file );
    print STDERR "Reference sequence file not found: $ref_seq\n" unless( -e $ref_seq );
    print STDERR "List of BAMs not found or is empty: $bam_list\n" unless( -s $bam_list );
    print STDERR "Output directory not found: $output_dir\n" unless( -e $output_dir );
    print STDERR "MAF file not found or is empty: $maf_file\n" unless( -s $maf_file );
    return undef unless( -s $roi_file && -e $ref_seq && -s $bam_list && -e $output_dir && -s $maf_file );
    # Check on the files we expect to find within the provided output directory
    $output_dir =~ s/(\/)+$//; # Remove trailing forward slashes if any
    my $gene_covg_dir = "$output_dir/gene_covgs"; # Should contain per-gene coverage files per sample
    my $total_covgs_file = "$output_dir/total_covgs"; # Should contain overall coverages per sample
    print STDERR "Directory with per-gene coverages not found: $gene_covg_dir\n" unless( -e $gene_covg_dir );
    print STDERR "Total coverages file not found or is empty: $total_covgs_file\n" unless( -s $total_covgs_file );
    return undef unless( -e $gene_covg_dir && -s $total_covgs_file );
    # Outputs of this script will be written to these locations in the output directory
    my $overall_bmr_file = "$output_dir/overall_bmrs";
    my $gene_mr_file = "$output_dir/gene_mrs";
    $self->gene_mr_file( $gene_mr_file );
    # Build a hash to quickly lookup the genes to be ignored for overall BMRs
    my %ignored_genes = ();
    if( defined $genes_to_ignore ) {
        %ignored_genes = map { $_ => 1 } split( /,/, $genes_to_ignore );
    }
    # Parse out the names of the samples which should match the names of the coverage files needed
    my ( @all_sample_names, %sample_idx );
    my $idx = 0;
    my $sampleFh = IO::File->new( $bam_list ) or die "Couldn't open $bam_list. $!";
    while( my $line = $sampleFh->getline ) {
        next if ( $line =~ m/^#/ );
        chomp( $line );
        my ( $sample ) = split( /\t/, $line );
        push( @all_sample_names, $sample );
        $sample_idx{$sample} = $idx++;
    }
    $sampleFh->close;
    # If the reference sequence FASTA file hasn't been indexed, do it
    my $ref_seq_idx = "$ref_seq.fai";
    Genome::Sys->shellcmd( cmd => "samtools faidx $ref_seq" ) unless( -e $ref_seq_idx );
    # Parse gene names and ROIs. Mutations outside these ROIs will be skipped
    my ( @all_gene_names, %gene_idx );
    $idx = 0;
    my $roi_bitmask = $self->create_empty_genome_bitmask( $ref_seq_idx );
    my $roiFh = IO::File->new( $roi_file ) or die "Couldn't open $roi_file. $!";
    while( my $line = $roiFh->getline ) {
        next if( $line =~ m/^#/ );
        chomp $line;
        my ( $chr, $start, $stop, $gene ) = split( /\t/, $line );
        if( !$roi_bitmask->{$chr} or $start > $roi_bitmask->{$chr}->Size ) {
            print STDERR "Skipping invalid ROI bitmask $chr:$start-$stop\n";
            next;
        }
        $roi_bitmask->{$chr}->Interval_Fill( $start, $stop );
        unless( defined $gene_idx{$gene} ) {
            push( @all_gene_names, $gene );
            $gene_idx{$gene} = $idx++;
        }
    }
    $roiFh->close;
    # These are the various categories that each mutation will be classified into
    my @mut_classes = ( AT_Transitions, AT_Transversions, CG_Transitions, CG_Transversions, CpG_Transitions, CpG_Transversions, Indels );
    push( @mut_classes, Truncations ) if( $separate_truncations );
    # Save the actual class names for reporting purposes, because the elements above are really just numerical constants
    my @mut_class_names = qw( AT_Transitions AT_Transversions CG_Transitions CG_Transversions CpG_Transitions CpG_Transversions Indels );
    push( @mut_class_names, 'Truncations' ) if( $separate_truncations );
    my @sample_mr; # Stores per sample covg and mutation information
    foreach my $sample ( @all_sample_names ) {
        $sample_mr[$sample_idx{$sample}][$_][mutations] = 0 foreach( @mut_classes );
        $sample_mr[$sample_idx{$sample}][$_][covd_bases] = 0 foreach( @mut_classes );
    }
    # Load the covered base-counts per sample from the output of "music bmr calc-covg"
    print STDERR "Loading per-sample coverages stored in $total_covgs_file\n";
    my $sample_cnt_in_total_covgs_file = 0;
    my $totCovgFh = IO::File->new( $total_covgs_file ) or die "Couldn't open $total_covgs_file. $!";
    while( my $line = $totCovgFh->getline ) {
        next unless( $line =~ m/^\S+\t\d+\t\d+\t\d+\t\d+$/ and $line !~ m/^#/ );
        chomp( $line );
        ++$sample_cnt_in_total_covgs_file;
        my ( $sample, $covd_bases, $covd_at_bases, $covd_cg_bases, $covd_cpg_bases ) = split( /\t/, $line );
        $sample_mr[$sample_idx{$sample}][AT_Transitions][covd_bases] = $covd_at_bases;
        $sample_mr[$sample_idx{$sample}][AT_Transversions][covd_bases] = $covd_at_bases;
        $sample_mr[$sample_idx{$sample}][CG_Transitions][covd_bases] = $covd_cg_bases;
        $sample_mr[$sample_idx{$sample}][CG_Transversions][covd_bases] = $covd_cg_bases;
        $sample_mr[$sample_idx{$sample}][CpG_Transitions][covd_bases] = $covd_cpg_bases;
        $sample_mr[$sample_idx{$sample}][CpG_Transversions][covd_bases] = $covd_cpg_bases;
        $sample_mr[$sample_idx{$sample}][Indels][covd_bases] = $covd_bases;
        $sample_mr[$sample_idx{$sample}][Truncations][covd_bases] = $covd_bases if( $separate_truncations );
    }
    $totCovgFh->close;
    unless( $sample_cnt_in_total_covgs_file == scalar( @all_sample_names )) {
        print STDERR "Mismatching number of samples in $total_covgs_file and $bam_list\n";
        return undef;
    }
    my @gene_mr; # Stores per gene covg and mutation information
    foreach my $gene ( @all_gene_names ) {
        foreach my $sample ( @all_sample_names ) {
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$_][mutations] = 0 foreach( @mut_classes );
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$_][covd_bases] = 0 foreach( @mut_classes );
        }
    }
    # Sum up the per-gene covered base-counts across samples from the output of "music bmr calc-covg"
    print STDERR "Loading per-gene coverage files stored under $gene_covg_dir/\n";
    foreach my $sample ( @all_sample_names ) {
        my $sample_covg_file = "$gene_covg_dir/$sample.covg";
        my $sampleCovgFh = IO::File->new( $sample_covg_file ) or die "Couldn't open $sample_covg_file. $!";
        while( my $line = $sampleCovgFh->getline ) {
            next unless( $line =~ m/^\S+\t\d+\t\d+\t\d+\t\d+\t\d+$/ and $line !~ m/^#/ );
            chomp( $line );
            my ( $gene, undef, $covd_bases, $covd_at_bases, $covd_cg_bases, $covd_cpg_bases ) = split( /\t/, $line );
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][AT_Transitions][covd_bases] += $covd_at_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][AT_Transversions][covd_bases] += $covd_at_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][CG_Transitions][covd_bases] += $covd_cg_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][CG_Transversions][covd_bases] += $covd_cg_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][CpG_Transitions][covd_bases] += $covd_cpg_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][CpG_Transversions][covd_bases] += $covd_cpg_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][Indels][covd_bases] += $covd_bases;
            $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][Truncations][covd_bases] += $covd_bases if( $separate_truncations );
        }
        $sampleCovgFh->close;
    }
    # Run "joinx ref-stats" to classify SNVs as being at AT, CG, or CpG sites in the reference
    print STDERR "Running 'joinx ref-stats' to read reference FASTA and identify SNVs at AT, CG, CpG sites\n";
    my $maf_bed = Genome::Sys->create_temp_file_path();
    my $mafBedFh = IO::File->new( $maf_bed, ">" ) or die "Temporary file could not be created. $!";
    my $mafFh = IO::File->new( $maf_file ) or die "Couldn't open $maf_file. $!";
    while( my $line = $mafFh->getline ) {
        next if( $line =~ m/^(#|Hugo_Symbol)/ );
        chomp $line;
        my @cols = split( /\t/, $line );
        my ( $chr, $start, $stop, $mutation_type, $ref, $var1, $var2 ) = @cols[4..6,9..12];
        if( $mutation_type =~ m/^(SNP|DNP|ONP|TNP)$/ ) {
            $mafBedFh->print( "$chr\t" . ( $start - 2 ) . "\t" . ( $start + 1 ) . "\n" );
        }
    }
    $mafFh->close;
    $mafBedFh->close;
    my $refstats_file = Genome::Sys->create_temp_file_path();
    Genome::Sys->shellcmd( cmd => "joinx ref-stats --ref-bases --bed $maf_bed --fasta $ref_seq --output $refstats_file" );
    # Parse through the ref-stats output and load it into hashes for quick lookup later
    my ( %ref_base, %cpg_site );
    my $refStatsFh = IO::File->new( $refstats_file ) or die "Couldn't open $refstats_file. $!";
    while( my $line = $refStatsFh->getline ) {
        next if( $line =~ m/^#/ );
        chomp $line;
        my ( $chr, undef, $pos, undef, undef, undef, $ref ) = split( /\t/, $line );
        my $locus = "$chr\t" . ( $pos - 1 );
        $ref_base{$locus} = substr( $ref, 1, 1 );
        $cpg_site{$locus} = 1 if( $ref =~ m/CG/ );
    }
    $refStatsFh->close;
    # Create a hash to help classify SNVs
    my %classify;
    $classify{$_} = AT_Transitions foreach( qw( AG TC ));
    $classify{$_} = AT_Transversions foreach( qw( AC AT TA TG ));
    $classify{$_} = CG_Transitions foreach( qw( CT GA ));
    $classify{$_} = CG_Transversions foreach( qw( CA CG GC GT ));
    # Parse through the MAF file and categorize each somatic mutation
    print STDERR "Parsing MAF file to classify mutations\n";
    my %skip_cnts;
    $mafFh = IO::File->new( $maf_file ) or die "Couldn't open $maf_file. $!";
    while( my $line = $mafFh->getline ) {
        next if( $line =~ m/^(#|Hugo_Symbol)/ );
        chomp $line;
        my @cols = split( /\t/, $line );
        my ( $gene, $chr, $start, $stop, $mutation_class, $mutation_type, $ref, $var1, $var2, $sample ) = @cols[0,4..6,8..12,15];
        # Skip mutations in samples that are not in the provided bam list
        unless( defined $sample_idx{$sample} ) {
            $skip_cnts{"belong to unrecognized samples"}++;
            print STDERR "Skipping unrecognized sample ($sample not in BAM list): $gene, $chr:$start-$stop\n" if( $show_skipped );
            next;
        }
        # If the mutation classification is odd, quit with error
        if( $mutation_class !~ m/^(Missense_Mutation|Nonsense_Mutation|Nonstop_Mutation|Splice_Site|Translation_Start_Site|Frame_Shift_Del|Frame_Shift_Ins|In_Frame_Del|In_Frame_Ins|Silent|Intron|RNA|3'Flank|3'UTR|5'Flank|5'UTR|IGR|Targeted_Region|De_novo_Start_InFrame|De_novo_Start_OutOfFrame)$/ ) {
            print STDERR "Unrecognized Variant_Classification \"$mutation_class\" in MAF file: $gene, $chr:$start-$stop\n";
            print STDERR "Please use TCGA MAF Specification v2.3.\n";
            return undef;
        }
        # If user wants, skip Silent mutations, or those in Introns, RNA, UTRs, Flanks, IGRs, or the ubiquitous Targeted_Region
        if(( $skip_non_coding && $mutation_class =~ m/^(Intron|RNA|3'Flank|3'UTR|5'Flank|5'UTR|IGR|Targeted_Region)$/ ) ||
          ( $skip_silent && $mutation_class =~ m/^Silent$/ )) {
            $skip_cnts{"are classified as $mutation_class"}++;
            print STDERR "Skipping $mutation_class mutation: $gene, $chr:$start-$stop\n" if( $show_skipped );
            next;
        }
        # If the mutation type is odd, quit with error
        if( $mutation_type !~ m/^(SNP|DNP|TNP|ONP|INS|DEL|Consolidated)$/ ) {
            print STDERR "Unrecognized Variant_Type \"$mutation_type\" in MAF file: $gene, $chr:$start-$stop\n";
            print STDERR "Please use TCGA MAF Specification v2.3.\n";
            return undef;
        }
        # Skip mutations that were consolidated into others (E.g. SNP consolidated into a TNP)
        if( $mutation_type =~ m/^Consolidated$/ ) {
            $skip_cnts{"are consolidated into another"}++;
            print STDERR "Skipping consolidated mutation: $gene, $chr:$start-$stop\n" if( $show_skipped );
            next;
        }
        # Skip mutations that fall completely outside any of the provided regions of interest
        if( $self->count_bits( $roi_bitmask->{$chr}, $start, $stop ) == 0 ) {
            $skip_cnts{"are outside any ROIs"}++;
            print STDERR "Skipping mutation that falls outside ROIs: $gene, $chr:$start-$stop\n" if( $show_skipped );
            next;
        }
        # Skip mutations whose gene names don't match any of those in the ROI list
        unless( defined $gene_idx{$gene} ) {
            $skip_cnts{"have unrecognized gene names"}++;
            print STDERR "Skipping unrecognized gene name (not in ROI file): $gene, $chr:$start-$stop\n" if( $show_skipped );
            next;
        }
        my $class = '';
        # Check if the mutation is the truncating type, if the user wanted a separate category of those
        if( $separate_truncations && $mutation_class =~ m/^(Nonsense_Mutation|Splice_Site|Frame_Shift_Del|Frame_Shift_Ins)/ ) {
            $class = Truncations;
        }
        # Classify the mutation as AT/CG/CpG Transition, AT/CG/CpG Transversion
        elsif( $mutation_type =~ m/^(SNP|DNP|ONP|TNP)$/ ) {
            # ::TBD:: For DNPs and TNPs, we use only the first base for mutation classification
            $ref = substr( $ref, 0, 1 );
            $var1 = substr( $var1, 0, 1 );
            $var2 = substr( $var2, 0, 1 );
            # If the alleles are anything but A, C, G, or T then quit with error
            if( $ref !~ m/[ACGT]/ || $var1 !~ m/[ACGT]/ || $var2 !~ m/[ACGT]/ ) {
                print STDERR "Unrecognized allele in column Reference_Allele, Tumor_Seq_Allele1, or Tumor_Seq_Allele2: $gene, $chr:$start-$stop\n";
                print STDERR "Please use TCGA MAF Specification v2.3.\n";
                return undef;
            }
            # Use the classify hash to find whether this SNV is an AT/CG Transition/Transversion
            $class = $classify{ "$ref$var1" } if( defined $classify{ "$ref$var1" } );
            $class = $classify{ "$ref$var2" } if( defined $classify{ "$ref$var2" } );
            # Check if the ref base in the MAF matched what we fetched from the ref-seq
            my $locus = "$chr\t$start";
            if( defined $ref_base{$locus} && $ref_base{$locus} ne $ref ) {
                print STDERR "Reference allele $ref for $gene variant at $chr:$start-$stop is " . $ref_base{$locus} . " in the FASTA. Using it anyway.\n";
            }
            # Check if a C or G reference allele belongs to a CpG pair in the refseq
            if(( $ref eq 'C' || $ref eq 'G' ) && defined $cpg_site{$locus} ) {
                $class = (( $class == CG_Transitions ) ? CpG_Transitions : CpG_Transversions );
            }
        }
        # Classify it as an indel (excludes splice-site and frame-shift if user wanted truncations separately)
        elsif( $mutation_type =~ m/^(INS|DEL)$/ ) {
            $class = Indels;
        }
        # The user's gene exclusion list affects only the overall BMR calculations
        $sample_mr[$sample_idx{$sample}][$class][mutations]++ unless( defined $ignored_genes{$gene} );
        $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$class][mutations]++;
    }
    $mafFh->close;
    # Display statistics related to parsing the MAF
    print STDERR "Finished Parsing the MAF file to classify mutations\n";
    foreach my $skip_type ( sort {$skip_cnts{$b} <=> $skip_cnts{$a}} keys %skip_cnts ) {
        print STDERR "Skipped " . $skip_cnts{$skip_type} . " mutation(s) that $skip_type\n" if( defined $skip_cnts{$skip_type} );
    }
    # If the user wants, merge together concurrent mutations of a gene in the same sample
    if( $merge_concurrent_muts ) {
        foreach my $sample ( @all_sample_names ) {
            foreach my $gene ( @all_gene_names ) {
                next unless( defined $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}] );
                my $num_muts = 0;
                $num_muts += $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$_][mutations] foreach( @mut_classes );
                if( $num_muts > 1 ) {
                    foreach my $class ( @mut_classes ) {
                        my $muts_in_class = $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$class][mutations]; # Num of muts of gene in this class
                        $sample_mr[$sample_idx{$sample}][$class][mutations] -= $muts_in_class; # Take it out of the sample total
                        $muts_in_class /= $num_muts; # Turn it into a fraction of the total number of muts in this gene
                        $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$class][mutations] = $muts_in_class; # Use the fraction as the num muts of gene in this class
                        $sample_mr[$sample_idx{$sample}][$class][mutations] += $muts_in_class; # Add the same fraction to the sample total
                    }
                }
            }
        }
    }
    # Calculate per-sample BMRs, and also subtract out covered bases in genes the user wants ignored
    foreach my $sample ( @all_sample_names ) {
        my $tot_muts = 0;
        foreach my $class ( @mut_classes ) {
            # Subtract the covered bases in this class that belong to the genes to be ignored
            # ::TBD:: Some of these bases may also belong to another gene (on the other strand maybe?), and those should not be subtracted
            foreach my $ignored_gene ( keys %ignored_genes ) {
                $sample_mr[$sample_idx{$sample}][$class][covd_bases] -= $gene_mr[$sample_idx{$sample}][$gene_idx{$ignored_gene}][$class][covd_bases] if( defined $gene_mr[$sample_idx{$sample}][$gene_idx{$ignored_gene}] );
            }
            $tot_muts += $sample_mr[$sample_idx{$sample}][$class][mutations];
        }
        $sample_mr[$sample_idx{$sample}][Overall][bmr] = $tot_muts / $sample_mr[$sample_idx{$sample}][Indels][covd_bases];
    }
    # Cluster samples into bmr-groups using k-means clustering
    my @sample_bmrs = map { $sample_mr[$sample_idx{$_}][Overall][bmr] } @all_sample_names;
    my @bmr_clusters = k_means( $bmr_groups, \@sample_bmrs );
    # Calculate overall BMRs for each cluster of samples, and print them to file
    my %cluster_bmr; # Stores per cluster categorized BMR
    my $totBmrFh = IO::File->new( $overall_bmr_file, ">" ) or die "Couldn't open $overall_bmr_file. $!";
    $totBmrFh->print( "#User-specified genes skipped in these calculations: $genes_to_ignore\n" ) if( defined $genes_to_ignore );
    my ( $covered_bases_sum, $mutations_sum ) = ( 0, 0 );
    for( my $i = 0; $i < scalar( @bmr_clusters ); ++$i ) {
        my @samples_in_cluster = map { $all_sample_names[$_] } @{$bmr_clusters[$i]};
        unless( $bmr_groups == 1 ) {
            $totBmrFh->print( "#BMR sub-group ", $i + 1, " (", scalar( @{$bmr_clusters[$i]} ), " samples)\n" );
            $totBmrFh->print( "#Samples: ", join( ",", @samples_in_cluster ), "\n" );
        }
        $totBmrFh->print( "#Mutation_Class\tCovered_Bases\tMutations\tOverall_BMR\n" );
        my ( $tot_covd_bases, $tot_muts ) = ( 0, 0 );
        foreach my $class ( @mut_classes ) {
            my ( $covd_bases, $mutations ) = ( 0, 0 );
            foreach my $sample ( @samples_in_cluster ) {
                $covd_bases += $sample_mr[$sample_idx{$sample}][$class][covd_bases];
                $mutations += $sample_mr[$sample_idx{$sample}][$class][mutations];
            }
            $tot_covd_bases = $covd_bases if( $class == Indels ); # Save this to calculate overall BMR below
            # Calculate overall BMR for this mutation class and print it to file
            $cluster_bmr{$i}[$class][bmr] = ( $covd_bases == 0 ? 0 : ( $mutations / $covd_bases ));
            $totBmrFh->print( join( "\t", $mut_class_names[$class], $covd_bases, $mutations, $cluster_bmr{$i}[$class][bmr] ), "\n" );
            $tot_muts += $mutations;
        }
        $totBmrFh->print( join( "\t", "Overall_BMR", $tot_covd_bases, $tot_muts, $tot_muts / $tot_covd_bases ), "\n\n" );
        $covered_bases_sum += $tot_covd_bases;
        $mutations_sum += $tot_muts;
    }
    $totBmrFh->close;
    $self->bmr_output( $mutations_sum / $covered_bases_sum );
    # Print out a file containing per-gene mutation counts and covered bases for use by "music smg"
    my $geneBmrFh = IO::File->new( $gene_mr_file, ">" ) or die "Couldn't open $gene_mr_file. $!";
    $geneBmrFh->print( "#Gene\tMutation_Class\tCovered_Bases\tMutations\tBMR\n" );
    foreach my $gene ( sort @all_gene_names ) {
        my ( $tot_covd_bases, $tot_muts ) = ( 0, 0 );
        for( my $i = 0; $i < scalar( @bmr_clusters ); ++$i ) {
            my @samples_in_cluster = map { $all_sample_names[$_] } @{$bmr_clusters[$i]};
            foreach my $class ( @mut_classes ) {
                my ( $covd_bases, $mutations ) = ( 0, 0 );
                foreach my $sample( @samples_in_cluster ) {
                    if( defined $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}] ) {
                        $covd_bases += $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$class][covd_bases];
                        $mutations += $gene_mr[$sample_idx{$sample}][$gene_idx{$gene}][$class][mutations];
                    }
                }
                my $rename_class = $mut_class_names[$class];
                $rename_class = ( $rename_class . "_SubGroup" . ( $i + 1 )) if( $bmr_groups > 1 );
                $geneBmrFh->print( join( "\t", $gene, $rename_class, $covd_bases, $mutations, $cluster_bmr{$i}[$class][bmr] ), "\n" );
                $tot_muts += $mutations;
                $tot_covd_bases += $covd_bases if( $class == Indels );
            }
        }
        $geneBmrFh->print( join( "\t", $gene, "Overall", $tot_covd_bases, $tot_muts, $self->bmr_output ), "\n" );
    }
    $geneBmrFh->close;
    return 1;
}

# Creates an empty whole genome bitmask based on the given reference sequence index sub create_empty_genome_bitmask {
my ( $self, $ref_seq_idx_file ) = @_;
my %genome;
my $refFh = IO::File->new( $ref_seq_idx_file ) or die "Couldn't open $ref_seq_idx_file. $!";
while( my $line = $refFh->getline ) {
my ( $chr, $length ) = split( /\t/, $line );
$genome{$chr} = Bit::Vector->new( $length + 1 ); # Adding a base for 1-based coordinates
}
$refFh->close;
return \%genome; }

# Counts the number of bits that are set in the given region of a Bit:Vector sub count_bits {
my ( $self, $vector, $start, $stop ) = @_;
my $count = 0;
for my $pos ( $start..$stop ) {
++$count if( $vector->bit_test( $pos ));
}
return $count; }

# Given a list of numerical values, returns k clusters based on k-means clustering sub k_means {
my ( $k, $list_ref ) = @_;
my @vals = @{$list_ref};
my $num_vals = scalar( @vals );

    # Start with the first k values as the centroids
    my @centroids = @vals[0..($k-1)];
    my @prev_centroids = map { 0 } @centroids;
    my @groups = ();
    my $diff_means = 1; # Arbitrary non-zero value
    # Repeat until the difference between these centroids and the previous ones, converges to zero
    while( $diff_means > 0 ) {
        @groups = ();
        # Group values into clusters based on closest centroid
        for( my $i = 0; $i < $num_vals; ++$i ) {
            my @distances = map { abs( $vals[$i] - $_ ) } @centroids;
            my $closest = min( @distances );
            for( my $j = 0; $j < $k; ++$j ) {
                if( $distances[$j] == $closest ) { push( @{$groups[$j]}, $i ); last; }
            }
        }
        # Calculate means to be the new centroids, and the sum of differences
        $diff_means = 0;
        for( my $i = 0; $i < $k; ++$i ) {
            $centroids[$i] = sum( map {$vals[$_]} @{$groups[$i]} );
            $centroids[$i] /= scalar( @{$groups[$i]} );
            $diff_means += abs( $centroids[$i] - $prev_centroids[$i] );
        }
        # Save the current centroids for comparisons with those in the next iteration
        @prev_centroids = @centroids;
    }
    return @groups;
}

1;

2020-11-06 perl v5.30.3