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 );
209 Returns a version of the graph rendered in our definition format.
216 push( @dotlines, 'digraph stemma {' );
217 my @real; # A cheap sort
218 foreach my $n ( sort $self->graph->vertices ) {
219 my $c = $self->graph->get_vertex_attribute( $n, 'class' );
220 $c = 'extant' unless $c;
221 if( $c eq 'extant' ) {
224 push( @dotlines, _make_dotline( $n, 'class' => $c ) );
227 # Now do the real ones
228 foreach my $n ( @real ) {
229 push( @dotlines, _make_dotline( $n, 'class' => 'extant' ) );
231 foreach my $e ( sort _by_vertex $self->graph->edges ) {
232 my( $from, $to ) = @$e;
233 push( @dotlines, " $from -> $to;" );
235 push( @dotlines, '}' );
236 return join( "\n", @dotlines );
240 my( $obj, %attr ) = @_;
242 foreach my $k ( keys %attr ) {
245 push( @pairs, "$k=\"$v\"" );
247 return sprintf( " %s [ %s ];", $obj, join( ', ', @pairs ) );
251 return $a->[0].$a->[1] cmp $b->[0].$b->[1];
256 Returns an SVG representation of the graph, calling as_dot first.
261 my( $self, $opts ) = @_;
262 my $dot = $self->as_dot( $opts );
263 my @cmd = qw/dot -Tsvg/;
265 my $dotfile = File::Temp->new();
267 # $dotfile->unlink_on_destroy(0);
268 binmode $dotfile, ':utf8';
270 push( @cmd, $dotfile->filename );
271 run( \@cmd, ">", binary(), \$svg );
272 $svg = decode_utf8( $svg );
278 Returns a list of the extant witnesses represented in the stemma.
284 my @wits = grep { $self->graph->get_vertex_attribute( $_, 'class' ) eq 'extant' }
285 $self->graph->vertices;
290 Text::Tradition::Error->throw(
291 'ident' => 'Stemma error',
298 __PACKAGE__->meta->make_immutable;
304 This package is free software and is provided "as is" without express
305 or implied warranty. You can redistribute it and/or modify it under
306 the same terms as Perl itself.
310 Tara L Andrews E<lt>aurum@cpan.orgE<gt>