SWE/Object/Graph.pm

package SWE::Object::Graph;
use strict;
use warnings;

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

  return $self;
}

## ------ Database ------

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

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

sub lock () {
  my $self = shift;

  if ($self->{lock_n}++ == 0) {
    my $lock = $self->{lock} ||= do {
      require SWE::DB::Lock;
      my $lock = SWE::DB::Lock->new;
      $lock->{file_name} = $self->db->graph_dir_name . 'graph.lock';
      $lock->lock_type ('Graph');
      $lock;
    };

    $lock->lock;
  };
} # lock

sub unlock () {
  my $self = shift;
  
  if (--$self->{lock_n} <= 0 and $self->{lock}) {
    $self->{lock}->unlock;
  }
} # unlock

use constant EMPTY_NODE_RATIO => 0.2;
use constant INITIAL_DEGREE => 5;

sub add_nodes ($$) {
  my ($self, $new_doc_number) = @_;

  $self->lock;

  my $global_prop_db = $self->db->global_prop;
  
  my $last_node_index = ${$global_prop_db->get_data ('lastnodeindex') || \ 0};
  my $doc_on_node_number = ${$global_prop_db->get_data ('doconnodenumber') || \ 0};
  $doc_on_node_number += $new_doc_number;
  my $max_node_index = $doc_on_node_number / (1 - EMPTY_NODE_RATIO);
  $max_node_index = $last_node_index if $max_node_index < $last_node_index;
  $max_node_index = $last_node_index + $new_doc_number
      if $max_node_index < $last_node_index + $new_doc_number;
  $max_node_index = int $max_node_index;

  if ($last_node_index < $max_node_index) {
    my $new_edges = {};
    
    for my $index1 ($last_node_index + 1 .. $max_node_index) {
      for (1 .. INITIAL_DEGREE) {
        my $index2 = int rand $index1;
        
        $new_edges->{$index1}->{$index2} = 1;
        $new_edges->{$index2}->{$index1} = 1;
      }
    }
    
    my $graph_prop_db = $self->db->graph_prop;
    for my $index1 (keys %$new_edges) {
      my $node = $graph_prop_db->get_data ($index1);
      my $edges = $node->{neighbors} ||= {};
      for my $index2 (keys %{$new_edges->{$index1}}) {
        $edges->{$index2} = 1;
      }
      $graph_prop_db->set_data ($index1 => $node);
    }

    $global_prop_db->set_data (lastnodeindex => \$max_node_index);
  }
  $global_prop_db->set_data (doconnodenumber => \$doc_on_node_number);

  $self->unlock;

  return ($last_node_index + 1 .. $max_node_index);
} # add_nodes

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

  ## In fact we don't need to lock the entire graph (though the
  ## |add_nodes| method might require it anyway), but we don't have
  ## way to lock a particular node only at the moment.
  $self->lock;

  my ($node_id) = $self->add_nodes (1);

  require SWE::Object::Node;
  my $node = SWE::Object::Node->new (db => $self->db, repo => $self->repo);
  $node->create (id => $node_id);
  $node->prop->{ids}->{$doc_id} = 1;
  $node->save_prop;

  $self->unlock;

  return $node;
} # create_node

sub get_node_by_id ($$) {
  my ($self, $node_id) = @_;
  
  ## TODO: cache
  
  require SWE::Object::Node;
  my $node = SWE::Object::Node->new (db => $self->db, repo => $self->repo);
  $node->load (id => $node_id);

  return $node;
} # get_node_by_id

use constant RELATEDNESS_THRESHOLD => 0.9;

sub schelling_update ($$) {
  my ($self, $node_id) = @_;

  $self->lock;

  my $node = $self->get_node_by_id ($node_id);
  my $doc_id = $node->document_id // return;

  my $repo = $self->repo;

  my $related = 0;
  my $n = 0;
  
  my $neighbor_ids = $node->neighbor_ids;
  my $unused_nodes = [];
  for my $n_node_id (keys %$neighbor_ids) {
    $n++;
    my $n_node = $self->get_node_by_id ($n_node_id);
    my $n_doc_id = $n_node->document_id;
    unless (defined $n_doc_id) {
      push @$unused_nodes, $n_node;
      next;
    }
    $related++ if $repo->are_related_ids ($node_id, $n_doc_id);
  }

  my $v = 0;
  if ($n) {
    $v = $related / $n;
  }

  if ($v < RELATEDNESS_THRESHOLD and @$unused_nodes) {
    my $unused_node = $unused_nodes->[rand @$unused_nodes];

    my $doc = $repo->get_document_by_id ($doc_id);
    $doc->lock;
    my $id_prop = $doc->untainted_prop;
    
    $id_prop->{node_id} = $unused_node->id;
    $unused_node->prop->{ids}->{$doc_id} = 1;
    delete $node->prop->{ids}->{$doc_id};

    $unused_node->save_prop;
    $doc->save_prop;
    $node->save_prop;

    $doc->unlock;
  }

  $self->unlock;
} # schelling_update

1;
1	wakaba	1.1	package SWE::Object::Graph;
2			use strict;
3			use warnings;
4
5			sub new ($%) {
6			my $class = shift;
7			my $self = bless {@_}, $class;
8
9			return $self;
10			}
11
12	wakaba	1.6	## ------ Database ------
13
14			sub db ($) { $_[0]->{db} }
15
16			sub repo ($) { $_[0]->{repo} }
17
18			sub lock () {
19			my $self = shift;
20
21			if ($self->{lock_n}++ == 0) {
22			my $lock = $self->{lock} \|\|= do {
23			require SWE::DB::Lock;
24			my $lock = SWE::DB::Lock->new;
25			$lock->{file_name} = $self->db->graph_dir_name . 'graph.lock';
26			$lock->lock_type ('Graph');
27			$lock;
28			};
29
30			$lock->lock;
31			};
32			} # lock
33
34			sub unlock () {
35			my $self = shift;
36
37			if (--$self->{lock_n} <= 0 and $self->{lock}) {
38			$self->{lock}->unlock;
39			}
40			} # unlock
41	wakaba	1.1
42			use constant EMPTY_NODE_RATIO => 0.2;
43			use constant INITIAL_DEGREE => 5;
44
45			sub add_nodes ($$) {
46			my ($self, $new_doc_number) = @_;
47	wakaba	1.6
48			$self->lock;
49	wakaba	1.1
50			my $global_prop_db = $self->db->global_prop;
51
52			my $last_node_index = ${$global_prop_db->get_data ('lastnodeindex') \|\| \ 0};
53	wakaba	1.4	my $doc_on_node_number = ${$global_prop_db->get_data ('doconnodenumber') \|\| \ 0};
54			$doc_on_node_number += $new_doc_number;
55			my $max_node_index = $doc_on_node_number / (1 - EMPTY_NODE_RATIO);
56			$max_node_index = $last_node_index if $max_node_index < $last_node_index;
57			$max_node_index = $last_node_index + $new_doc_number
58			if $max_node_index < $last_node_index + $new_doc_number;
59			$max_node_index = int $max_node_index;
60
61	wakaba	1.1	if ($last_node_index < $max_node_index) {
62			my $new_edges = {};
63
64			for my $index1 ($last_node_index + 1 .. $max_node_index) {
65			for (1 .. INITIAL_DEGREE) {
66			my $index2 = int rand $index1;
67
68			$new_edges->{$index1}->{$index2} = 1;
69			$new_edges->{$index2}->{$index1} = 1;
70			}
71			}
72
73			my $graph_prop_db = $self->db->graph_prop;
74			for my $index1 (keys %$new_edges) {
75			my $node = $graph_prop_db->get_data ($index1);
76			my $edges = $node->{neighbors} \|\|= {};
77			for my $index2 (keys %{$new_edges->{$index1}}) {
78			$edges->{$index2} = 1;
79			}
80			$graph_prop_db->set_data ($index1 => $node);
81			}
82
83			$global_prop_db->set_data (lastnodeindex => \$max_node_index);
84			}
85	wakaba	1.4	$global_prop_db->set_data (doconnodenumber => \$doc_on_node_number);
86	wakaba	1.1
87	wakaba	1.6	$self->unlock;
88
89	wakaba	1.1	return ($last_node_index + 1 .. $max_node_index);
90			} # add_nodes
91
92			sub create_node ($$) {
93			my ($self, $doc_id) = @_;
94
95	wakaba	1.6	## In fact we don't need to lock the entire graph (though the
96			## \|add_nodes\| method might require it anyway), but we don't have
97			## way to lock a particular node only at the moment.
98			$self->lock;
99
100	wakaba	1.1	my ($node_id) = $self->add_nodes (1);
101	wakaba	1.2
102			require SWE::Object::Node;
103	wakaba	1.6	my $node = SWE::Object::Node->new (db => $self->db, repo => $self->repo);
104	wakaba	1.2	$node->create (id => $node_id);
105			$node->prop->{ids}->{$doc_id} = 1;
106			$node->save_prop;
107
108	wakaba	1.6	$self->unlock;
109
110	wakaba	1.2	return $node;
111			} # create_node
112
113			sub get_node_by_id ($$) {
114			my ($self, $node_id) = @_;
115
116			## TODO: cache
117	wakaba	1.1
118	wakaba	1.2	require SWE::Object::Node;
119	wakaba	1.6	my $node = SWE::Object::Node->new (db => $self->db, repo => $self->repo);
120	wakaba	1.2	$node->load (id => $node_id);
121	wakaba	1.1
122	wakaba	1.2	return $node;
123			} # get_node_by_id
124	wakaba	1.5
125			use constant RELATEDNESS_THRESHOLD => 0.9;
126
127			sub schelling_update ($$) {
128			my ($self, $node_id) = @_;
129
130	wakaba	1.6	$self->lock;
131
132	wakaba	1.5	my $node = $self->get_node_by_id ($node_id);
133			my $doc_id = $node->document_id // return;
134
135	wakaba	1.8	my $repo = $self->repo;
136	wakaba	1.5
137			my $related = 0;
138			my $n = 0;
139
140			my $neighbor_ids = $node->neighbor_ids;
141			my $unused_nodes = [];
142			for my $n_node_id (keys %$neighbor_ids) {
143			$n++;
144			my $n_node = $self->get_node_by_id ($n_node_id);
145			my $n_doc_id = $n_node->document_id;
146			unless (defined $n_doc_id) {
147			push @$unused_nodes, $n_node;
148			next;
149			}
150			$related++ if $repo->are_related_ids ($node_id, $n_doc_id);
151			}
152
153			my $v = 0;
154			if ($n) {
155			$v = $related / $n;
156			}
157
158			if ($v < RELATEDNESS_THRESHOLD and @$unused_nodes) {
159			my $unused_node = $unused_nodes->[rand @$unused_nodes];
160
161	wakaba	1.8	my $doc = $repo->get_document_by_id ($doc_id);
162			$doc->lock;
163			my $id_prop = $doc->untainted_prop;
164	wakaba	1.5
165			$id_prop->{node_id} = $unused_node->id;
166			$unused_node->prop->{ids}->{$doc_id} = 1;
167			delete $node->prop->{ids}->{$doc_id};
168
169			$unused_node->save_prop;
170	wakaba	1.8	$doc->save_prop;
171	wakaba	1.5	$node->save_prop;
172	wakaba	1.8
173			$doc->unlock;
174	wakaba	1.5	}
175	wakaba	1.6
176			$self->unlock;
177	wakaba	1.5	} # schelling_update
178	wakaba	1.1
179			1;