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;
        my $index2 = $index1 - rand 50; # XXX
        
        $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	wakaba	1.9	#my $index2 = int rand $index1;
67			my $index2 = $index1 - rand 50; # XXX
68	wakaba	1.1
69			$new_edges->{$index1}->{$index2} = 1;
70			$new_edges->{$index2}->{$index1} = 1;
71			}
72			}
73
74			my $graph_prop_db = $self->db->graph_prop;
75			for my $index1 (keys %$new_edges) {
76			my $node = $graph_prop_db->get_data ($index1);
77			my $edges = $node->{neighbors} \|\|= {};
78			for my $index2 (keys %{$new_edges->{$index1}}) {
79			$edges->{$index2} = 1;
80			}
81			$graph_prop_db->set_data ($index1 => $node);
82			}
83
84			$global_prop_db->set_data (lastnodeindex => \$max_node_index);
85			}
86	wakaba	1.4	$global_prop_db->set_data (doconnodenumber => \$doc_on_node_number);
87	wakaba	1.1
88	wakaba	1.6	$self->unlock;
89
90	wakaba	1.1	return ($last_node_index + 1 .. $max_node_index);
91			} # add_nodes
92
93			sub create_node ($$) {
94			my ($self, $doc_id) = @_;
95
96	wakaba	1.6	## In fact we don't need to lock the entire graph (though the
97			## \|add_nodes\| method might require it anyway), but we don't have
98			## way to lock a particular node only at the moment.
99			$self->lock;
100
101	wakaba	1.1	my ($node_id) = $self->add_nodes (1);
102	wakaba	1.2
103			require SWE::Object::Node;
104	wakaba	1.6	my $node = SWE::Object::Node->new (db => $self->db, repo => $self->repo);
105	wakaba	1.2	$node->create (id => $node_id);
106			$node->prop->{ids}->{$doc_id} = 1;
107			$node->save_prop;
108
109	wakaba	1.6	$self->unlock;
110
111	wakaba	1.2	return $node;
112			} # create_node
113
114			sub get_node_by_id ($$) {
115			my ($self, $node_id) = @_;
116
117			## TODO: cache
118	wakaba	1.1
119	wakaba	1.2	require SWE::Object::Node;
120	wakaba	1.6	my $node = SWE::Object::Node->new (db => $self->db, repo => $self->repo);
121	wakaba	1.2	$node->load (id => $node_id);
122	wakaba	1.1
123	wakaba	1.2	return $node;
124			} # get_node_by_id
125	wakaba	1.5
126			use constant RELATEDNESS_THRESHOLD => 0.9;
127
128			sub schelling_update ($$) {
129			my ($self, $node_id) = @_;
130
131	wakaba	1.6	$self->lock;
132
133	wakaba	1.5	my $node = $self->get_node_by_id ($node_id);
134			my $doc_id = $node->document_id // return;
135
136	wakaba	1.8	my $repo = $self->repo;
137	wakaba	1.5
138			my $related = 0;
139			my $n = 0;
140
141			my $neighbor_ids = $node->neighbor_ids;
142			my $unused_nodes = [];
143			for my $n_node_id (keys %$neighbor_ids) {
144			$n++;
145			my $n_node = $self->get_node_by_id ($n_node_id);
146			my $n_doc_id = $n_node->document_id;
147			unless (defined $n_doc_id) {
148			push @$unused_nodes, $n_node;
149			next;
150			}
151			$related++ if $repo->are_related_ids ($node_id, $n_doc_id);
152			}
153
154			my $v = 0;
155			if ($n) {
156			$v = $related / $n;
157			}
158
159			if ($v < RELATEDNESS_THRESHOLD and @$unused_nodes) {
160			my $unused_node = $unused_nodes->[rand @$unused_nodes];
161
162	wakaba	1.8	my $doc = $repo->get_document_by_id ($doc_id);
163			$doc->lock;
164			my $id_prop = $doc->untainted_prop;
165	wakaba	1.5
166			$id_prop->{node_id} = $unused_node->id;
167			$unused_node->prop->{ids}->{$doc_id} = 1;
168			delete $node->prop->{ids}->{$doc_id};
169
170			$unused_node->save_prop;
171	wakaba	1.8	$doc->save_prop;
172	wakaba	1.5	$node->save_prop;
173	wakaba	1.8
174			$doc->unlock;
175	wakaba	1.5	}
176	wakaba	1.6
177			$self->unlock;
178	wakaba	1.5	} # schelling_update
179	wakaba	1.1
180			1;