20251125

2025-11-25 00:28:51 +08:00
commit eb3f16c30e
406 changed files with 91653 additions and 0 deletions
@@ -0,0 +1,156 @@
+package Ktree;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+    my $packagename = shift;
+    
+    my $self = { _root => KtreeNode->new("", 0) };
+
+    bless ($self, $packagename);
+
+    return($self);
+}
+
+sub add_kmer {
+    my $self = shift;
+    my ($kmer) = @_;
+
+
+    unless (defined $kmer) {
+        confess "error, require param kmer";
+    }
+
+    my $root_node = $self->{_root};
+
+    my @seq = split(//, $kmer);
+
+    my $node = $root_node; 
+    do {
+        my $char = shift @seq;
+        $node = $node->get_child($char);
+    } while (@seq);
+    
+    $node->set_val( $node->get_val() + 1 );
+    
+    return;
+}
+
+sub report_kmer_counts {
+    my $self = shift;
+    
+    my $root_node = $self->{_root};
+    
+    &_recurse_through_kmer_counts("", $root_node);
+    
+    return;
+}
+
+sub _recurse_through_kmer_counts {
+    my ($prefix, $node) = @_;
+
+    my $char = $node->get_char();
+    
+    my @children_chars = $node->get_children_chars();
+    
+    if (@children_chars) {
+        foreach my $child_char (@children_chars) {
+            my $child_node = $node->get_child($child_char);
+            &_recurse_through_kmer_counts($prefix . $char, $child_node);
+        }
+    }
+    else {
+        # base case
+        my $val = $node->get_val();
+        print join("\t", $prefix . $char, $val) . "\n";
+    }
+
+    return;
+}
+
+
+
+package KtreeNode;
+
+use strict;
+use warnings;
+use Carp;
+
+
+sub new {
+    my $packagename = shift;
+    my ($char, $val) = @_;
+
+    unless (defined $char && defined $val) {
+        confess "Error, require (character, val) as parameter";
+    }
+
+    my $self = { char => $char,
+                 val => $val,
+                 children => {},
+    };
+    
+    bless ($self, $packagename);
+    
+    return($self);
+}
+
+
+
+
+####
+sub get_child {
+    my $self = shift;
+    my ($char) = @_;
+
+    unless (defined $char) {
+        confess "error, parameter 'char' required";
+    }
+
+    my $child = $self->{children}->{$char};
+    unless (ref $child) {
+        
+        $child = $self->{children}->{$char} = new KtreeNode($char, 0);
+    }
+
+    return($child);
+}
+
+
+sub get_children_chars {
+    my $self = shift;
+    
+    my @chars = keys %{$self->{children}};
+    return(@chars);
+}
+
+
+sub get_char {
+    my $self = shift;
+    return($self->{char});
+}
+
+
+####
+sub get_val {
+    my $self = shift;
+    return($self->{val});
+}
+
+####
+sub set_val {
+    my $self = shift;
+    my $val = shift;
+    unless (defined $val) {
+        confess "error, require val as param";
+    }
+
+    $self->{val} = $val;
+    
+    return;
+}
+
+
+1; #EOM