SWE/Object/Repository.pm

package SWE::Object::Repository;
use strict;
use warnings;
use Scalar::Util qw/weaken/;

sub new ($%) {
  my $class = shift;
  my $self = bless {@_}, $class;

  return $self;
}

sub db ($) { $_[0]->{db} }

sub graph ($) {
  my $self = shift;
  return $self->{graph} ||= do {
    require SWE::Object::Graph;
    my $g = SWE::Object::Graph->new (repo => $self, db => $self->db);
    weaken $g->{repo};
    $g;
  };
} # graph

sub get_document_by_id ($$) {
  my ($self, $doc_id) = @_;

  return $self->{document}->{$doc_id} ||= do {
    require SWE::Object::Document;
    my $doc = SWE::Object::Document->new
        (repo => $self, db => $self->db, id => $doc_id);
    weaken $doc->{repo};
    $doc;
  };
} # get_document_by_id

# XXX
my $weight_file_name = 'data/weight.txt';

sub term_weight_vector ($) {
  my $self = shift;

  ## TODO: lock

  ## TODO: use global props

  return $self->{term_weight_vector} ||= do {
    require SWE::Data::FeatureVector;

    my $w;
    if (-f $weight_file_name) {
      local $/ = undef;
      open my $file, '<:encoding(utf8)', $weight_file_name or die "$0: $weight_file_name: $!";
      $w = SWE::Data::FeatureVector->parse_stringref (\<$file>);
      close $file;
    } else {
      $w = SWE::Data::FeatureVector->new;
    }
    delete $self->{term_weight_vector_modified};
    $w;
  };
} # term_weight_vector

sub save_term_weight_vector ($) {
  my $self = shift;
  return unless $self->{term_weight_vector_modified};
  
  ## TODO: use global props
  
  open my $file, '>:encoding(utf8)', $weight_file_name or die "$0: $weight_file_name: $!";
  print $file $self->{term_weight_vector}->stringify;
  close $file;
} # save_term_weight_vector

sub are_related_ids ($$$;$) {
  my ($self, $id1, $id2, $answer) = @_;
  
  my $w = $self->term_weight_vector;
  
  my $tfidf_db = $self->db->id_tfidf;

  ## TODO: cache
  
  require SWE::Data::FeatureVector;
  my $fv1 = SWE::Data::FeatureVector->parse_stringref
      ($tfidf_db->get_data ($id1) // return undef);
  my $fv2 = SWE::Data::FeatureVector->parse_stringref
      ($tfidf_db->get_data ($id2) // return undef);
  
  my $diff = $fv1->subtract ($fv2);

  my $i = 0;
  A: {
    my $wx = $diff->multiply ($w)->component_sum;
    my $y = $wx >= 0 ? 1 : -1;
    
    if (defined $answer and $y * $answer < 0) {
      $w = $y > 0 ? $w->subtract ($diff) : $w->add ($diff);
      $self->{term_weight_vector} = $w;
      $self->{term_weight_vector_modified} = 1;
      $i++;
      redo A unless $i > 20;
    }
    
    return $y > 0;
  }
} # are_related_ids

1;
1	wakaba	1.1	package SWE::Object::Repository;
2			use strict;
3			use warnings;
4	wakaba	1.4	use Scalar::Util qw/weaken/;
5	wakaba	1.1
6			sub new ($%) {
7			my $class = shift;
8			my $self = bless {@_}, $class;
9
10			return $self;
11			}
12
13			sub db ($) { $_[0]->{db} }
14
15	wakaba	1.4	sub graph ($) {
16			my $self = shift;
17			return $self->{graph} \|\|= do {
18			require SWE::Object::Graph;
19			my $g = SWE::Object::Graph->new (repo => $self, db => $self->db);
20			weaken $g->{repo};
21			$g;
22			};
23			} # graph
24
25			sub get_document_by_id ($$) {
26			my ($self, $doc_id) = @_;
27
28			return $self->{document}->{$doc_id} \|\|= do {
29			require SWE::Object::Document;
30			my $doc = SWE::Object::Document->new
31			(repo => $self, db => $self->db, id => $doc_id);
32			weaken $doc->{repo};
33			$doc;
34			};
35			} # get_document_by_id
36
37			# XXX
38	wakaba	1.1	my $weight_file_name = 'data/weight.txt';
39
40			sub term_weight_vector ($) {
41			my $self = shift;
42
43			## TODO: lock
44
45			## TODO: use global props
46
47			return $self->{term_weight_vector} \|\|= do {
48			require SWE::Data::FeatureVector;
49
50			my $w;
51			if (-f $weight_file_name) {
52			local $/ = undef;
53			open my $file, '<:encoding(utf8)', $weight_file_name or die "$0: $weight_file_name: $!";
54			$w = SWE::Data::FeatureVector->parse_stringref (\<$file>);
55			close $file;
56			} else {
57			$w = SWE::Data::FeatureVector->new;
58			}
59			delete $self->{term_weight_vector_modified};
60			$w;
61			};
62			} # term_weight_vector
63
64			sub save_term_weight_vector ($) {
65			my $self = shift;
66			return unless $self->{term_weight_vector_modified};
67
68			## TODO: use global props
69
70			open my $file, '>:encoding(utf8)', $weight_file_name or die "$0: $weight_file_name: $!";
71			print $file $self->{term_weight_vector}->stringify;
72			close $file;
73			} # save_term_weight_vector
74
75			sub are_related_ids ($$$;$) {
76			my ($self, $id1, $id2, $answer) = @_;
77
78			my $w = $self->term_weight_vector;
79
80			my $tfidf_db = $self->db->id_tfidf;
81	wakaba	1.2
82			## TODO: cache
83	wakaba	1.1
84			require SWE::Data::FeatureVector;
85			my $fv1 = SWE::Data::FeatureVector->parse_stringref
86	wakaba	1.3	($tfidf_db->get_data ($id1) // return undef);
87	wakaba	1.1	my $fv2 = SWE::Data::FeatureVector->parse_stringref
88	wakaba	1.3	($tfidf_db->get_data ($id2) // return undef);
89	wakaba	1.1
90			my $diff = $fv1->subtract ($fv2);
91	wakaba	1.2
92			my $i = 0;
93			A: {
94			my $wx = $diff->multiply ($w)->component_sum;
95			my $y = $wx >= 0 ? 1 : -1;
96
97			if (defined $answer and $y * $answer < 0) {
98			$w = $y > 0 ? $w->subtract ($diff) : $w->add ($diff);
99			$self->{term_weight_vector} = $w;
100			$self->{term_weight_vector_modified} = 1;
101			$i++;
102			redo A unless $i > 20;
103			}
104
105			return $y > 0;
106	wakaba	1.1	}
107			} # are_related_ids
108
109			1;