20251125

99.scripts/trinity_utils/PerlLib/KmerGraphLib/AlignGraph.pm

@@ -0,0 +1,149 @@
+package main;
+our $SEE;
+
+package AlignGraph;
+
+use strict;
+use warnings;
+use Carp;
+use AlignNode;
+
+use base qw (ReadCoverageGraph);
+
+no warnings qw (recursion);
+
+
+sub new {
+	my $packagename = shift;
+	
+	my $self = $packagename->SUPER::new();
+
+	
+	## Nodes exist in order of end5 -> end3 at all times.  Strand is included in the node name just for safety reasons.
+
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+
+sub add_alignment {
+	my $self = shift;
+	
+	my ($read_acc, $scaffold, $strand, $genome_coords_aref) = @_;
+
+	my @align_positions;
+	
+	foreach my $coordset (sort {$a->[0]<=>$b->[0]} @$genome_coords_aref) {
+
+		my ($lend, $rend) = sort {$a<=>$b} @$coordset;
+		
+		for (my $i = $lend; $i <= $rend; $i++) {
+			push (@align_positions, $i);
+		}
+	}
+	
+	$self->_add_ordered_positions_to_graph(\@align_positions, $strand, $read_acc);
+	
+	return;
+
+}
+
+
+
+sub _add_ordered_positions_to_graph {
+	my $self = shift;
+	my ($ordered_positions_aref, $strand, $read_acc) = @_;
+
+	unless (ref $ordered_positions_aref eq 'ARRAY') {
+		confess "Error, require ordered position list";
+	}
+	unless ($strand =~ /^[\+\-]$/) {
+		confess "strand must be: + or - ";
+	}
+	
+	my @align_positions = @$ordered_positions_aref;
+
+	if ($strand eq '-') {
+		@align_positions = reverse @align_positions;
+	}
+
+	my $prev_align_pos = shift @align_positions;
+	while (@align_positions) {
+		my $next_align_pos = shift @align_positions;
+		
+		# print "\tadding $next_align_pos\n";
+		
+		my $prev_align_node = $self->get_or_create_node("$prev_align_pos,$strand", $read_acc);
+		my $next_align_node = $self->get_or_create_node("$next_align_pos,$strand", $read_acc);
+		
+		$self->link_adjacent_nodes($prev_align_node, $next_align_node);
+		
+		$prev_align_pos = $next_align_pos;
+
+	}
+	
+	return;
+}
+
+sub get_all_nodes {
+	my $self = shift;
+
+	return( sort {$a->{_value} cmp $b->{_value}} $self->SUPER::get_all_nodes());
+
+}
+
+
+
+1; #EOM
+
+
+=CIGAR_format
+
+from: http://bioperl.org/pipermail/bioperl-l/2003-March/011591.html
+
+cigar line format (where CIGAR stands for Concise
+Idiosyncratic Gapped Alignment Report).
+
+In the cigar line format alignments are sotred as follows:
+
+M: Match
+D: Deletino
+I: Insertion
+
+An example of an alignment for a hypthetical protein match is shown 
+below:
+
+
+Query:   42 PGPAGLP----GSVGLQGPRGLRGPLP-GPLGPPL...
+             PG    P    G     GP   R      PLGP
+Sbjct: 1672 PGTP*TPLVPLGPWVPLGPSSPR--LPSGPLGPTD...
+
+
+protein_align_feature table as the following cigar line:
+
+7M4D12M2I2MD7M
+
+
+
+ From SAM documentation:
+
+Clipped alignment. In Smith-Waterman alignment, a sequence may not be aligned from the first residue to the last one.
+Subsequences at the ends may be clipped off. We introduce operation ʻSʼ to describe (softly) clipped alignment. Here is
+an example. Suppose the clipped alignment is:
+
+REF: AGCTAGCATCGTGTCGCCCGTCTAGCATACGCATGATCGACTGTCAGCTAGTCAGACTAGTCGATCGATGTG
+READ: gggGTGTAACC-GACTAGgggg
+
+where on the read sequence, bases in uppercase are matches and bases in lowercase are clipped off. The CIGAR for
+this alignment is: 3S8M1D6M4S.
+Spliced alignment. In cDNA-to-genome alignment, we may want to distinguish introns from deletions in exons. We
+introduce operation ʻNʼ to represent long skip on the reference sequence. Suppose the spliced alignment is:
+
+REF: AGCTAGCATCGTGTCGCCCGTCTAGCATACGCATGATCGACTGTCAGCTAGTCAGACTAGTCGATCGATGTG
+READ: GTGTAACCC................................TCAGAATA
+
+where ʻ...ʼ on the read sequence indicates the intron. The CIGAR for this alignment is: 9M32N8M.
+
+=cut
+

99.scripts/trinity_utils/PerlLib/KmerGraphLib/AlignNode.pm

@@ -0,0 +1,19 @@
+package AlignNode;
+
+use base qw (ReadCoverageNode);
+
+## Instead of storing Kmers, will store base number and strand positions.
+
+sub new {
+	my $packagename = shift;
+	my ($stranded_base, $read_accession) = @_;
+	
+	my $self = $packagename->SUPER::new($stranded_base, $read_accession);
+	
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+
+1; #EOM

99.scripts/trinity_utils/PerlLib/KmerGraphLib/GenericGraph.pm

@@ -0,0 +1,221 @@
+package GenericGraph;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+	my $packagename = shift;
+	
+	my $self = { 
+		_nodes => {}, # node_name => node_reference
+		_edge_counter => {},  # prev_node -> after_node = count
+	};
+
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+
+sub get_or_create_node {
+	my $self = shift;
+	my $node_name = shift;
+	
+	if ($self->node_exists($node_name)) {
+		return($self->get_node($node_name));
+	}
+	else {
+		# instantiate it, add it to the graph
+		return($self->create_node($node_name));
+	}
+}
+	
+
+sub node_exists {
+	my $self = shift;
+	my $node_name = shift;
+	
+	unless ($node_name =~ /\w/) {
+		confess "Error, node_name required";
+	}
+	
+	if (exists $self->{_nodes}->{$node_name}) {
+		return(1);
+	}
+	else {
+		return(0);
+	}
+}
+
+sub get_node {
+	my $self = shift;
+	my $node_name = shift;
+
+	if (! $self->node_exists($node_name)) {
+		confess "Error, $node_name doesn't exist in graph";
+	}
+
+	my $node = $self->{_nodes}->{$node_name};
+	
+	return($node);
+}
+
+sub get_all_nodes {
+	my $self = shift;
+	
+	return(values %{$self->{_nodes}});
+}
+
+
+sub create_node {
+	my $self = shift;
+
+	my $node_name = shift;
+
+	if ($self->node_exists($node_name)) {
+		confess "Error, node $node_name already exists in the graph";
+	}
+
+	my $node = new GenericNode($node_name);
+	
+	$self->{_nodes}->{$node_name} = $node;
+	
+	return($node);
+}
+
+
+sub link_adjacent_nodes {
+	my $self = shift;
+	my ($before_node, $after_node, $edge_increment) = @_;
+
+	unless (ref $before_node && ref $after_node) {
+		confess "Error, need both before and after nodes for linking";
+	}
+	
+	$before_node->add_next_node($after_node);
+	$after_node->add_prev_node($before_node);
+
+	if (defined($edge_increment)) {
+		if ($edge_increment =~ /^\d+/ && $edge_increment > 0) {
+			$self->{_edge_counter}->{$before_node}->{$after_node} += $edge_increment;
+		}
+	}
+	else {
+		$self->{_edge_counter}->{$before_node}->{$after_node}++;
+	}
+	
+	
+	return;
+}
+
+
+sub get_edge_count {
+	my $self = shift;
+	my ($prev_node, $next_node) = @_;
+
+	my $edge_count = $self->{_edge_counter}->{$prev_node}->{$next_node} || 0;
+	
+	return($edge_count);
+}
+
+
+####
+sub prune_nodes_from_graph {
+	my $self = shift;
+	my @nodes = @_;
+
+	my $graph_nodes_href = $self->{_nodes};
+
+	foreach my $node (@nodes) {
+
+		delete ($self->{_edge_counter}->{$node}); # remove edge counts starting at current node.
+		
+		my $node_name = $node->get_value();
+		delete $graph_nodes_href->{$node_name};
+		
+		my @next_nodes = $node->get_all_next_nodes();
+		my @prev_nodes = $node->get_all_prev_nodes();
+		
+		foreach my $prev_node (@prev_nodes) {
+			$prev_node->delete_next_node($node);
+			$node->delete_prev_node($prev_node);
+			
+			delete ($self->{_edge_counter}->{$prev_node}->{$node}); # remove edge counts for prev nodes linking to current node.
+
+		}
+		
+		foreach my $next_node (@next_nodes) {
+			
+			$next_node->delete_prev_node($node);
+			$node->delete_next_node($next_node);
+		}
+
+
+	}
+	
+	
+	return;
+}
+
+####
+sub prune_edge {
+	my $self = shift;
+	my ($prev_node, $node) = @_;
+
+	# Sever connection between nodes.
+
+	$prev_node->delete_next_node($node);
+	$node->delete_prev_node($prev_node);
+	
+	delete ($self->{_edge_counter}->{$prev_node}->{$node});
+
+	return;
+}
+
+
+####
+sub print_path {
+	my @nodes = @_;
+
+	my $counter = 0;
+	foreach my $node (@nodes) {
+		$counter++;
+		printf("%4s", $counter);
+		print " " . $node->get_value() . "\n";
+	}
+	print "\n";
+	
+	return;
+}
+
+####
+sub toString {
+	my $self = shift;
+
+	my @nodes = $self->get_all_nodes();
+
+	my $text = "";
+	foreach my $node (@nodes) {
+		$text .= $node->toString() . "\n";
+	}
+
+	return($text);
+}
+
+####
+sub get_root_nodes {
+	my $self = shift;
+
+	my @roots;
+	foreach my $node ($self->get_all_nodes()) {
+		unless ($node->get_all_prev_nodes()) {
+			push (@roots, $node);
+		}
+	}
+
+	return(@roots);
+}
+
+
+1; #EOM

99.scripts/trinity_utils/PerlLib/KmerGraphLib/GenericNode.pm

@@ -0,0 +1,170 @@
+package GenericNode;
+
+use strict;
+use warnings;
+
+use Carp;
+
+my $ID_counter = 0;
+
+sub new {
+	my $packagename = shift;
+	
+	my ($value) = @_;
+	
+	my $self = {
+
+		_value => $value,
+		_prev => {},
+		_next => {},
+		
+		_ID => ++$ID_counter,
+
+		_colors => {},
+
+	};
+
+	bless ($self, $packagename);
+
+	return($self);
+	
+}
+
+sub get_hexID {
+	my $self = shift;
+
+	my $id = sprintf("%x", $self->{_ID});
+	
+	return("$id");
+}
+
+sub get_ID {
+    my $self = shift;
+    return($self->{_ID});
+}
+
+
+sub get_value {
+	my $self = shift;
+
+	return($self->{_value});
+}
+
+sub set_value {
+	my ($self) = shift;
+	my ($value) = @_;
+	
+	$self->{_value} = $value;
+}
+
+sub add_prev_node {
+	my $self = shift;
+	my ($prev_node) = @_;
+
+	unless (ref $prev_node) {
+		croak "Error, prev_node should be a node object";
+	}
+	$self->{_prev}->{$prev_node} = $prev_node;
+	return;
+}
+
+sub add_next_node {
+	my $self = shift;
+	my ($next_node) = @_;
+
+	unless (ref $next_node) {
+		croak "Error, next_node should be a node object";
+	}
+	
+	$self->{_next}->{$next_node} = $next_node;
+}
+
+sub has_next_node {
+	my $self = shift;
+	my $next_node = shift;
+
+	if (exists $self->{_next}->{$next_node}) {
+		return(1);
+	}
+	else {
+		return(0);
+	}
+}
+
+sub has_prev_node {
+	my $self = shift;
+	my $prev_node = shift;
+
+	if (exists $self->{_prev}->{$prev_node}) {
+		return(1);
+	}
+	else {
+		return(0);
+	}
+}
+
+
+
+sub get_all_prev_nodes {
+	my $self = shift;
+	my @prev_nodes = grep { ref($_) } values %{$self->{_prev}};
+	
+	#print "Prev: " . join(",", @prev_nodes) . "\n";
+	
+	return(@prev_nodes);
+	
+}
+
+sub get_all_next_nodes {
+	my $self = shift;
+	my @next_nodes = grep { ref($_) } values %{$self->{_next}};
+	
+	#print "Next: " . join(",", @next_nodes) . "\n";
+	
+	return(@next_nodes);
+	
+}
+
+sub delete_prev_node {
+	my $self = shift;
+	my $node = shift;
+
+	my $prev_nodes_href = $self->{_prev};
+	delete $prev_nodes_href->{$node};
+
+	return;
+}
+
+sub delete_next_node {
+	my $self = shift;
+	my $node = shift;
+
+	my $next_nodes_href = $self->{_next};
+	delete $next_nodes_href->{$node};
+	
+	return;
+}
+
+
+sub add_color {
+	my $self = shift;
+
+	my $color = shift;
+
+	$self->{_colors}->{$color}++;
+
+	return;
+}
+
+sub get_colors {
+	my $self = shift;
+
+	return(keys %{$self->{_colors}});
+}
+
+
+
+
+1; #EOM
+
+

99.scripts/trinity_utils/PerlLib/KmerGraphLib/KmerNode.pm

@@ -0,0 +1,173 @@
+package KmerNode;
+
+use strict;
+use warnings;
+use Carp;
+use ReadTracker;
+
+use base qw (GenericNode);
+
+sub new {
+	my $packagename = shift;
+	my ($kmer_seq, $accession) = @_;
+	
+	my $self = $packagename->SUPER::new($kmer_seq);
+	
+	$self->{_count} = 0;
+	$self->{_ReadTracker} = new ReadTracker();
+	
+	$self->{depth} = undef;
+	
+	## for DP scans:
+	$self->{_visited} = 0;
+	$self->{_base_score} = 0;
+	$self->{_sum_score} = 0;
+	$self->{_best_prev} = undef; # prev_node in highest scoring path.
+	$self->{_forward_scores} = []; # stores structs of { node => ref, score => $score}
+	
+	
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+
+####
+sub get_ReadTracker {
+	my $self = shift;
+	return($self->{_ReadTracker});
+}
+
+
+sub get_sequence {
+	my $self = shift;
+
+	return($self->get_value());
+}
+
+sub set_sequence {
+	my $self = shift;
+	my $sequence = shift;
+	
+	unless ($sequence =~ /\w/) {
+		confess "Error, need sequence";
+	}
+
+	$self->set_value($sequence);
+
+	return;
+}
+
+sub track_reads {
+	my $self = shift;
+	my @accs = @_;
+
+	$self->{_ReadTracker}->track_reads(@accs);
+	
+	return;
+}
+
+sub get_count {
+	my $self = shift;
+
+	return($self->{_count});
+}
+
+sub set_count {
+	my $self = shift;
+
+	my ($count) = @_;
+
+	$self->{_count} = $count;
+	return;
+}
+
+
+
+####
+sub toString {
+        my $self = shift;
+        
+        my @prev_nodes = $self->get_all_prev_nodes();
+        
+        my @next_nodes = $self->get_all_next_nodes();
+        
+        my $text = "";
+        
+        foreach my $prev_node (@prev_nodes) {
+            $text .= "P " . $prev_node->get_value() . "(" . $prev_node->get_count() . ") $prev_node " . join(",", $prev_node->get_colors()) . "\n";
+        }
+        $text .= "X  " . $self->get_value() . "(" . $self->get_count() . ") $self " . join(",", $self->get_colors()) . "\n";
+        
+        foreach my $next_node (@next_nodes) {
+			$text .= "N   " . $next_node->get_value() . "(" . $self->get_count() . ") $next_node " . join(",", $next_node->get_colors()) . "\n";
+		}
+		
+		return($text);
+}
+
+
+####
+sub get_reads_exiting_node {
+	my $self = shift;
+
+	my @next_nodes = $self->get_all_next_nodes();
+	unless (@next_nodes) {
+		return();
+	}
+
+	my $read_tracker = $self->get_ReadTracker();
+
+	my @reads_in_node = $read_tracker->get_tracked_read_indices();
+
+	my @reads_in_next_nodes;
+	foreach my $next_node (@next_nodes) {
+		push (@reads_in_next_nodes, $next_node->get_ReadTracker()->get_tracked_read_indices());
+	}
+
+	my %next_node_reads = map { + $_ => 1 } @reads_in_next_nodes;
+
+	my @exiting_reads;
+	foreach my $read (@reads_in_node) {
+		if ($next_node_reads{$read}) {
+			push (@exiting_reads, $read);
+		}
+	}
+
+	return(@exiting_reads);
+}
+
+####
+sub get_reads_entering_node {
+	my $self = shift;
+	
+	my @prev_nodes = $self->get_all_prev_nodes();
+	unless (@prev_nodes) {
+		return();
+	}
+
+	my $read_tracker = $self->get_ReadTracker();
+
+	my @reads_in_node = $read_tracker->get_tracked_read_indices();
+
+	my @reads_in_prev_nodes;
+	foreach my $prev_node (@prev_nodes) {
+		push (@reads_in_prev_nodes, $prev_node->get_ReadTracker()->get_tracked_read_indices());
+	}
+
+	my %prev_node_reads = map { + $_ => 1 } @reads_in_prev_nodes;
+
+	my @entering_reads;
+	foreach my $read (@reads_in_node) {
+		if ($prev_node_reads{$read}) {
+			push (@entering_reads, $read);
+		}
+	}
+
+	return(@entering_reads);
+}
+
+
+
+1; #EOM
+

99.scripts/trinity_utils/PerlLib/KmerGraphLib/ReadCoverageGraph.pm

@@ -0,0 +1,244 @@
+package main;
+our $SEE;
+
+package ReadCoverageGraph;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(GenericGraph);
+use ReadCoverageNode;
+
+no warnings qw (recursion);
+
+sub new {
+	my $packagename = shift;
+	
+	my $self = $packagename->SUPER::new();
+
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+
+
+sub get_or_create_node {
+	my $self = shift;
+	my ($node_name, $read_accession) = @_;
+	
+	if ($self->node_exists($node_name)) {
+		my $node = $self->get_node($node_name);
+		$node->add_read($read_accession);
+		return($node);
+		
+	}
+	else {
+		# instantiate it, add it to the graph
+		return($self->create_node($node_name, $read_accession));
+	}
+}
+	
+
+sub create_node {
+	my $self = shift;
+
+	my ($node_name, $read_accession) = @_;
+	
+	if ($self->node_exists($node_name)) {
+		confess "Error, node $node_name already exists in the graph";
+	}
+
+	my $node = new ReadCoverageNode($node_name, $read_accession);
+	
+	$self->{_nodes}->{$node_name} = $node;
+	
+	return($node);
+}
+
+
+####
+sub get_nodes_sorted_by_count_desc {
+	my $self = shift;
+	my @nodes = $self->get_all_nodes();
+
+	@nodes = reverse sort {$a->{_count}<=>$b->{_count}} @nodes;
+	
+	return(@nodes);
+}
+
+
+sub find_maximal_path_including_node {
+	my $self = shift;
+	
+	my ($nucleating_node, $max_recurse_depth) = @_;
+
+	my $path_forward_aref = [$nucleating_node];
+	my $depth_forward = 0;
+	my $sum_forward_count = 0;
+	do {
+		my $start_node = $path_forward_aref->[-1];
+		($path_forward_aref, $sum_forward_count, $depth_forward) = $self->extend_path("next", $start_node, $path_forward_aref, $max_recurse_depth, 0, 0);
+		
+		if ($main::SEE) {
+			print "Forward.\n";
+			&print_path(@$path_forward_aref);
+		}
+
+	} while ($depth_forward > 0);
+
+	if ($main::SEE) {
+		print "Forward, done.\n";
+		&print_path(@$path_forward_aref);
+	}
+	
+	
+	my $path_reverse_aref = [$nucleating_node];
+	my $depth_reverse = 0;
+	my $sum_reverse_count = 0;
+	do {
+		my $start_node = $path_reverse_aref->[-1];
+		($path_reverse_aref, $sum_reverse_count, $depth_reverse) = $self->extend_path("prev", $start_node, $path_reverse_aref, $max_recurse_depth, 0, 0);
+		
+		if ($main::SEE) {
+			print "Reverse:\n";
+			&print_path(@$path_reverse_aref);
+		}
+
+	} while ($depth_reverse > 0);
+	
+
+	if ($main::SEE) {
+		print "Reverse, done.\n";
+		&print_path(@$path_reverse_aref);
+	}
+	
+	## unwrap path
+
+	# pull out the nucleating node, should be first one in each path.
+	shift @$path_forward_aref;
+	shift @$path_reverse_aref;
+	
+	my @path = ( (reverse @$path_reverse_aref), $nucleating_node, @$path_forward_aref);
+	
+	if ($main::SEE) {
+		print "Done.\n";
+		&print_path(@path);
+	}
+	
+	return(@path);
+	
+}
+
+
+####
+sub extend_path {
+	my $self = shift;
+	
+	my ($direction, 
+		$node, 
+		$curr_path_list_aref,
+		$max_recurse_depth, 
+		$sum_counts, 
+		$curr_depth) = @_;
+
+	
+	my $path_length = scalar (@$curr_path_list_aref);
+	
+	print "extending $direction from " . $node->get_value() . ", K:$path_length S:$sum_counts, D:$curr_depth\n" if $main::SEE;
+	
+	#print join("\t", @_) . "\n";
+	
+	## curr_path_list_aref should include the incoming node already
+
+	if ($curr_depth >= $max_recurse_depth) {
+		return($curr_path_list_aref, $sum_counts, $curr_depth);
+	}
+
+	## explore connected nodes
+	my @other_nodes;
+	if ($direction eq 'next') {
+		@other_nodes = $node->get_all_next_nodes();
+	}
+	else {
+		@other_nodes = $node->get_all_prev_nodes();
+	}
+
+	## only explore those other_node's that are not already seen along the current path
+	my @unseen_nodes;
+
+	foreach my $other_node (@other_nodes) {
+		unless (grep {$_ == $other_node} @$curr_path_list_aref) {
+			push (@unseen_nodes, $other_node);
+		}
+	}
+	
+	#print "Curr path nodes: " . join(" ", @$curr_path_list_aref) . "\n";
+
+	@other_nodes = @unseen_nodes; # reset to those that haven't been seen already.
+
+	#print "\tOther nodes: " . join(" ", @other_nodes) . "\n\n";
+
+	if (@other_nodes) {
+		## examine possible paths:
+		
+		if ($main::SEE) {
+			print "Extending from:\n" . $node->get_value() . " (" . $node->get_count() . ") Depth:$curr_depth to\n";
+			foreach my $other_node (@other_nodes) {
+				print $other_node->get_value() . " (" . $other_node->get_count() . ")\n";
+			}
+			print "\n";
+		}
+		
+		
+		my @alt_paths;
+		foreach my $other_node (@other_nodes) {
+			#print $other_node->toString() . "\n";
+			
+			my ($path_list_aref, $counts, $depth) = $self->extend_path($direction,
+																	   $other_node,
+																	   [@$curr_path_list_aref, $other_node], # tack it on to the list
+																	   $max_recurse_depth, 
+																	   $sum_counts + $other_node->get_count(), 
+																	   $curr_depth+1);
+			
+			push (@alt_paths, [$path_list_aref, $counts, $depth]);
+		}
+		
+		## select the greatest one
+		@alt_paths = sort {  #$a->[2] <=> $b->[2]   ## Perhaps include extension length
+							 #	 ||
+								 $a->[1] <=>$b->[1] } @alt_paths;
+		
+		my $top_path = pop @alt_paths;
+		
+		my ($path_list_aref, $counts, $depth) = @$top_path;
+		return($path_list_aref, $counts, $depth);
+	}
+	else {
+		## no extensions possible
+		return($curr_path_list_aref, $sum_counts, $curr_depth);
+	}
+}
+
+
+
+####
+sub print_path {
+	my @nodes = @_;
+
+	my $counter = 0;
+	foreach my $node (@nodes) {
+		$counter++;
+		printf("%4s", $counter);
+		print " " . $node->get_value() . " C:" . $node->get_count() . "\n";
+	}
+	print "\n";
+	
+	return;
+}
+
+
+
+1; #EOM

99.scripts/trinity_utils/PerlLib/KmerGraphLib/ReadCoverageNode.pm

@@ -0,0 +1,188 @@
+package ReadCoverageNode;
+
+use strict;
+use warnings;
+
+use Carp;
+use base qw (GenericNode);
+
+
+## static vars
+my %READ_TRACKER;
+my $READ_COUNTER = 0;
+
+
+sub new {
+	my $packagename = shift;
+	my ($node_name, $read_acc) = @_;
+
+	my $self = $packagename->SUPER::new($node_name); # sets _value
+	
+
+
+	$self->{_reads} = {};
+	$self->{_count} = 0;
+
+
+	bless ($self, $packagename);
+
+	$self->add_read($read_acc);
+
+
+	return($self);
+}
+
+####
+sub get_count {
+	my $self = shift;
+	return($self->{_count});
+}
+
+
+sub set_count {
+	my $self = shift;
+	my $count = shift;
+
+	$self->{_count} = $count;
+	return;
+}
+
+
+####
+sub add_read {
+	my $self = shift;
+	my $read_acc = shift;
+
+	
+	my $node_name = $self->get_value();
+	unless ((defined $read_acc) && $read_acc =~ /\w/) {
+		confess "Error, need read accession";
+	}
+
+	my $read_tracking_no = $self->_get_or_create_tracking_number($read_acc);
+
+	if (exists $self->{_reads}->{$read_tracking_no}) {
+				
+		#print "Already got read $read_acc for $node_name, count:" . $self->get_count() . "\n";
+		
+	}
+	else {
+		$self->{_reads}->{$read_tracking_no} = 1;
+		$self->{_count}++;
+	
+		#print "-incrementing count for $read_acc for $node_name => $self->{_count}\n";
+		
+	}
+	
+	return;
+}
+		
+####
+sub get_reads {
+	my $self = shift;
+	
+	my @reads = keys %{$self->{_reads}};
+
+	return(@reads);
+}
+
+###
+sub has_read {
+	my $self = shift;
+	my $read_acc = shift;
+	
+	if (exists $self->{_reads}->{$read_acc}) {
+		return(1);
+	}
+	else {
+		return(0);
+	}
+}
+
+
+
+####
+sub count_reads_in_common {
+	my $self = shift;
+	my $other_node = shift;
+
+	my $count = 0;
+	
+	foreach my $read ($self->get_reads()) {
+		if ($other_node->has_read($read)) {
+			$count++;
+		}
+	}
+	
+	return($count);
+}
+
+####
+sub toString {
+	my $self = shift;
+	
+	my @prev_nodes = $self->get_all_prev_nodes();
+	
+	my @next_nodes = $self->get_all_next_nodes();
+	
+	my $text = "";
+	
+	foreach my $prev_node (@prev_nodes) {
+	    $text .= "P " . $prev_node->get_value() . "(" . $prev_node->get_count() . ")\n";
+	}
+	$text .= "X  " . $self->get_value() . "(" . $self->get_count() . ")\n";
+	
+	foreach my $next_node (@next_nodes) {
+		$text .= "N   " . $next_node->get_value() . "(" . $self->get_count() . ")\n";
+	}
+	
+	return($text);
+}
+
+#### Private read tracking   ## this should probably be a separate class at some point, with a singleton class object.
+
+sub _read_is_tracked {
+	my $self = shift;
+	my $read_acc = shift;
+
+	if (exists $READ_TRACKER{$read_acc}) {
+		return(1);
+	}
+	else {
+		return(0);
+	}
+}
+
+sub _get_read_tracking_number {
+	my $self = shift;
+	my $read_acc = shift;
+
+	if (! $self->_read_is_tracked($read_acc)) {
+		die "Error, read $read_acc is not tracked";
+	}
+	
+	my $tracking_number = $READ_TRACKER{$read_acc};
+	return($tracking_number);
+}
+
+sub _get_or_create_tracking_number {
+	my $self = shift;
+	my $read_acc = shift;
+
+	if ($self->_read_is_tracked($read_acc)) {
+		return($self->_get_read_tracking_number($read_acc));
+	}
+	else {
+		## track this new read:
+		$READ_COUNTER++;
+		$READ_TRACKER{$read_acc} = $READ_COUNTER;
+		return($self->_get_read_tracking_number($read_acc));
+	}
+}
+
+
+   
+
+
+
+1; # EOM

99.scripts/trinity_utils/PerlLib/KmerGraphLib/ReadManager.pm

@@ -0,0 +1,31 @@
+package ReadManager;
+
+use strict;
+use warnings;
+use Carp;
+
+
+my $counter = 0;
+my %read_acc_to_counter;
+
+
+####
+sub get_read_index {
+	my ($read_acc) = @_;
+
+	if (my $read_index = $read_acc_to_counter{$read_acc}) {
+		
+		return($read_index);
+	}
+
+	else {
+
+		$counter++;
+		$read_acc_to_counter{$read_acc} = $counter;
+
+		return($counter);
+	}
+}
+
+1; #EOM
+

99.scripts/trinity_utils/PerlLib/KmerGraphLib/ReadTracker.pm

@@ -0,0 +1,67 @@
+package ReadTracker;
+
+use strict;
+use warnings;
+use Carp;
+use ReadManager;
+
+
+sub new {
+	my ($packagename) = shift;
+	
+	
+	my $self = { reads => {}, # read indices, use ReadManager to hold full acc strings.
+
+	};
+
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+sub track_reads {
+	my $self = shift;
+	my @reads = @_;
+
+	foreach my $read (@reads) {
+		my $index = &ReadManager::get_read_index($read);
+		$self->{reads}->{$index}++;
+	}
+
+	return;
+}
+
+sub append_to_ReadTracker {
+	my $self = shift;
+	my $to_add_ReadTracker = shift;
+
+	foreach my $read_index (keys %{$to_add_ReadTracker->{reads}}) {
+		$self->{reads}->{$read_index} += $to_add_ReadTracker->{reads}->{$read_index};
+	}
+	
+	return;
+}
+
+sub get_tracked_read_indices {
+	my $self = shift;
+
+	return(keys %{$self->{reads}});
+}
+
+sub get_read_base_count {
+	my $self = shift;
+	my $read = shift;
+
+	unless (defined $self->{reads}->{$read}) {
+		confess "Error, no read index stored [$read] ";
+	}
+
+	return($self->{reads}->{$read});
+}
+
+	
+
+1; #EOM
+
+	
+					 

99.scripts/trinity_utils/PerlLib/KmerGraphLib/SAM_entry.pm

@@ -0,0 +1,411 @@
+package SAM_entry;
+
+use strict;
+use warnings;
+use Carp;
+
+
+
+sub new {
+	my $packagename = shift;
+	my ($line) = @_;
+
+	unless (defined $line) {
+		confess "Error, need sam text line as parameter";
+	}
+
+	chomp $line;
+
+	my @fields = split(/\t/, $line);
+	
+	my $self = {
+		_fields => [@fields],
+	};
+	
+	bless ($self, $packagename);
+	
+	return($self);
+}
+
+
+####
+sub get_read_name {
+	my $self = shift;
+	return ($self->{_fields}->[0]);
+}
+
+
+####
+sub get_scaffold_name {
+	my $self = shift;
+	return($self->{_fields}->[2]);
+}
+
+####
+sub get_aligned_position {
+	my $self = shift;
+	return($self->{_fields}->[3]);
+}
+
+sub get_scaffold_position { # preferred
+	my $self = shift;
+	return($self->get_aligned_position());
+}
+
+
+####
+sub get_cigar_alignment {
+	my $self = shift;
+	return($self->{_fields}->[5]);
+}
+
+####
+sub get_alignment_coords {
+	my $self = shift;
+
+	my $genome_lend = $self->get_aligned_position();
+
+	my $alignment = $self->get_cigar_alignment();
+
+	my $query_lend = 0;
+
+	my @genome_coords;
+	my @query_coords;
+
+
+	$genome_lend--; # move pointer just before first position.
+	
+	while ($alignment =~ /(\d+)([A-Z])/g) {
+		my $len = $1;
+		my $code = $2;
+		
+		unless ($code =~ /^[MSDNIH]$/) {
+			confess "Error, cannot parse cigar code [$code]";
+		}
+		
+		# print "parsed $len,$code\n";
+		
+		if ($code eq 'M' || $code eq 'S' || $code eq 'H') { # aligned bases match or mismatch
+			
+			my $genome_rend = $genome_lend + $len;
+			my $query_rend = $query_lend + $len;
+			
+			push (@genome_coords, [$genome_lend+1, $genome_rend]);
+			push (@query_coords, [$query_lend+1, $query_rend]);
+			
+			# reset coord pointers
+			$genome_lend = $genome_rend;
+			$query_lend = $query_rend;
+			
+		}
+		elsif ($code eq 'D' || $code eq 'N') { # insertion in the genome, gap in query (intron, perhaps)
+			$genome_lend += $len;
+			
+		}
+
+		elsif ($code eq 'I') { # gap in genome, insertion in query 
+
+			$query_lend += $len;
+
+		}
+	}
+
+	return(\@genome_coords, \@query_coords);
+}
+
+
+####
+sub get_mate_scaffold_name {
+	my $self = shift;
+   
+	return($self->{_fields}->[6]);
+}
+
+
+####
+sub set_mate_scaffold_name {
+	my $self = shift;
+	my $mate_scaffold_name = shift;
+	
+	$self->{_fields}->[6] = $mate_scaffold_name;
+	
+	return;
+}
+
+
+####
+sub get_mate_scaffold_position {
+	my $self = shift;
+
+	return($self->{_fields}->[7]);
+}
+
+
+####
+sub set_mate_scaffold_position {
+	my $self = shift;
+	my $scaff_pos = shift;
+   
+	$self->{_fields}->[7] = $scaff_pos;
+	
+	return;
+}
+
+
+####
+sub toString {
+	my $self = shift;
+	return( join("\t", @{$self->{_fields}}) );
+}
+
+
+####
+sub get_mapping_quality {
+	my $self = shift;
+	return($self->{_fields}->[4]);
+}
+
+
+####
+sub get_sequence {
+	my $self = shift;
+	return($self->{_fields}->[9]);
+}
+
+####
+sub get_quality_scores {
+	my $self = shift;
+	return($self->{_fields}->[10]);
+}
+
+
+
+###################
+## Flag Processing
+###################
+
+# from sam format spec:
+
+=flag_description
+
+Flag Description
+0x0001 the read is paired in sequencing, no matter whether it is mapped in a pair
+0x0002 the read is mapped in a proper pair (depends on the protocol, normally inferred during alignment) 1
+0x0004 the query sequence itself is unmapped
+0x0008 the mate is unmapped 1
+0x0010 strand of the query (0 for forward; 1 for reverse strand)
+0x0020 strand of the mate 1
+0x0040 the read is the first read in a pair 1,2
+0x0080 the read is the second read in a pair 1,2
+0x0100 the alignment is not primary (a read having split hits may have multiple primary alignment records)
+0x0200 the read fails platform/vendor quality checks
+0x0400 the read is either a PCR duplicate or an optical duplicate
+
+1. Flag 0x02, 0x08, 0x20, 0x40 and 0x80 are only meaningful when flag 0x01 is present.
+2. If in a read pair the information on which read is the first in the pair is lost in the upstream analysis, flag 0x01 shuld
+be present and 0x40 and 0x80 are both zero.
+
+=cut
+
+
+####
+sub get_flag {
+	my $self = shift;
+	my $flag = $self->{_fields}->[1];
+	return($flag);
+}
+
+sub set_flag {
+	my $self = shift;
+	my $flag = shift;
+
+	unless (defined $flag) {
+		confess "Error, need flag value";
+	}
+
+	$self->{_fields}->[1] = $flag;
+	return;
+}
+
+####
+sub is_paired {
+	my $self = shift;
+	return($self->_get_bit_val(0x0001));
+}
+
+sub set_paired {
+	my $self = shift;
+	my $bit_val = shift;
+	
+	$self->_set_bit_val(0x0001, $bit_val);
+	
+	return;
+}
+
+####
+sub is_proper_pair {
+	my $self = shift;
+	return($self->_get_bit_val(0x0002));
+}
+
+sub set_proper_pair {
+	my $self = shift;
+	my $bit_val = shift;
+	
+	$self->_set_bit_val(0x0002, $bit_val);
+	return;
+}
+
+####
+sub is_query_unmapped {
+	my $self = shift;
+	return($self->_get_bit_val(0x0004));
+}
+
+sub set_query_unmapped {
+	my $self = shift;
+	my $bit_val = shift;
+
+	$self->_set_bit_val(0x0004, $bit_val);
+}
+
+
+####
+sub is_mate_unmapped {
+	my $self = shift;
+	return($self->_get_bit_val(0x0008));
+}
+
+sub set_mate_unmapped {
+	my $self = shift;
+	my $bit_val = shift;
+	
+	return($self->_set_bit_val(0x0008, $bit_val));
+}
+
+####
+sub get_query_strand {
+	my $self = shift;
+	
+	my $strand = ($self->_get_bit_val(0x0010)) ? '-' : '+';
+	return($strand);
+}
+
+####
+sub get_query_transcribed_strand {
+	my $self = shift;
+
+	my $strand = $self->get_query_strand();
+	
+	if ($self->is_paired() && $self->is_first_in_pair()) {
+		
+		my $transcribed_strand = ($strand eq '+') ? '-' : '+';
+		
+		return($transcribed_strand);
+	}
+	else {
+		return($strand);
+	}
+}
+
+
+
+
+sub set_query_strand {
+	my $self = shift;
+	my $strand = shift;
+
+	unless ($strand eq '+' || $strand eq '-') {
+		confess "Error, strand value must be [+-]";
+	}
+
+	my $bit_val = ($strand eq '+') ? 0 : 1;
+	$self->_set_bit_val(0x0010, $bit_val);
+}
+
+####
+sub get_mate_strand {
+	my $self = shift;
+	
+	my $strand = ($self->_get_bit_val(0x0020)) ? '-' : '+';
+	return($strand);
+}
+
+sub set_mate_strand {
+	my $self = shift;
+	my $strand = shift;
+
+	unless ($strand eq '+' || $strand eq '-') {
+		confess "Error, strand value must be [+-]";
+	}
+
+	my $bit_val = ($strand eq '+') ? 0 : 1;
+	$self->_set_bit_val(0x0020, $bit_val);
+}
+
+####
+sub is_first_in_pair {
+	my $self = shift;
+	return($self->_get_bit_val(0x0040));
+}
+
+sub set_first_in_pair {
+	my $self = shift;
+	my $bit_val = shift;
+	
+	$self->_set_bit_val(0x0040, $bit_val);
+	return;
+}
+
+####
+sub is_second_in_pair {
+	my $self = shift;
+	return($self->_get_bit_val(0x0080));
+}
+
+
+sub set_second_in_pair {
+	my $self = shift;
+	my $bit_val = shift;
+
+	$self->_set_bit_val(0x0080, $bit_val);
+	return;
+}
+
+
+
+####
+sub _get_bit_val {
+	my $self = shift;
+	my ($bit_position) = @_;
+
+	my $flag = $self->get_flag();
+	return($flag & $bit_position);
+}
+
+
+####
+sub _set_bit_val {
+	my $self = shift;
+	my ($bit_position, $bit_val) = @_;
+
+	unless (defined $bit_position && defined $bit_val) {
+		confess "Error, need bit position and value";
+	}
+	
+	my $flag = $self->get_flag();
+
+	if ($bit_val) {
+		$flag |= $bit_position;
+	}
+	else {
+		# erase bit
+		$flag &= ~$bit_position;
+	}
+	
+	$self->set_flag($flag);
+}
+
+
+1; #EOM
+

99.scripts/trinity_utils/PerlLib/KmerGraphLib/SAM_reader.pm

@@ -0,0 +1,98 @@
+package SAM_reader;
+
+use strict;
+use warnings;
+use Carp;
+
+use SAM_entry;
+
+sub new {
+	my $packagename = shift;
+	my $filename = shift; 
+
+	unless ($filename) {
+		confess "Error, need SAM filename as parameter";
+	}
+	
+	my $self = { filename => $filename,
+				 _next => undef,
+				 _fh =>  undef,
+	};
+
+	bless ($self, $packagename);
+
+	$self->_init();
+
+	return($self);
+}
+
+
+####
+sub _init {
+	my ($self) = @_;
+
+	open ($self->{_fh}, $self->{filename}) or confess "Error, cannot open file " . $self->{filename};
+	
+	$self->_advance();
+
+	return;
+}
+
+####
+sub _advance {
+	my ($self) = @_;
+
+	my $fh = $self->{_fh};
+
+	my $next_line = <$fh>;
+	
+	if ($next_line) {
+		$self->{_next} = new SAM_entry($next_line);
+	}
+	else {
+		$self->{_next} = undef;
+	}
+	
+	return;
+}
+
+####
+sub has_next {
+	my $self = shift;
+	
+	if (defined $self->{_next}) {
+		return(1);
+	}
+	else {
+		return(0);
+	}
+}
+
+
+####
+sub get_next {
+	my $self = shift;
+	
+	my $next_entry = $self->{_next};
+
+	$self->_advance();
+	
+	if (defined $next_entry) {
+		return($next_entry);
+	}
+	else {
+		return(undef);
+	}
+}
+
+####
+sub preview_next {
+	my $self = shift;
+	return($self->{_next});
+}
+
+
+1;
+
+	
+	

99.scripts/trinity_utils/PerlLib/KmerGraphLib/SAM_to_AlignGraph.pm

@@ -0,0 +1,50 @@
+package SAM_to_AlignGraph;
+
+## Static class
+
+use strict;
+use warnings;
+
+use AlignGraph; 
+use Carp;
+
+use SAM_reader;
+use SAM_entry;
+
+sub construct_AlignGraph {
+	my ($sam_file) = @_;
+
+	my $graph = new AlignGraph();
+
+	my $sam_reader = new SAM_reader($sam_file);
+	
+	my $counter = 0;
+
+	while ($sam_reader->has_next()) {
+
+		$counter++;
+		print STDERR "\r[$counter]   " if $counter % 100 == 0;
+
+		my $sam_entry = $sam_reader->get_next();
+
+		my $scaff = $sam_entry->get_scaffold_name();
+		my $read_acc = $sam_entry->get_read_name();
+		
+		if ($sam_entry->is_query_unmapped()) { next; }
+		
+		
+		
+		my $query_strand = $sam_entry->get_query_transcribed_strand();
+
+		my ($genome_coords_aref, $query_coords_aref) = $sam_entry->get_alignment_coords();
+				
+		$graph->add_alignment($read_acc, $scaff, $query_strand, $genome_coords_aref);
+		
+	}
+
+	return($graph);
+}
+
+1; #EOM
+
+

99.scripts/trinity_utils/PerlLib/KmerGraphLib/StringNode.pm

@@ -0,0 +1,173 @@
+package StringNode;
+
+use strict;
+use warnings;
+use Carp;
+use ReadTracker;
+
+use base qw (GenericNode);
+
+sub new {
+	my $packagename = shift;
+	my ($kmer_seq, $accession) = @_;
+	
+	my $self = $packagename->SUPER::new($kmer_seq);
+	
+	$self->{_count} = 0;
+	$self->{_ReadTracker} = new ReadTracker();
+	
+	$self->{depth} = undef;
+	
+	## for DP scans:
+	$self->{_visited} = 0;
+	$self->{_base_score} = 0;
+	$self->{_sum_score} = 0;
+	$self->{_best_prev} = undef; # prev_node in highest scoring path.
+	$self->{_forward_scores} = []; # stores structs of { node => ref, score => $score}
+	
+	
+	bless ($self, $packagename);
+
+	return($self);
+}
+
+
+####
+sub get_ReadTracker {
+	my $self = shift;
+	return($self->{_ReadTracker});
+}
+
+
+sub get_sequence {
+	my $self = shift;
+
+	return($self->get_value());
+}
+
+sub set_sequence {
+	my $self = shift;
+	my $sequence = shift;
+	
+	unless ($sequence =~ /\w/) {
+		confess "Error, need sequence";
+	}
+
+	$self->set_value($sequence);
+
+	return;
+}
+
+sub track_reads {
+	my $self = shift;
+	my @accs = @_;
+
+	$self->{_ReadTracker}->track_reads(@accs);
+	
+	return;
+}
+
+sub get_count {
+	my $self = shift;
+
+	return($self->{_count});
+}
+
+sub set_count {
+	my $self = shift;
+
+	my ($count) = @_;
+
+	$self->{_count} = $count;
+	return;
+}
+
+
+
+####
+sub toString {
+        my $self = shift;
+        
+        my @prev_nodes = $self->get_all_prev_nodes();
+        
+        my @next_nodes = $self->get_all_next_nodes();
+        
+        my $text = "";
+        
+        foreach my $prev_node (@prev_nodes) {
+            $text .= "P " . $prev_node->get_value() . "(" . $prev_node->get_count() . ") $prev_node " . join(",", $prev_node->get_colors()) . "\n";
+        }
+        $text .= "X  " . $self->get_value() . "(" . $self->get_count() . ") $self " . join(",", $self->get_colors()) . "\n";
+        
+        foreach my $next_node (@next_nodes) {
+			$text .= "N   " . $next_node->get_value() . "(" . $self->get_count() . ") $next_node " . join(",", $next_node->get_colors()) . "\n";
+		}
+		
+		return($text);
+}
+
+
+####
+sub get_reads_exiting_node {
+	my $self = shift;
+
+	my @next_nodes = $self->get_all_next_nodes();
+	unless (@next_nodes) {
+		return();
+	}
+
+	my $read_tracker = $self->get_ReadTracker();
+
+	my @reads_in_node = $read_tracker->get_tracked_read_indices();
+
+	my @reads_in_next_nodes;
+	foreach my $next_node (@next_nodes) {
+		push (@reads_in_next_nodes, $next_node->get_ReadTracker()->get_tracked_read_indices());
+	}
+
+	my %next_node_reads = map { + $_ => 1 } @reads_in_next_nodes;
+
+	my @exiting_reads;
+	foreach my $read (@reads_in_node) {
+		if ($next_node_reads{$read}) {
+			push (@exiting_reads, $read);
+		}
+	}
+
+	return(@exiting_reads);
+}
+
+####
+sub get_reads_entering_node {
+	my $self = shift;
+	
+	my @prev_nodes = $self->get_all_prev_nodes();
+	unless (@prev_nodes) {
+		return();
+	}
+
+	my $read_tracker = $self->get_ReadTracker();
+
+	my @reads_in_node = $read_tracker->get_tracked_read_indices();
+
+	my @reads_in_prev_nodes;
+	foreach my $prev_node (@prev_nodes) {
+		push (@reads_in_prev_nodes, $prev_node->get_ReadTracker()->get_tracked_read_indices());
+	}
+
+	my %prev_node_reads = map { + $_ => 1 } @reads_in_prev_nodes;
+
+	my @entering_reads;
+	foreach my $read (@reads_in_node) {
+		if ($prev_node_reads{$read}) {
+			push (@entering_reads, $read);
+		}
+	}
+
+	return(@entering_reads);
+}
+
+
+
+1; #EOM
+