[Bio] / FigKernelPackages / Clustering.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Clustering.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Sun Feb 14 20:16:08 2010 UTC revision 1.2, Thu Feb 18 16:57:11 2010 UTC
# Line 19  Line 19 
19    
20  use Carp;  use Carp;
21  use Data::Dumper;  use Data::Dumper;
22    use tree_utilities;
23    
24  # $connections->{$object1} ->{$object2} is the distance between $object1 and $object2, if it is defined (undef  # $connections->{$object1} ->{$object2} is the distance between $object1 and $object2, if it is defined (undef
25  # is equivalent to infinity)  # is equivalent to infinity)
26  #  #
27  sub cluster {  sub cluster {
28      my($connections,$max_dist,$dist_func_ref) = @_;      my($connections,$max_dist,$dist_func_ref,$things) = @_;
29    
30      my @clusters = map { [$_] } keys(%$connections);      if (! ref($dist_func_ref))
31        {
32            if    ($dist_func_ref eq "avg_dist")            { $dist_func_ref = \&avg_dist }
33            elsif ($dist_func_ref eq "max_dist")            { $dist_func_ref = \&max_dist }
34            elsif ($dist_func_ref eq "single_linkage_dist") { $dist_func_ref = \&single_linkage_dist }
35            else { confess "Could not resolve the distance function" }
36        }
37        my @clusters = defined($things) ? @$things :
38                                          map { [$_] } keys(%$connections);
39        my @trees    = map { [$_->[0],0,[undef]] } @clusters;
40    
41      my ($cI,$cJ) = &closest($connections,\@clusters,$max_dist,$dist_func_ref);      my ($cI,$cJ,$d) = &closest($connections,\@clusters,$max_dist,$dist_func_ref);
42      while (defined($cI))      while (defined($cI))
43      {      {
44            my $treeI   = $trees[$cI];
45            my $treeJ   = $trees[$cJ];
46            my $parent  = ['',0,[0,$treeI,$treeJ]];
47            $treeI->[2]->[0] = $treeJ->[2]->[0] = $parent;
48            $treeI->[1] = $treeJ->[1] = $d/2;
49            $trees[$cI] = $parent;
50            splice(@trees,$cJ,1);
51    
52          push(@{$clusters[$cI]},@{$clusters[$cJ]});          push(@{$clusters[$cI]},@{$clusters[$cJ]});
53          splice(@clusters,$cJ,1);          splice(@clusters,$cJ,1);
54          ($cI,$cJ) = &closest($connections,\@clusters,$max_dist,$dist_func_ref);          ($cI,$cJ,$d) = &closest($connections,\@clusters,$max_dist,$dist_func_ref);
55      }      }
56      return \@clusters;      return (\@clusters,\@trees);
57  }  }
58    
59  sub closest {  sub closest {
# Line 59  Line 76 
76              }              }
77          }          }
78      }      }
79      return ($bestI,$bestJ);      return ($bestI,$bestJ,$best);
80  }  }
81    
82  sub single_linkage_dist {  sub single_linkage_dist {

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3