new positioning system, works great for graph, needs work for CSV
[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / Reading.pm
CommitLineData
784877d9 1package Text::Tradition::Collation::Reading;
2
8e1394aa 3use Moose;
d047cd52 4use Moose::Util::TypeConstraints;
784877d9 5use MooseX::NonMoose;
3265b0ce 6use Text::Tradition::Collation::Relationship;
784877d9 7
8extends 'Graph::Easy::Node';
9
10subtype 'Position'
11 => as 'Str',
12 => where { $_ =~ /^\d+\,\d+$/ },
13 message { 'Position must be of the form x,y' };
14
15has 'position' => (
d047cd52 16 is => 'rw',
17 isa => 'Position',
4a8828f0 18 predicate => 'has_position',
d047cd52 19 );
784877d9 20
21# This contains an array of reading objects; the array is a pool,
22# shared by the reading objects inside the pool. When a reading is
23# added to the pool, all the same_as attributes should be updated.
24has 'same_as' => (
d047cd52 25 is => 'rw',
26 isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
27 );
784877d9 28
8e1394aa 29# Deal with the non-arg option for Graph::Easy's constructor.
30around BUILDARGS => sub {
31 my $orig = shift;
32 my $class = shift;
33
34 my %args;
35 if( @_ == 1 && ref( $_[0] ) ne 'HASH' ) {
36 return $class->$orig( 'name' => $_[0] );
37 } else {
38 return $class->$orig( @_ );
39 }
40};
41
d047cd52 42# Initialize the identity pool.
43sub BUILD {
44 my( $self, $args ) = @_;
8e1394aa 45 $self->same_as( [ $self ] );
d047cd52 46}
784877d9 47
e2902068 48sub text {
49 # Wrapper function around 'label' attribute.
50 my $self = shift;
51 if( @_ ) {
52 $self->set_attribute( 'label', $_[0] );
53 }
54 return $self->get_attribute( 'label' );
55}
56
784877d9 57sub merge_from {
58 my( $self, $merged_node ) = @_;
59 # Adopt the identity pool of the other node.
60 my @now_identical = grep { $_ ne $merged_node } @{$merged_node->same_as};
61 my $new_pool = _merge_array_pool( \@now_identical, $self->same_as )
62 if @now_identical;
63
3265b0ce 64 # TODO Adopt the relationship attributes of the other node.
784877d9 65}
66
3265b0ce 67## Dealing with transposed readings. These methods are only really
68## applicable if we have a linear collation graph.
69
784877d9 70sub set_identical {
71 my( $self, $other_node ) = @_;
72 my $enlarged_pool = _merge_array_pool( $self->same_as,
73 $other_node->same_as );
74
75 # ...and set this node to point to the enlarged pool.
8e1394aa 76 $self->same_as( $enlarged_pool );
784877d9 77}
78
de51424a 79sub identical_readings {
80 my $self = shift;
81 my @same = grep { $_ ne $self } @{$self->same_as};
82 return @same;
83}
84
784877d9 85sub _merge_array_pool {
86 my( $pool, $main_pool ) = @_;
87 my %poolhash;
88 foreach ( @$main_pool ) {
89 # Note which nodes are already in the main pool so that we
90 # don't re-add them.
91 $poolhash{$_->name} = 1;
92 }
93
94 foreach( @$pool ) {
95 # Add the remaining nodes to the main pool...
96 push( @$main_pool, $_ ) unless $poolhash{$_->name};
97 }
98 return $main_pool;
99}
d047cd52 100
8e1394aa 101sub has_primary {
102 my $self = shift;
103 my $pool = $self->same_as;
df6d9812 104 return $pool->[0]->name ne $self->name;
8e1394aa 105}
106
107sub primary {
108 my $self = shift;
109 return $self->same_as->[0];
110}
111
3265b0ce 112## Keep track of which readings are unchanged across witnesses.
d047cd52 113
4a8828f0 114sub is_common {
115 my( $self ) = shift;
116 return $self->get_attribute( 'class' ) eq 'common';
117}
118
119sub make_common {
120 my( $self ) = shift;
121 $self->set_attribute( 'class', 'common' );
122}
123
124sub make_variant {
125 my( $self ) = shift;
126 $self->set_attribute( 'class', 'variant' );
127}
128
d047cd52 129no Moose;
130__PACKAGE__->meta->make_immutable;
131
1321;
133
134######################################################
135## copied from Graph::Easy::Parser docs
136######################################################
137# when overriding nodes, we also need ::Anon
138
139package Text::Tradition::Collation::Reading::Anon;
021bdbac 140use Moose;
141use MooseX::NonMoose;
142extends 'Text::Tradition::Collation::Reading';
143extends 'Graph::Easy::Node::Anon';
144no Moose;
145__PACKAGE__->meta->make_immutable;
d047cd52 146
021bdbac 1471;
148# use base qw/Text::Tradition::Collation::Reading/;
149# use base qw/Graph::Easy::Node::Anon/;
d047cd52 150
151######################################################
152# and :::Empty
153
154package Text::Tradition::Collation::Reading::Empty;
021bdbac 155use Moose;
156use MooseX::NonMoose;
157extends 'Graph::Easy::Node::Empty';
158no Moose;
159__PACKAGE__->meta->make_immutable;
d047cd52 160
021bdbac 1611;
162# use base qw/Text::Tradition::Collation::Reading/;
d047cd52 163
164######################################################