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 /;
16 Text::Tradition::Stemma - a representation of a I<stemma codicum> for a Text::Tradition
21 my $t = Text::Tradition->new(
22 'name' => 'this is a text',
24 'file' => '/path/to/tei_parallel_seg_file.xml' );
26 my $s = $tradition->add_stemma( dotfile => '/path/to/stemma.dot' );
30 Text::Tradition is a library for representation and analysis of collated
31 texts, particularly medieval ones. The Collation is the central feature of
32 a Tradition, where the text, its sequence of readings, and its relationships
33 between readings are actually kept.
37 The easiest way to define a stemma (which is a directed acyclic graph, denoting
38 the scholar's hypothesis concerning which text(s) were copied from which other(s))
39 is to use a special form of the 'dot' syntax of GraphViz.
41 Each stemma opens with the line
45 and continues with a list of all manuscript witnesses in the stemma, whether
46 extant witnesses or missing archetypes or hyparchetypes. Each of these is
47 listed by its sigil on its own line, e.g.:
49 alpha [ class=hypothetical ]
50 1 [ class=hypothetical,label=* ]
53 Extant witnesses are listed with class=extant; missing or postulated witnesses
54 are listed with class=hypothetical. Anonymous hyparchetypes must be given a
55 unique name or number, but can be represented as anonymous with the addition
56 of 'label=*' to their lines. Greek letters or other special characters may be
57 used as names, but they must always be wrapped in double quotes.
59 Links between manuscripts are then listed with arrow notation, as below. These
60 lines show the direction of copying, one step at a time, for the entire stemma.
65 The final line in the definition should be the closing brace:
69 Thus for a set of extant manuscripts A, B, and C, where A and B were copied
70 from the archetype O and C was copied from B, the definition would be:
73 O [ class=hypothetical]
86 The constructor. This should generally be called from Text::Tradition, but
87 if called directly it takes the following options:
91 =item * collation - The collation with which the stemma is associated.
93 =item * dot - A filehandle open to a DOT representation of the stemma graph.
101 isa => 'Text::Tradition::Collation',
109 predicate => 'has_graph',
113 my( $self, $args ) = @_;
114 # If we have been handed a dotfile, initialize it into a graph.
115 if( exists $args->{'dot'} ) {
116 $self->_graph_from_dot( $args->{'dot'} );
120 sub _graph_from_dot {
121 my( $self, $dotfh ) = @_;
122 my $reader = Graph::Reader::Dot->new();
123 my $graph = $reader->read_graph( $dotfh );
125 $self->graph( $graph );
126 # Go through the nodes and set any non-hypothetical node to extant.
127 foreach my $v ( $self->graph->vertices ) {
128 $self->graph->set_vertex_attribute( $v, 'class', 'extant' )
129 unless $self->graph->has_vertex_attribute( $v, 'class' );
132 throw( "Failed to parse dot in $dotfh" );
138 =head2 as_dot( \%options )
140 Returns a normal dot representation of the stemma layout, suitable for rendering
141 with GraphViz. Options include:
145 =item * graph - A hashref of global graph options.
147 =item * node - A hashref of global node options.
149 =item * edge - A hashref of global edge options.
153 See the GraphViz documentation for the list of available options.
158 my( $self, $opts ) = @_;
160 # Get default and specified options
167 'fillcolor' => 'white',
169 'shape' => 'ellipse', # Shape for the extant nodes
172 'arrowhead' => 'none',
174 @graphopts{ keys %{$opts->{'graph'}} } = values %{$opts->{'graph'}}
176 @nodeopts{ keys %{$opts->{'node'}} } = values %{$opts->{'node'}}
178 @edgeopts{ keys %{$opts->{'edge'}} } = values %{$opts->{'edge'}}
182 push( @dotlines, 'digraph stemma {' );
183 ## Print out the global attributes
184 push( @dotlines, _make_dotline( 'graph', %graphopts ) ) if keys %graphopts;
185 push( @dotlines, _make_dotline( 'edge', %edgeopts ) ) if keys %edgeopts;
186 push( @dotlines, _make_dotline( 'node', %nodeopts ) ) if keys %nodeopts;
188 # Add each of the nodes.
189 foreach my $n ( $self->graph->vertices ) {
190 if( $self->graph->has_vertex_attribute( $n, 'label' ) ) {
191 my $ltext = $self->graph->get_vertex_attribute( $n, 'label' );
192 push( @dotlines, _make_dotline( $n, 'label' => $ltext ) );
194 # Use the default display settings.
195 push( @dotlines, " $n;" );
198 # Add each of our edges.
199 foreach my $e ( $self->graph->edges ) {
200 my( $from, $to ) = @$e;
201 push( @dotlines, " $from -> $to;" );
203 push( @dotlines, '}' );
205 return join( "\n", @dotlines );
208 =head2 editable( $linesep )
210 Returns a version of the graph rendered in our definition format. The
211 $linesep argument defaults to newline; set it to the empty string or to
212 a space if the result is to be sent via JSON.
218 my $join = shift || "\n";
220 push( @dotlines, 'digraph stemma {' );
221 my @real; # A cheap sort
222 foreach my $n ( sort $self->graph->vertices ) {
223 my $c = $self->graph->get_vertex_attribute( $n, 'class' );
224 $c = 'extant' unless $c;
225 if( $c eq 'extant' ) {
228 push( @dotlines, _make_dotline( $n, 'class' => $c ) );
231 # Now do the real ones
232 foreach my $n ( @real ) {
233 push( @dotlines, _make_dotline( $n, 'class' => 'extant' ) );
235 foreach my $e ( sort _by_vertex $self->graph->edges ) {
236 my( $from, $to ) = @$e;
237 push( @dotlines, " $from -> $to;" );
239 push( @dotlines, '}' );
240 return join( $join, @dotlines );
244 my( $obj, %attr ) = @_;
246 foreach my $k ( keys %attr ) {
249 push( @pairs, "$k=\"$v\"" );
251 return sprintf( " %s [ %s ];", $obj, join( ', ', @pairs ) );
255 return $a->[0].$a->[1] cmp $b->[0].$b->[1];
260 Returns an SVG representation of the graph, calling as_dot first.
265 my( $self, $opts ) = @_;
266 my $dot = $self->as_dot( $opts );
267 my @cmd = qw/dot -Tsvg/;
269 my $dotfile = File::Temp->new();
271 # $dotfile->unlink_on_destroy(0);
272 binmode $dotfile, ':utf8';
274 push( @cmd, $dotfile->filename );
275 run( \@cmd, ">", binary(), \$svg );
276 # HACK: Parse the SVG and change the dimensions.
277 # Convert width from pt to px, and remove height to allow scaling.
278 my $parser = XML::LibXML->new();
279 my $svgdoc = $parser->parse_string( decode_utf8( $svg ) );
280 my $dval = $svgdoc->documentElement->getAttribute('width');
282 $svgdoc->documentElement->setAttribute( 'width', $dval );
283 $svgdoc->documentElement->removeAttribute('height');
285 return decode_utf8( $svgdoc->toString );
290 Returns a list of the extant witnesses represented in the stemma.
296 my @wits = grep { $self->graph->get_vertex_attribute( $_, 'class' ) eq 'extant' }
297 $self->graph->vertices;
304 { $self->graph->get_vertex_attribute( $_, 'class' ) eq 'hypothetical' }
305 $self->graph->vertices;
310 Text::Tradition::Error->throw(
311 'ident' => 'Stemma error',
318 __PACKAGE__->meta->make_immutable;
324 This package is free software and is provided "as is" without express
325 or implied warranty. You can redistribute it and/or modify it under
326 the same terms as Perl itself.
330 Tara L Andrews E<lt>aurum@cpan.orgE<gt>