1 package Text::Tradition::Stemma;
4 use Encode qw( decode_utf8 );
7 use Graph::Reader::Dot;
8 use IPC::Run qw/ run binary /;
9 use Text::Tradition::Error;
10 use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /;
15 Text::Tradition::Stemma - a representation of a I<stemma codicum> for a Text::Tradition
20 my $t = Text::Tradition->new(
21 'name' => 'this is a text',
23 'file' => '/path/to/tei_parallel_seg_file.xml' );
25 my $s = $tradition->add_stemma( dotfile => '/path/to/stemma.dot' );
29 Text::Tradition is a library for representation and analysis of collated
30 texts, particularly medieval ones. The Collation is the central feature of
31 a Tradition, where the text, its sequence of readings, and its relationships
32 between readings are actually kept.
36 The easiest way to define a stemma (which is a directed acyclic graph, denoting
37 the scholar's hypothesis concerning which text(s) were copied from which other(s))
38 is to use a special form of the 'dot' syntax of GraphViz.
40 Each stemma opens with the line
44 and continues with a list of all manuscript witnesses in the stemma, whether
45 extant witnesses or missing archetypes or hyparchetypes. Each of these is
46 listed by its sigil on its own line, e.g.:
48 alpha [ class=hypothetical ]
49 1 [ class=hypothetical,label=* ]
52 Extant witnesses are listed with class=extant; missing or postulated witnesses
53 are listed with class=hypothetical. Anonymous hyparchetypes must be given a
54 unique name or number, but can be represented as anonymous with the addition
55 of 'label=*' to their lines. Greek letters or other special characters may be
56 used as names, but they must always be wrapped in double quotes.
58 Links between manuscripts are then listed with arrow notation, as below. These
59 lines show the direction of copying, one step at a time, for the entire stemma.
64 The final line in the definition should be the closing brace:
68 Thus for a set of extant manuscripts A, B, and C, where A and B were copied
69 from the archetype O and C was copied from B, the definition would be:
72 O [ class=hypothetical]
85 The constructor. This should generally be called from Text::Tradition, but
86 if called directly it takes the following options:
90 =item * collation - The collation with which the stemma is associated.
92 =item * dot - A filehandle open to a DOT representation of the stemma graph.
100 isa => 'Text::Tradition::Collation',
108 predicate => 'has_graph',
112 my( $self, $args ) = @_;
113 # If we have been handed a dotfile, initialize it into a graph.
114 if( exists $args->{'dot'} ) {
115 $self->_graph_from_dot( $args->{'dot'} );
119 sub _graph_from_dot {
120 my( $self, $dotfh ) = @_;
121 my $reader = Graph::Reader::Dot->new();
122 my $graph = $reader->read_graph( $dotfh );
124 $self->graph( $graph );
125 # Go through the nodes and set any non-hypothetical node to extant.
126 foreach my $v ( $self->graph->vertices ) {
127 $self->graph->set_vertex_attribute( $v, 'class', 'extant' )
128 unless $self->graph->has_vertex_attribute( $v, 'class' );
131 throw( "Failed to parse dot in $dotfh" );
137 =head2 as_dot( \%options )
139 Returns a normal dot representation of the stemma layout, suitable for rendering
140 with GraphViz. Options include:
144 =item * graph - A hashref of global graph options.
146 =item * node - A hashref of global node options.
148 =item * edge - A hashref of global edge options.
152 See the GraphViz documentation for the list of available options.
157 my( $self, $opts ) = @_;
159 # Get default and specified options
166 'fillcolor' => 'white',
168 'shape' => 'ellipse', # Shape for the extant nodes
171 'arrowhead' => 'none',
173 @graphopts{ keys %{$opts->{'graph'}} } = values %{$opts->{'graph'}}
175 @nodeopts{ keys %{$opts->{'node'}} } = values %{$opts->{'node'}}
177 @edgeopts{ keys %{$opts->{'edge'}} } = values %{$opts->{'edge'}}
181 push( @dotlines, 'digraph stemma {' );
182 ## Print out the global attributes
183 push( @dotlines, _make_dotline( 'graph', %graphopts ) ) if keys %graphopts;
184 push( @dotlines, _make_dotline( 'edge', %edgeopts ) ) if keys %edgeopts;
185 push( @dotlines, _make_dotline( 'node', %nodeopts ) ) if keys %nodeopts;
187 # Add each of the nodes.
188 foreach my $n ( $self->graph->vertices ) {
189 if( $self->graph->has_vertex_attribute( $n, 'label' ) ) {
190 my $ltext = $self->graph->get_vertex_attribute( $n, 'label' );
191 push( @dotlines, _make_dotline( $n, 'label' => $ltext ) );
193 # Use the default display settings.
194 push( @dotlines, " $n;" );
197 # Add each of our edges.
198 foreach my $e ( $self->graph->edges ) {
199 my( $from, $to ) = @$e;
200 push( @dotlines, " $from -> $to;" );
202 push( @dotlines, '}' );
204 return join( "\n", @dotlines );
207 =head2 editable( $linesep )
209 Returns a version of the graph rendered in our definition format. The
210 $linesep argument defaults to newline; set it to the empty string or to
211 a space if the result is to be sent via JSON.
217 my $join = shift || "\n";
219 push( @dotlines, 'digraph stemma {' );
220 my @real; # A cheap sort
221 foreach my $n ( sort $self->graph->vertices ) {
222 my $c = $self->graph->get_vertex_attribute( $n, 'class' );
223 $c = 'extant' unless $c;
224 if( $c eq 'extant' ) {
227 push( @dotlines, _make_dotline( $n, 'class' => $c ) );
230 # Now do the real ones
231 foreach my $n ( @real ) {
232 push( @dotlines, _make_dotline( $n, 'class' => 'extant' ) );
234 foreach my $e ( sort _by_vertex $self->graph->edges ) {
235 my( $from, $to ) = @$e;
236 push( @dotlines, " $from -> $to;" );
238 push( @dotlines, '}' );
239 return join( $join, @dotlines );
243 my( $obj, %attr ) = @_;
245 foreach my $k ( keys %attr ) {
248 push( @pairs, "$k=\"$v\"" );
250 return sprintf( " %s [ %s ];", $obj, join( ', ', @pairs ) );
254 return $a->[0].$a->[1] cmp $b->[0].$b->[1];
259 Returns an SVG representation of the graph, calling as_dot first.
264 my( $self, $opts ) = @_;
265 my $dot = $self->as_dot( $opts );
266 my @cmd = qw/dot -Tsvg/;
268 my $dotfile = File::Temp->new();
270 # $dotfile->unlink_on_destroy(0);
271 binmode $dotfile, ':utf8';
273 push( @cmd, $dotfile->filename );
274 run( \@cmd, ">", binary(), \$svg );
275 $svg = decode_utf8( $svg );
281 Returns a list of the extant witnesses represented in the stemma.
287 my @wits = grep { $self->graph->get_vertex_attribute( $_, 'class' ) eq 'extant' }
288 $self->graph->vertices;
295 { $self->graph->get_vertex_attribute( $_, 'class' ) eq 'hypothetical' }
296 $self->graph->vertices;
301 Text::Tradition::Error->throw(
302 'ident' => 'Stemma error',
309 __PACKAGE__->meta->make_immutable;
315 This package is free software and is provided "as is" without express
316 or implied warranty. You can redistribute it and/or modify it under
317 the same terms as Perl itself.
321 Tara L Andrews E<lt>aurum@cpan.orgE<gt>