1 package Text::Tradition::Analysis::Result;
4 use JSON qw/ to_json /;
6 use Text::Tradition::Error;
10 Text::Tradition::Analysis::Result - object to express an IDP calculation result
11 for a particular graph problem.
15 Given a graph (expressing a stemma hypothesis) and a set of witness groupings
16 (expressing variation in reading between witnesses related according to the
17 stemma hypothesis), it is possible to calculate certain properties of how the
18 readings might be related to each other. This calculation depends on a custom
19 program run under the IDP system [TODO URL]. As the problem is NP-hard, the
20 calculation can take a long time. The purpose of this object is to allow storage
21 of calculated results in a database.
23 For each graph problem, the following features can be calculated:
27 =item * Whether the reading groups form a genealogical pattern on the stemma.
29 =item * The groupings, including lost/hypothetical witnesses if necessary, that minimize the amount of non-genealogical variation on the stemma.
31 =item * The classes, which for each witness express whether (in a minimally non-genealogical case) the witness is a source of its reading, follows a parent witness, or reverts to an ancestral reading that is not the parent's.
39 Creates a new graph problem. Requires two properties:
43 =item * setlist - An array of arrays expressing the witness sets. The inner
44 arrays will be converted to Set::Scalar objects, and must have distinct members.
46 =item * graph - A dot description of a graph (e.g. the output of a call to
47 Text::Tradition::Stemma::editable) against which the sets will be analyzed.
55 isa => 'ArrayRef[Set::Scalar]',
58 set_index => 'first_index',
69 has 'is_genealogical' => (
72 predicate => 'has_genealogical_result'
75 has 'groupinglist' => (
77 isa => 'ArrayRef[Set::Scalar]',
79 groupings => 'elements',
80 _add_grouping => 'push',
81 _set_grouping => 'set',
89 isa => 'HashRef[Str]',
92 has_class => 'exists',
94 classes => 'elements',
95 assigned_wits => 'keys',
99 around BUILDARGS => sub {
102 my $args = @_ == 1 ? $_[0] : { @_ };
104 # Convert the set list into a list of Set::Scalars, ordered first by size and
105 # then alphabetically by first-sorted.
106 die "Must specify a set list to Analysis::Result->new()"
107 unless ref( $args->{'setlist'} ) eq 'ARRAY';
109 foreach my $set ( @{$args->{'setlist'}} ) {
111 # Check uniqueness of the current set
112 if( ref( $set ) ne 'Set::Scalar' ) {
113 $s = Set::Scalar->new( @$set );
114 die "Duplicate element(s) in set passed to Analysis::Result->new()"
115 unless @$set == $s->elements;
117 # Check distinctness of the set from all other sets given so far
118 foreach my $ps ( @sets ) {
119 die "Two sets are not disjoint"
120 unless $s->is_disjoint( $ps );
126 $args->{'setlist'} = [ sort { by_size_and_alpha( $a, $b ) } @sets ];
128 # If we have been passed a Text::Tradition::Stemma, save only its graph.
129 if( ref( $args->{'graph'} ) eq 'Text::Tradition::Stemma' ) {
130 my $st = delete $args->{'graph'};
131 $args->{'graph'} = $st->editable;
134 return $class->$orig( $args );
140 # Initialize the groupings array
141 map { $self->_add_grouping( $_ ) } $self->sets;
144 sub record_grouping {
145 my( $self, $group ) = @_;
146 unless( ref( $group ) eq 'Set::Scalar' ) {
147 my $s = Set::Scalar->new( @$group );
150 # Find the set that is a subset of this group, and record it in the
151 # correct spot in our groupinglist.
153 foreach my $set ( $self->sets ) {
154 if( $set->is_subset( $group ) ) {
155 $self->_set_grouping( $idx, $group );
160 if( $idx == scalar( $self->sets ) ) {
161 throw( "Failed to find witness set that is a subset of $group" );
165 # A request string is the graph followed by the groups, which should form a unique
166 # key for the result.
169 return string_from_graph_problem( $self->graph, [ $self->sets ] );
172 sub string_from_graph_problem {
173 my( $graph, $grouping ) = @_;
174 my( $graphstr, @groupsets );
175 # Get the graph string
176 if( ref( $graph ) && ref( $graph ) eq 'Graph' ) {
177 $graphstr = Text::Tradition::Stemma::editable_graph( $graph, { 'linesep' => ' ' } );
179 throw( "Passed non-graph object $graph to stringification" )
183 # Make sure all groupings are sets
184 foreach my $g ( @$grouping ) {
185 if( ref( $g ) eq 'ARRAY' ) {
186 push( @groupsets, Set::Scalar->new( @$g ) );
187 } elsif( ref( $g ) eq 'Set::Scalar' ) {
188 push( @groupsets, $g );
190 throw( "Tried to stringify grouping $g that is neither set nor array" );
193 return $graphstr . '//' .
194 join( ',', sort { by_size_and_alpha( $a, $b ) } @groupsets );
199 my $phash = { graph => $self->graph };
201 map { push( @groupings, [ $_->members ] ) } $self->sets;
202 $phash->{groupings} = \@groupings;
203 return to_json( $phash );
206 sub by_size_and_alpha {
208 my $size = $b->members <=> $a->members;
209 return $size if $size;
210 # Then sort by alphabetical order of set elements.
211 return "$a" cmp "$b";
216 my @sources = grep { $self->class( $_ ) eq 'source' } $self->assigned_wits;
220 # Look for a matching set in our setlist, and return its corresponding group
221 sub minimum_grouping_for {
222 my( $self, $set ) = @_;
223 my $midx = $self->set_index( sub { "$set" eq "$_" } );
224 return undef unless defined $midx;
225 return $self->grouping( $midx );
229 Text::Tradition::Error->throw(
230 'ident' => 'Analysis::Result error',
236 __PACKAGE__->meta->make_immutable;