--- /dev/null
+lib/Text/Tradition/Parser/BaseText.pm
+lib/Text/Tradition/Parser/CollateText.pm
+lib/Text/Tradition/Parser/CTE.pm
+lib/Text/Tradition/Parser/KUL.pm
+lib/Text/Tradition/Analysis.pm
default => 'Tradition',
);
-has 'stemma' => (
- is => 'ro',
- isa => 'Text::Tradition::Stemma',
- writer => '_add_stemma',
- predicate => 'has_stemma',
+has 'stemmata' => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Text::Tradition::Stemma]',
+ handles => {
+ all_stemmata => 'elements',
+ _add_stemma => 'push',
+ stemma => 'get',
+ stemma_count => 'count',
+ clear_stemmata => 'clear',
+ },
+ default => sub { [] },
);
# Create the witness before trying to add it
'file' => 't/data/simple.txt',
);
+is( $t->stemma_count, 0, "No stemmas added yet" );
my $s;
ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
-is( $t->stemma, $s, "Stemma is the right one" );
+is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
+is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
=end testing
my $data = {};
# We need a stemma in order to run this...
- unless( $tradition->has_stemma ) {
+ unless( $tradition->stemma_count ) {
warn "Tradition '" . $tradition->name . "' has no stemma to analyze";
return undef;
}
- my $stemma = $tradition->stemma;
+ my $stemma = $tradition->stemma(0); # TODO allow multiple
# We have the collation, so get the alignment table with witnesses in rows.
# Also return the reading objects in the table, rather than just the words.
use Text::Tradition::Collation::RelationshipStore;
use Text::Tradition::Error;
use XML::LibXML;
+use XML::LibXML::XPathContext;
use Moose;
has 'sequence' => (
=head1 OUTPUT METHODS
-=head2 as_svg
+=head2 as_svg( \%options )
Returns an SVG string that represents the graph, via as_dot and graphviz.
+See as_dot for a list of options.
=cut
sub as_svg {
- my( $self ) = @_;
+ my( $self, $opts ) = @_;
my @cmd = qw/dot -Tsvg/;
my( $svg, $err );
my $dotfile = File::Temp->new();
- ## TODO REMOVE
+ ## USE FOR DEBUGGING
# $dotfile->unlink_on_destroy(0);
binmode $dotfile, ':utf8';
- print $dotfile $self->as_dot();
+ print $dotfile $self->as_dot( $opts );
push( @cmd, $dotfile->filename );
run( \@cmd, ">", binary(), \$svg );
- $svg = decode_utf8( $svg );
- return $svg;
+ return decode_utf8( $svg );
}
-=head2 svg_subgraph( $from, $to )
-Returns an SVG string that represents the portion of the graph given by the
-specified range. The $from and $to variables refer to ranks within the graph.
+=head2 as_dot( \%options )
-=cut
+Returns a string that is the collation graph expressed in dot
+(i.e. GraphViz) format. Options include:
-sub svg_subgraph {
- my( $self, $from, $to ) = @_;
-
- my $dot = $self->as_dot( $from, $to );
- unless( $dot ) {
- throw( "Could not output a graph with range $from - $to" );
- }
-
- my @cmd = qw/dot -Tsvg/;
- my( $svg, $err );
- my $dotfile = File::Temp->new();
- ## TODO REMOVE
- # $dotfile->unlink_on_destroy(0);
- binmode $dotfile, ':utf8';
- print $dotfile $dot;
- push( @cmd, $dotfile->filename );
- run( \@cmd, ">", binary(), \$svg );
- $svg = decode_utf8( $svg );
- return $svg;
-}
+=over 4
+=item * from
-=head2 as_dot( $from, $to )
+=item * to
-Returns a string that is the collation graph expressed in dot
-(i.e. GraphViz) format. If $from or $to is passed, as_dot creates
-a subgraph rather than the entire graph.
+=item * color_common
+
+=back
=cut
sub as_dot {
- my( $self, $startrank, $endrank ) = @_;
+ my( $self, $opts ) = @_;
+ my $startrank = $opts->{'from'} if $opts;
+ my $endrank = $opts->{'to'} if $opts;
+ my $color_common = $opts->{'color_common'} if $opts;
# Check the arguments
if( $startrank ) {
'bgcolor' => 'none',
);
my %node_attrs = (
- 'fontsize' => 11,
+ 'fontsize' => 14,
'fillcolor' => 'white',
'style' => 'filled',
'shape' => 'ellipse'
if( $endrank ) {
$dot .= "\t\"#SUBEND#\" [ label=\"...\" ];\n";
}
+
my %used; # Keep track of the readings that actually appear in the graph
- foreach my $reading ( $self->readings ) {
+ # Sort the readings by rank if we have ranks; this speeds layout.
+ my @all_readings = $self->end->has_rank
+ ? sort { $a->rank <=> $b->rank } $self->readings
+ : $self->readings;
+ foreach my $reading ( @all_readings ) {
# Only output readings within our rank range.
next if $startrank && $reading->rank < $startrank;
next if $endrank && $reading->rank > $endrank;
my $label = $reading->text;
$label =~ s/\"/\\\"/g;
$rattrs->{'label'} = $label;
- # TODO make this an option?
- # $rattrs->{'fillcolor'} = 'green' if $reading->is_common;
+ $rattrs->{'fillcolor'} = '#b3f36d' if $reading->is_common && $color_common;
$dot .= sprintf( "\t\"%s\" %s;\n", $reading->id, _dot_attr_string( $rattrs ) );
}
- # Add the real edges
+ # Add the real edges. Need to weight one edge per rank jump, in a
+ # continuous line.
+ my $weighted = $self->_add_edge_weights;
my @edges = $self->paths;
my( %substart, %subend );
foreach my $edge ( @edges ) {
# Do we need to output this edge?
if( $used{$edge->[0]} && $used{$edge->[1]} ) {
- my $label = $self->path_display_label( $self->path_witnesses( $edge ) );
+ my $label = $self->_path_display_label( $self->path_witnesses( $edge ) );
my $variables = { %edge_attrs, 'label' => $label };
+
# Account for the rank gap if necessary
- if( $self->reading( $edge->[1] )->has_rank
- && $self->reading( $edge->[0] )->has_rank
- && $self->reading( $edge->[1] )->rank
- - $self->reading( $edge->[0] )->rank > 1 ) {
- $variables->{'minlen'} = $self->reading( $edge->[1] )->rank
- - $self->reading( $edge->[0] )->rank;
+ my $rank0 = $self->reading( $edge->[0] )->rank
+ if $self->reading( $edge->[0] )->has_rank;
+ my $rank1 = $self->reading( $edge->[1] )->rank
+ if $self->reading( $edge->[1] )->has_rank;
+ if( defined $rank0 && defined $rank1 && $rank1 - $rank0 > 1 ) {
+ $variables->{'minlen'} = $rank1 - $rank0;
}
+
+ # Add the calculated edge weights
+ if( exists $weighted->{$edge->[0]}
+ && $weighted->{$edge->[0]} eq $edge->[1] ) {
+ # $variables->{'color'} = 'red';
+ $variables->{'weight'} = 3.0;
+ }
+
# EXPERIMENTAL: make edge width reflect no. of witnesses
my $extrawidth = scalar( $self->path_witnesses( $edge ) ) * 0.2;
$variables->{'penwidth'} = $extrawidth + 0.8; # gives 1 for a single wit
}
# Add substitute start and end edges if necessary
foreach my $node ( keys %substart ) {
- my $witstr = $self->path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
+ my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
my $variables = { %edge_attrs, 'label' => $witstr };
my $varopts = _dot_attr_string( $variables );
$dot .= "\t\"#SUBSTART#\" -> \"$node\" $varopts;";
}
foreach my $node ( keys %subend ) {
- my $witstr = $self->path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
+ my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) );
my $variables = { %edge_attrs, 'label' => $witstr };
my $varopts = _dot_attr_string( $variables );
$dot .= "\t\"$node\" -> \"#SUBEND#\" $varopts;";
}
-
+
$dot .= "}\n";
return $dot;
}
return( '[ ' . join( ', ', @attrs ) . ' ]' );
}
+sub _add_edge_weights {
+ my $self = shift;
+ # Walk the graph from START to END, choosing the successor node with
+ # the largest number of witness paths each time.
+ my $weighted = {};
+ my $curr = $self->start->id;
+ while( $curr ne $self->end->id ) {
+ my @succ = sort { $self->path_witnesses( $curr, $a )
+ <=> $self->path_witnesses( $curr, $b ) }
+ $self->sequence->successors( $curr );
+ my $next = pop @succ;
+ # Try to avoid lacunae in the weighted path.
+ while( $self->reading( $next )->is_lacuna && @succ ) {
+ $next = pop @succ;
+ }
+ $weighted->{$curr} = $next;
+ $curr = $next;
+ }
+ return $weighted;
+}
+
+=head2 path_witnesses( $edge )
+
+Returns the list of sigils whose witnesses are associated with the given edge.
+The edge can be passed as either an array or an arrayref of ( $source, $target ).
+
+=cut
+
sub path_witnesses {
my( $self, @edge ) = @_;
# If edge is an arrayref, cope.
return @wits;
}
-sub path_display_label {
+sub _path_display_label {
my $self = shift;
my @wits = sort @_;
my $maj = scalar( $self->tradition->witnesses ) * 0.6;
}
# Add the relationship graph to the XML
- $self->relations->as_graphml( $graphml_ns, $root, \%node_hash,
+ $self->relations->_as_graphml( $graphml_ns, $root, \%node_hash,
$node_data_keys{'id'}, \%edge_data_keys );
# Save and return the thing
sub make_alignment_table {
my( $self, $noderefs, $include ) = @_;
- unless( $self->linear ) {
- throw( "Need a linear graph in order to make an alignment table" );
- }
+ # Make sure we can do this
+ throw( "Need a linear graph in order to make an alignment table" )
+ unless $self->linear;
+ $self->calculate_ranks unless $self->end->has_rank;
+
my $table = { 'alignment' => [], 'length' => $self->end->rank - 1 };
my @all_pos = ( 1 .. $self->end->rank - 1 );
foreach my $wit ( sort { $a->sigil cmp $b->sigil } $self->tradition->witnesses ) {
# Combine!
# print STDERR "Combining readings at same rank: $key\n";
$self->merge_readings( $unique_rank_rdg{$key}, $rdg );
+ # TODO see if this now makes a common point.
} else {
$unique_rank_rdg{$key} = $rdg;
}
sub common_predecessor {
my $self = shift;
my( $r1, $r2 ) = $self->_objectify_args( @_ );
- return $self->common_in_path( $r1, $r2, 'predecessors' );
+ return $self->_common_in_path( $r1, $r2, 'predecessors' );
}
sub common_successor {
my $self = shift;
my( $r1, $r2 ) = $self->_objectify_args( @_ );
- return $self->common_in_path( $r1, $r2, 'successors' );
+ return $self->_common_in_path( $r1, $r2, 'successors' );
}
-sub common_in_path {
+sub _common_in_path {
my( $self, $r1, $r2, $dir ) = @_;
my $iter = $r1->rank > $r2->rank ? $r1->rank : $r2->rank;
$iter = $self->end->rank - $iter if $dir eq 'successors';
no Moose;
__PACKAGE__->meta->make_immutable;
-=head1 BUGS / TODO
+=head1 LICENSE
-=over
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
-=item * Get rid of $backup in reading_sequence
+=head1 AUTHOR
-=back
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
return $self->is_start || $self->is_end || $self->is_lacuna || $self->is_ph;
}
-# Some syntactic sugar
+=head1 Convenience methods
+
+=head2 related_readings
+
+Calls Collation's related_readings with $self as the first argument.
+
+=cut
+
sub related_readings {
my $self = shift;
return $self->collation->related_readings( $self, @_ );
}
+=head2 predecessors
+
+Returns a list of Reading objects that immediately precede $self in the collation.
+
+=cut
+
sub predecessors {
my $self = shift;
my @pred = $self->collation->sequence->predecessors( $self->id );
return map { $self->collation->reading( $_ ) } @pred;
}
+=head2 successors
+
+Returns a list of Reading objects that immediately follow $self in the collation.
+
+=cut
+
sub successors {
my $self = shift;
my @succ = $self->collation->sequence->successors( $self->id );
return map { $self->collation->reading( $_ ) } @succ;
}
+=head2 set_identical( $other_reading)
+
+Backwards compatibility method, to add a transposition relationship
+between $self and $other_reading. Don't use this.
+
+=cut
+
sub set_identical {
my( $self, $other ) = @_;
return $self->collation->add_relationship( $self, $other,
no Moose::Util::TypeConstraints;
+=head1 NAME
+
+Text::Tradition::Collation::Relationship - represents a syntactic or semantic
+relationship between two readings
+
+=head1 DESCRIPTION
+
+Text::Tradition is a library for representation and analysis of collated
+texts, particularly medieval ones. A relationship connects two readings
+within a collation, usually when they appear in the same place in different
+texts.
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+Creates a new relationship. Usually called via $collation->add_relationship.
+Options include:
+
=over 4
=item * type - Can be one of spelling, orthographic, grammatical, meaning, lexical, collated, repetition, transposition. All but the last two are only valid relationships between readings that occur at the same point in the text.
=back
+=head1 ACCESSORS
+
+=head2 type
+
+=head2 displayform
+
+=head2 scope
+
+=head2 non_correctable
+
+=head2 non_independent
+
+See the option descriptions above.
+
=cut
has 'type' => (
);
# A read-only meta-Boolean attribute.
+
+=head2 colocated
+
+Returns true if the relationship type is one that requires that its readings
+occupy the same place in the collation.
+
+=cut
+
sub colocated {
my $self = shift;
return $self->type !~ /^(repetition|transposition)$/;
}
+=head2 nonlocal
+
+Returns true if the relationship scope is anything other than 'local'.
+
+=cut
+
sub nonlocal {
my $self = shift;
return $self->scope ne 'local';
$self->delete_reading( $deleted );
}
-sub as_graphml {
+sub _as_graphml {
my( $self, $graphml_ns, $xmlroot, $node_hash, $nodeid_key, $edge_keys ) = @_;
my $rgraph = $xmlroot->addNewChild( $graphml_ns, 'graph' );
my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
ok( $d->save( $t ), "Updated tradition with stemma" );
is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
- is( $d->tradition( $uuid )->stemma, $s, "...and it has the correct stemma" );
+ is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
try {
$d->save( $s );
} catch( Text::Tradition::Error $e ) {
is( scalar $f->tradition_ids, 2, "Directory index has both traditions" );
my $tf = $f->tradition( $uuid );
is( $tf->name, $t->name, "Retrieved the tradition from a new directory" );
- my $sid = $f->object_to_id( $tf->stemma );
+ my $sid = $f->object_to_id( $tf->stemma(0) );
try {
$f->tradition( $sid );
} catch( Text::Tradition::Error $e ) {
1;
-
\ No newline at end of file
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
A basic exception class to throw around, as it were.
-=cut
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
=head1 AUTHOR
# $rel->type, $rel->from->id, $rel->to->id );
# }
# }
- $collation->calculate_ranks();
+ $collation->calculate_common_readings(); # will implicitly rank
}
=item B<read_base>
}
# Rank the readings.
- $collation->calculate_ranks() if $collation->linear;
+ $collation->calculate_common_readings(); # will implicitly rank
# Save the text for each witness so that we can ensure consistency
# later on
my( $c, $idx, @tokens ) = @_;
my %unique;
my @readings;
+ my $commonctr = 0;
foreach my $j ( 0 .. $#tokens ) {
if( $tokens[$j] ) {
my $word = _restore_punct( $tokens[$j] );
$rdg = $unique{$word};
} else {
my %args = ( 'id' => join( ',', $idx, $j+1 ),
+ 'rank' => $idx,
'text' => $word,
'collation' => $c );
- $args{'is_lacuna'} = 1 if $word eq '#LACUNA#';
+ if( $word eq '#LACUNA#' ) {
+ $args{'is_lacuna'} = 1
+ } else {
+ $commonctr++;
+ }
$rdg = Text::Tradition::Collation::Reading->new( %args );
$unique{$word} = $rdg;
}
push( @readings, $rdg );
} else {
+ $commonctr++;
push( @readings, undef );
}
}
+ if( $commonctr == 1 ) {
+ # Whichever reading isn't a lacuna is a common node.
+ foreach my $rdg ( values %unique ) {
+ next if $rdg->is_lacuna;
+ $rdg->is_common( 1 );
+ }
+ }
map { $c->add_reading( $_ ) } values( %unique );
return @readings;
}
=cut
my( $IDKEY, $TOKENKEY, $TRANSPOS_KEY, $RANK_KEY,
- $START_KEY, $END_KEY, $LACUNA_KEY,
+ $START_KEY, $END_KEY, $LACUNA_KEY, $COMMON_KEY,
$SOURCE_KEY, $TARGET_KEY, $WITNESS_KEY, $EXTRA_KEY, $RELATIONSHIP_KEY,
$SCOPE_KEY, $CORRECT_KEY, $INDEP_KEY )
= qw/ id text identical rank
- is_start is_end is_lacuna
+ is_start is_end is_lacuna is_common
source target witness extra relationship
scope non_correctable non_independent /;
my $reading_options = {
'id' => $n->{$IDKEY},
'is_lacuna' => $n->{$LACUNA_KEY},
+ 'is_common' => $n->{$COMMON_KEY},
};
my $rank = $n->{$RANK_KEY};
$reading_options->{'rank'} = $rank if $rank;
# text and identical rank that can be merged.
$tradition->collation->flatten_ranks();
+ # And now that we've done that, calculate the common nodes.
+ $tradition->collation->calculate_common_readings();
+
# Save the text for each witness so that we can ensure consistency
# later on
$tradition->collation->text_from_paths();
# add them to the witness paths.
foreach my $idx ( 1 .. $#{$alignment_table} ) {
my $row = $alignment_table->[$idx];
- my $nodes = make_nodes( $c, $row, $idx );
+ my $nodes = _make_nodes( $c, $row, $idx );
foreach my $w ( 0 .. $#{$row} ) {
# push the appropriate node onto the appropriate witness path
my $word = $row->[$w];
if( $word ) {
my $reading = $nodes->{$word};
my $wit = $witnesses[$w];
- $DB::single = 1 unless $wit;
push( @{$wit->path}, $reading );
} # else skip it for empty readings.
}
}
}
-sub make_nodes {
+sub _make_nodes {
my( $collation, $row, $index ) = @_;
my %unique;
+ my $commonctr = 0; # Holds the number of unique readings + gaps, ex. lacunae.
foreach my $w ( @$row ) {
$unique{$w} = 1 if $w;
+ $commonctr +=1 unless ( $w && $w eq '#LACUNA#' );
}
my $ctr = 1;
foreach my $w ( keys %unique ) {
'rank' => $index,
'text' => $w,
};
- $rargs->{'is_lacuna'} = 1 if $w eq '#LACUNA#';
+ if( $w eq '#LACUNA#' ) {
+ $rargs->{'is_lacuna'} = 1;
+ } elsif( $commonctr == 1 ) {
+ $rargs->{'is_common'} = 1;
+ }
my $r = $collation->add_reading( $rargs );
$unique{$w} = $r;
$ctr++;
# transposed reading nodes to be merged into one (producing a
# nonlinear, bidirectional graph) or not (producing a relatively
# linear, unidirectional graph.)
- return $collation->linear ? collate_linearly( @_ )
- : collate_nonlinearly( @_ );
+ return $collation->linear ? _collate_linearly( @_ )
+ : _collate_nonlinearly( @_ );
}
-sub collate_linearly {
+sub _collate_linearly {
my( $collation, $lemma_set, @variant_sets ) = @_;
my @unique;
return $substitutions;
}
-sub collate_nonlinearly {
+sub _collate_nonlinearly {
my( $collation, $lemma_set, @variant_sets ) = @_;
my @unique;
return cmp_str( $node );
}
+=head2 B<cmp_str>
+
+Don't use this. Really.
+
+=cut
+
sub cmp_str {
my( $reading ) = @_;
my $word = $reading->text();
return @repeated;
}
+=head2 B<add_hash_entry>( $hash, $key, $entry )
+
+Very simple utility for adding $entry to the list at $hash->{$key}.
+
+=cut
+
sub add_hash_entry {
my( $hash, $key, $entry ) = @_;
if( exists $hash->{$key} ) {
}
}
-sub is_monotonic {
- my( @readings ) = @_;
- my( $common, $min, $max ) = ( -1, -1, -1 );
- foreach my $rdg ( @readings ) {
-# print STDERR "Checking reading " . $rdg->id . "/" . $rdg->text . " - "
-# . $rdg->position->reference ."\n";
- return 0 if $rdg->position->common < $common;
- if( $rdg->position->common == $common ) {
- return 0 if $rdg->position->min <= $min;
- return 0 if $rdg->position->max <= $max;
- }
- $common = $rdg->position->common;
- $min = $rdg->position->min;
- $max = $rdg->position->max;
- }
- return 1;
-}
-
1;
=head1 BUGS / TODO
use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /;
use Moose;
+=head1 NAME
+
+Text::Tradition::Stemma - a representation of a I<stemma codicum> for a Text::Tradition
+
+=head1 SYNOPSIS
+
+ use Text::Tradition;
+ my $t = Text::Tradition->new(
+ 'name' => 'this is a text',
+ 'input' => 'TEI',
+ 'file' => '/path/to/tei_parallel_seg_file.xml' );
+
+ my $s = $tradition->add_stemma( dotfile => '/path/to/stemma.dot' );
+
+=head1 DESCRIPTION
+
+Text::Tradition is a library for representation and analysis of collated
+texts, particularly medieval ones. The Collation is the central feature of
+a Tradition, where the text, its sequence of readings, and its relationships
+between readings are actually kept.
+
+=head1 DOT SYNTAX
+
+The easiest way to define a stemma (which is a directed acyclic graph, denoting
+the scholar's hypothesis concerning which text(s) were copied from which other(s))
+is to use a special form of the 'dot' syntax of GraphViz.
+
+Each stemma opens with the line
+
+ digraph Stemma {
+
+and continues with a list of all manuscript witnesses in the stemma, whether
+extant witnesses or missing archetypes or hyparchetypes. Each of these is
+listed by its sigil on its own line, e.g.:
+
+ alpha [ class=hypothetical ]
+ 1 [ class=hypothetical,label=* ]
+ Ms4 [ class=extant ]
+
+Extant witnesses are listed with class=extant; missing or postulated witnesses
+are listed with class=hypothetical. Anonymous hyparchetypes must be given a
+unique name or number, but can be represented as anonymous with the addition
+of 'label=*' to their lines. Greek letters or other special characters may be
+used as names, but they must always be wrapped in double quotes.
+
+Links between manuscripts are then listed with arrow notation, as below. These
+lines show the direction of copying, one step at a time, for the entire stemma.
+
+ alpha -> 1
+ 1 -> Ms4
+
+The final line in the definition should be the closing brace:
+
+ }
+
+Thus for a set of extant manuscripts A, B, and C, where A and B were copied
+from the archetype O and C was copied from B, the definition would be:
+
+ digraph Stemma {
+ O [ class=hypothetical]
+ A [ class=extant ]
+ B [ class=extant ]
+ C [ class=extant ]
+ O -> A
+ O -> B
+ B -> C
+ }
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+The constructor. This should generally be called from Text::Tradition, but
+if called directly it takes the following options:
+
+=over
+
+=item * collation - The collation with which the stemma is associated.
+
+=item * dot - A filehandle open to a DOT representation of the stemma graph.
+
+=back
+
+=cut
+
has collation => (
is => 'ro',
isa => 'Text::Tradition::Collation',
my( $self, $args ) = @_;
# If we have been handed a dotfile, initialize it into a graph.
if( exists $args->{'dot'} ) {
- $self->graph_from_dot( $args->{'dot'} );
+ $self->_graph_from_dot( $args->{'dot'} );
}
}
-sub graph_from_dot {
+sub _graph_from_dot {
my( $self, $dotfh ) = @_;
my $reader = Graph::Reader::Dot->new();
my $graph = $reader->read_graph( $dotfh );
}
}
+=head1 METHODS
+
+=head2 as_dot( \%options )
+
+Returns a normal dot representation of the stemma layout, suitable for rendering
+with GraphViz. Options include:
+
+=over
+
+=item * graph - A hashref of global graph options.
+
+=item * node - A hashref of global node options.
+
+=item * edge - A hashref of global edge options.
+
+=back
+
+See the GraphViz documentation for the list of available options.
+
+=cut
+
sub as_dot {
my( $self, $opts ) = @_;
return join( "\n", @dotlines );
}
+=head2 editable
+
+Returns a version of the graph rendered in our definition format.
+
+=cut
-# Another version of dot output meant for graph editing, thus
-# much simpler.
sub editable {
my $self = shift;
my @dotlines;
return $a->[0].$a->[1] cmp $b->[0].$b->[1];
}
-# Render the stemma as SVG.
+=head2 as_svg
+
+Returns an SVG representation of the graph, calling as_dot first.
+
+=cut
+
sub as_svg {
my( $self, $opts ) = @_;
my $dot = $self->as_dot( $opts );
return $svg;
}
+=head2 witnesses
+
+Returns a list of the extant witnesses represented in the stemma.
+
+=cut
+
sub witnesses {
my $self = shift;
my @wits = grep { $self->graph->get_vertex_attribute( $_, 'class' ) eq 'extant' }
return @wits;
}
+=head2 distance_trees( program => $program )
+
+Returns a set of undirected graphs, which are the result of running a distance
+tree calculation program on the collation. Currently the only supported
+program is phylip_pars.
+
+=cut
+
#### Methods for calculating phylogenetic trees ####
before 'distance_trees' => sub {
}
};
+=head2 run_phylip_pars
+
+Runs Phylip Pars on the collation, returning the results in Newick format.
+Used for the distance_trees calculation.
+
+=cut
+
sub run_phylip_pars {
my $self = shift;
my $cdata = character_input( $self->collation->make_alignment_table() );
__PACKAGE__->meta->make_immutable;
1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
@EXPORT_OK = qw/ make_character_matrix character_input phylip_pars
parse_newick newick_to_svg /;
-sub make_character_matrix {
+=head1 NAME
+
+Text::Tradition::StemmaUtil - standalone utilities for distance tree calculations
+
+=head1 DESCRIPTION
+
+This package contains a set of utilities for running phylogenetic analysis on
+text collations.
+
+=head1 SUBROUTINES
+
+=cut
+
+sub _make_character_matrix {
my( $table ) = @_;
# Push the names of the witnesses to initialize the rows of the matrix.
my @matrix = map { [ _normalize_witname( $_->{'witness'} ) ] }
my @pos_readings = map { $_->{'tokens'}->[$token_index] }
@{$table->{'alignment'}};
my @pos_text = map { $_ ? $_->{'t'} : $_ } @pos_readings;
- my @chars = convert_characters( \@pos_text );
+ my @chars = _convert_characters( \@pos_text );
foreach my $idx ( 0 .. $#matrix ) {
push( @{$matrix[$idx]}, $chars[$idx] );
}
return sprintf( "%-10s", $witname );
}
-sub convert_characters {
+sub _convert_characters {
my $row = shift;
# This is a simple algorithm that treats every reading as different.
# Eventually we will want to be able to specify how relationships
return @chars;
}
+=head2 character_input( $alignment_table )
+
+Returns a character matrix string suitable for Phylip programs, which
+corresponds to the given alignment table. See Text::Tradition::Collation
+for a description of the alignment table format.
+
+=cut
+
sub character_input {
my $table = shift;
- my $character_matrix = make_character_matrix( $table );
+ my $character_matrix = _make_character_matrix( $table );
my $input = '';
my $rows = scalar @{$character_matrix};
my $columns = scalar @{$character_matrix->[0]} - 1;
return $input;
}
+=head2 phylip_pars( $character_matrix )
+
+Runs Phylip Pars on the given character matrix. Returns results in Newick format.
+
+=cut
+
sub phylip_pars {
my( $charmatrix ) = @_;
# Set up a temporary directory for all the default Phylip files.
throw( join( '', @error ) );
}
+=head2 parse_newick( $newick_string )
+
+Parses the given Newick tree(s) into one or more undirected Graph objects.
+
+=cut
+
sub parse_newick {
my $newick = shift;
my @trees;
return \@trees;
}
+=head2 newick_to_svg( $newick_string )
+
+Uses the FigTree utility (if installed) to transform the given Newick tree(s)
+into a graph visualization.
+
+=cut
+
sub newick_to_svg {
my $newick = shift;
my $program = File::Which::which( 'figtree' );
);
}
+1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
binmode STDOUT, ":utf8";
eval { no warnings; binmode $DB::OUT, ":utf8"; };
-my( $informat, $inbase, $outformat, $help, $linear, $name, $HACK, $sep, $stemmafile, $dsn )
+my( $informat, $inbase, $outformat, $help, $linear, $name, $HACK, $sep, $stemmafile,
+ $dsn, $dbuser, $dbpass )
= ( '', '', '', '', 1, 'Tradition', 0, "\t", '',
- "dbi:SQLite:dbname=stemmaweb/db/traditions.db" );
+ "dbi:SQLite:dbname=stemmaweb/db/traditions.db", undef, undef );
GetOptions( 'i|in=s' => \$informat,
'b|base=s' => \$inbase,
'n|name=s' => \$name,
'h|help' => \$help,
's|stemma=s' => \$stemmafile,
+ 'u|user=s' => \$dbuser,
+ 'p|pass=s' => \$dbpass,
'sep=s' => \$sep,
'hack' => \$HACK,
'dsn=s' => \$dsn,
print STDERR "Bad result: $tree";
}
} elsif( $outformat eq 'db' ) {
+ my $extra_args = { 'create' => 1 };
+ $extra_args->{'user'} = $dbuser if $dbuser;
+ $extra_args->{'password'} = $dbpass if $dbpass;
my $dir = Text::Tradition::Directory->new( 'dsn' => $dsn,
- 'extra_args' => { 'create' => 1 } );
+ 'extra_args' => $extra_args );
my $scope = $dir->new_scope;
my $uuid = $dir->store( $tradition );
print STDERR "Saved tradition to database with ID $uuid\n";
package stemmaweb::Controller::Relation;
use Moose;
use namespace::autoclean;
+use TryCatch;
BEGIN { extends 'Catalyst::Controller' }
=head1 DESCRIPTION
-The stemma analysis tool with the pretty colored table.
+The reading relationship mapper with draggable nodes.
=head1 METHODS
+=head2 index
+
GET relation/$textid
Renders the application for the text identified by $textid.
-=head2 index
-
-The relationship editor tool.
-
=cut
sub index :Path :Args(1) {
my( $self, $c, $textid ) = @_;
my $m = $c->model('Directory');
my $tradition = $m->tradition( $textid );
- my $table = $tradition->collation->make_alignment_table();
- my $witlist = map { $_->{'witness'} } @{$table->{'alignment'}};
- $c->stash->{witnesses} = $witlist;
- $c->stash->{alignment} = $table;
- $c->stash->{template} = 'relate.tt';
+ my $collation = $tradition->collation;
+ my $svg_str = $collation->as_svg;
+ $svg_str =~ s/\n//gs;
+ $c->stash->{'svg_string'} = $svg_str;
+ $c->stash->{'template'} = 'relate.tt';
+}
+
+sub dispatcher :Path :Args(2) {
+ my( $self, $c, $textid, $forward ) = @_;
+ $c->stash->{'tradition'} = $c->model('Directory')->tradition( $textid );
+ $c->forward( $forward );
+}
+
+=head2 relationship_definition
+
+ GET relation/definitions
+
+Returns a data structure giving the valid types and scopes for a relationship.
+
+=cut
+
+sub definitions :Local :Args(0) {
+ my( $self, $c ) = @_;
+ my $valid_relationships = [ qw/ spelling orthographic grammatical meaning / ];
+ my $valid_scopes = [ qw/ local global / ];
+ $c->stash->{'result'} = { 'types' => $valid_relationships, 'scopes' => $valid_scopes };
+ $c->forward('View::JSON');
}
+=head2 relationship
+
+ POST relation/$textid/relationship
+ source_id: $source, target_id: $target, rel_type: $type, scope: $scope
+
+Sets the specified relationship between the readings in $source and $target.
+Returns 200 and a list of node pairs where the relationship was added on success;
+returns 403 and an { error: message } struct on failure.
+
+=cut
+
+sub relationship :Private {
+ my( $self, $c ) = @_;
+ my $tradition = delete $c->stash->{'tradition'};
+ my $collation = $tradition->collation;
+ my $node = $c->request->param('source_id');
+ my $target = $c->request->param('target_id');
+ my $relation = $c->request->param('rel_type');
+ my $note = $c->request->param('note');
+ my $scope = $c->request->param('scope');
+
+ my $opts = { 'type' => $relation,
+ 'scope' => $scope };
+
+ try {
+ my @vectors = $collation->add_relationship( $node, $target, $opts );
+ my $m = $c->model('Directory');
+ $m->save( $tradition );
+ $c->stash->{'result'} = \@vectors;
+ } catch( Text::Tradition::Error $e ) {
+ $c->response->status( '403' );
+ $c->stash->{'result'} = { 'error' => $e->message };
+ }
+ $c->forward('View::JSON');
+}
+
+=head2 relationships
+
+ GET relation/$textid/relationships
+
+Returns a list of relationships that exist in the specified text. Each
+relationship is returned in a struct that looks like:
+
+{ source: $sid, target: $tid, type: $rel_type, scope: $rel_scope }
+
+=cut
+
+sub relationships :Private {
+ my( $self, $c ) = @_;
+ my $collation = delete $c->stash->{'collation'};
+ # TODO make this API
+ my @pairs = $collation->relationships; # returns the edges
+ my @all_relations;
+ foreach my $p ( @pairs ) {
+ my $relobj = $collation->relations->get_relationship( @$p );
+ push( @all_relations,
+ { source => $p->[0], target => $p->[1],
+ type => $relobj->type, scope => $relobj->scope } );
+ }
+ $c->stash->{'result'} = \@all_relations;
+ $c->forward('View::JSON');
+}
+
+
=head2 end
Attempt to render a view, if needed.
$m->store( $tradition );
}
- $c->stash->{'result'} = $tradition->stemma
- ? $tradition->stemma->as_svg
+ $c->stash->{'result'} = $tradition->stemma_count
+ ? $tradition->stemma(0)->as_svg
: '';
$c->forward('View::SVG');
}
my( $self, $c, $textid ) = @_;
my $m = $c->model('Directory');
my $tradition = $m->tradition( $textid );
- my $stemma = $tradition->stemma;
- # TODO Think about caching the stemma in a session
- $c->stash->{svg} = $stemma->as_svg;
- $c->stash->{text_title} = $tradition->name;
- $c->stash->{template} = 'stexaminer.tt';
- # TODO Run the analysis as AJAX from the loaded page.
- my $t = run_analysis( $tradition );
- $c->stash->{variants} = $t->{'variants'};
- $c->stash->{total} = $t->{'variant_count'};
- $c->stash->{genealogical} = $t->{'genealogical_count'};
- $c->stash->{conflict} = $t->{'conflict_count'};
+ if( $tradition->stemma_count ) {
+ my $stemma = $tradition->stemma(0);
+ # TODO Think about caching the stemma in a session
+ $c->stash->{svg} = $stemma->as_svg;
+ $c->stash->{text_title} = $tradition->name;
+ $c->stash->{template} = 'stexaminer.tt';
+ # TODO Run the analysis as AJAX from the loaded page.
+ my $t = run_analysis( $tradition );
+ $c->stash->{variants} = $t->{'variants'};
+ $c->stash->{total} = $t->{'variant_count'};
+ $c->stash->{genealogical} = $t->{'genealogical_count'};
+ $c->stash->{conflict} = $t->{'conflict_count'};
+ } else {
+ $c->stash->{error} = 'Tradition ' . $tradition->name
+ . 'has no stemma for analysis.';
+ }
}
=head2 end
--- /dev/null
+<style type="text/css" media="screen">
+body {
+ margin: 0;
+ padding: 0 20px;
+ font: 1em "Trebuchet MS", verdana, arial, sans-serif;
+ font-size: 85%;
+ background: #EDF1FA;
+}
+.error {
+ color: red;
+}
+#graph_container {
+ height: 104px;
+ width: 90%;
+ margin-top: 5px;
+ border: 2px solid #B0C6F7;
+}
+#enlargement_container {
+ height: 504px;
+ width: 90%;
+ margin-top: 5px;
+ border: 2px solid #B0C6F7;
+ background: #fff;
+ padding-top: 5px;
+ padding-bottom: 5px;
+}
+#dialog_overlay {
+ display: none;
+ position: absolute;
+ background-image: url("../css/cupertino/images/ui-bg_diagonals-thick_90_eeeeee_40x40.png");
+ background-repeat: repeat;
+ background-attachment: scroll;
+ background-position: 50% 50%;
+ background-color: #EEEEEE;
+ opacity: 0.7;
+ padding-bottom: 5px;
+ padding-top: 5px;
+ border: 2px solid #B0C6F7;
+}
+#update_workspace_button {
+ position: relative;
+ top: -538px;
+ left: 44%;
+ height: 17px;
+ width: 17px;
+ margin-top: 8px;
+ border: 1px solid #B0C6F7;
+ background-image: url('../images/act_arrs.gif');
+ background-position: 0px 0px;
+ background-color: #fcfcfc;
+ z-index: 50;
+}
+#workspace_container {
+ height: 504px;
+ width: 43%;
+ position: relative;
+ top: -545px;
+ left: 47%;
+ margin-top: 10px;
+ border: 2px solid #B0C6F7;
+ background: #fff;
+}
+#graph_underlay {
+ height: 100%;
+ width: 100%;
+ background: #fff;
+ position: relative;
+ z-index: -2;
+}
+#visor {
+ height: 100px;
+ width: 20%;
+ background-color: #61EDAE;
+ opacity: 0.15;
+ position: relative;
+ left: 40%;
+ top: -104px;
+ z-index: -1;
+ border-left: 2px solid #3C73FA;
+ border-right: 2px solid #3C73FA;
+ border-bottom: 2px solid #B0C6F7;
+ border-top: 2px solid #B0C6F7;
+}
+#graph {
+ position: relative; top: -208px;
+ padding: 0px;
+ overflow: auto;
+ /* cursor: -moz-grab !important; */ /* should this be applied with JS? */
+}
+#enlargement {
+ padding: 0px;
+ overflow: hidden;
+}
+#workspace {
+ padding: 0px;
+ overflow: hidden;
+}
+#keymap {
+ position: absolute;
+ left: 80%;
+ top: 100px;
+ border: 2px solid #B0C6F7;
+ background: #fff;
+}
+#keymap ul {
+ padding: 10px;
+ padding-left: 14px;
+ padding-right: 14px;
+ margin: 0px;
+}
+#keymap li {
+ border-left: 16px solid #fff;
+ padding-left: 8px;
+ list-style: none;
+ margin-bottom: 3px;
+}
+</style>
height: 450px;
border: 1px #c6dcf1 solid;
}
+.traditionname {
+ text-decoration: underline;
+}
+.selected {
+ font-style: italic;
+}
#variant_graph {
clear: both;
width: 900px;
height: 400px;
border: 1px #c6dcf1 solid;
overflow: auto;
+ text-align: center;
+}
+#variant_graph img {
+ margin-top: expression(( 400 - this.height ) / 2);
}
#stemma_graph {
float: left;
width: 500px;
height: 450px;
border: 1px #c6dcf1 solid;
+ text-align: center;
+}
+#stemma_graph img {
+ margin-top: expression(( 450 - this.height ) / 2);
}
/* Additional components for the stexaminer */
#variants_table {
function loadTradition( textid ) {
-
+ // First insert the placeholder image
+ var basepath = window.location.pathname
+ if( basepath.lastIndexOf('/') == basepath.length - 1 ) {
+ basepath = basepath.slice( 0, basepath.length - 1)
+ };
+ var imghtml = '<img src="' + basepath + '/images/ajax-loader.gif" alt="Loading SVG..."/>'
+ $('#stemma_graph').empty();
+ $('#variant_graph').empty();
+ $('#stemma_graph').append( imghtml );
+ $('#variant_graph').append( imghtml );
+ // Then get and load the actual content.
// TODO: scale #stemma_grpah both horizontally and vertically
// TODO: load svgs from SVG.Jquery (to make scaling react in Safari)
- $('#stemma_graph').load( "stemma/" + textid , function() {
+ $('#stemma_graph').load( basepath + "/stemma/" + textid , function() {
var stemma_svg_element = $('#stemma_graph svg').svg().svg('get').root();
console.log( stemma_svg_element );
stemma_svg_element.height.baseVal.value = $('#stemma_graph').height();
});
- $('#variant_graph').load( "variantgraph/" + textid , function() {
+ $('#variant_graph').load( basepath + "/variantgraph/" + textid , function() {
var variant_svg_element = $('#variant_graph svg').svg().svg('get').root();
var svg_height = variant_svg_element.height.baseVal.value;
var svg_width = variant_svg_element.width.baseVal.value;
--- /dev/null
+/* Copyright (c) 2009 Brandon Aaron (http://brandonaaron.net)
+ * Dual licensed under the MIT (http://www.opensource.org/licenses/mit-license.php)
+ * and GPL (http://www.opensource.org/licenses/gpl-license.php) licenses.
+ * Thanks to: http://adomas.org/javascript-mouse-wheel/ for some pointers.
+ * Thanks to: Mathias Bank(http://www.mathias-bank.de) for a scope bug fix.
+ *
+ * Version: 3.0.2
+ *
+ * Requires: 1.2.2+
+ */
+(function(c){var a=["DOMMouseScroll","mousewheel"];c.event.special.mousewheel={setup:function(){if(this.addEventListener){for(var d=a.length;d;){this.addEventListener(a[--d],b,false)}}else{this.onmousewheel=b}},teardown:function(){if(this.removeEventListener){for(var d=a.length;d;){this.removeEventListener(a[--d],b,false)}}else{this.onmousewheel=null}}};c.fn.extend({mousewheel:function(d){return d?this.bind("mousewheel",d):this.trigger("mousewheel")},unmousewheel:function(d){return this.unbind("mousewheel",d)}});function b(f){var d=[].slice.call(arguments,1),g=0,e=true;f=c.event.fix(f||window.event);f.type="mousewheel";if(f.wheelDelta){g=f.wheelDelta/120}if(f.detail){g=-f.detail/3}d.unshift(f,g);return c.event.handle.apply(this,d)}})(jQuery);
\ No newline at end of file
+function getRelativePath( action ) {
+ path_elements = window.location.pathname.split('/');
+ if( path_elements[1].length > 0 ) {
+ return window.location.pathname.split('/')[1] + '/' + action;
+ } else {
+ return action;
+ }
+}
+
+function svgLoaded() {
+ // some initial scaling
+ var svg_element = $('#svgbasics').children('svg');
+ var svg_graph = svg_element.svg().svg('get').root();
+ var svg_vbwidth = svg_graph.viewBox.baseVal.width;
+ var svg_vbheight = svg_graph.viewBox.baseVal.height;
+ var scroll_padding = $('#graph_container').width();
+ // (Use attr('width') to set width attr, otherwise style="width: npx;" is set.)
+ var svg_element_width = svg_vbwidth/svg_vbheight * parseInt(svg_element.attr('height'));
+ svg_element_width += scroll_padding;
+ svg_element.attr( 'width', svg_element_width );
+ $('ellipse').attr( {stroke:'black', fill:'#fff'} );
+}
+
+function svgEnlargementLoaded() {
+ // some initial scaling
+ var svg_element = $('#svgenlargement').children('svg');
+ var svg_graph = svg_element.svg().svg('get').root()
+ var svg_vbwidth = svg_graph.viewBox.baseVal.width;
+ var svg_vbheight = svg_graph.viewBox.baseVal.height;
+ var scroll_padding = $('#enlargement_container').width();
+ // (Use attr('width') to set width attr, otherwise style="width: npx;" is set.)
+ var svg_element_width = svg_vbwidth/svg_vbheight * parseInt(svg_element.attr('height'));
+ svg_element_width += scroll_padding;
+ svg_element.attr( 'width', svg_element_width );
+ $('ellipse').attr( {stroke:'black', fill:'#fff'} );
+ var svg_height = parseInt( $('#svgenlargement').height() );
+ scroll_enlargement_ratio = svg_height/svg_vbheight;
+}
+
+function get_ellipse( node_id ) {
+ return $('#svgenlargement .node').children('title').filter( function(index) {
+ return $(this).text() == node_id;
+ }).siblings('ellipse');
+}
+
+function get_node_obj( node_id ) {
+ return get_ellipse( node_id ).data( 'node_obj' );
+}
+
+function get_edge( edge_id ) {
+ return $('#svgenlargement .edge').filter( function(index) {
+ return $(this).children( 'title' ).text() == $('<div/>').html(edge_id).text() ;
+ });
+}
+
+function node_obj(ellipse) {
+ this.ellipse = ellipse;
+ var self = this;
+
+ this.x = 0;
+ this.y = 0;
+ this.dx = 0;
+ this.dy = 0;
+ this.node_elements = node_elements_for(self.ellipse);
+
+ this.get_id = function() {
+ return self.ellipse.siblings('title').text()
+ }
+
+ this.set_draggable = function( draggable ) {
+ if( draggable ) {
+ self.ellipse.attr( {stroke:'black', fill:'#fff'} );
+ self.ellipse.mousedown( this.mousedown_listener );
+ self.ellipse.hover( this.enter_node, this.leave_node );
+ } else {
+ self.ellipse.unbind('mouseenter').unbind('mouseleave').unbind('mousedown');
+ self.ellipse.attr( {stroke:'green', fill:'#b3f36d'} );
+ }
+ }
+
+ this.mousedown_listener = function(evt) {
+ evt.stopPropagation();
+ self.x = evt.clientX;
+ self.y = evt.clientY;
+ $('body').mousemove( self.mousemove_listener );
+ $('body').mouseup( self.mouseup_listener );
+ self.ellipse.unbind('mouseenter').unbind('mouseleave')
+ self.ellipse.attr( 'fill', '#ff66ff' );
+ first_node_g_element = $("#svgenlargement g .node" ).filter( ":first" );
+ if( first_node_g_element.attr('id') !== self.get_g().attr('id') ) { self.get_g().insertBefore( first_node_g_element ) };
+ }
+
+ this.mousemove_listener = function(evt) {
+ self.dx = (evt.clientX - self.x) / mousemove_enlargement_ratio;
+ self.dy = (evt.clientY - self.y) / mousemove_enlargement_ratio;
+ self.move_elements();
+ }
+
+ this.mouseup_listener = function(evt) {
+ if( $('ellipse[fill="#ffccff"]').size() > 0 ) {
+ var source_node_id = self.ellipse.siblings('title').text();
+ var target_node_id = $('ellipse[fill="#ffccff"]').siblings("title").text();
+ $('#source_node_id').val( source_node_id );
+ $('#target_node_id').val( target_node_id );
+ $('#dialog-form').dialog( 'open' );
+ };
+ $('body').unbind('mousemove');
+ $('body').unbind('mouseup');
+ self.ellipse.attr( 'fill', '#fff' );
+ self.ellipse.hover( self.enter_node, self.leave_node );
+ self.reset_elements();
+ }
+
+ this.cpos = function() {
+ return { x: self.ellipse.attr('cx'), y: self.ellipse.attr('cy') };
+ }
+
+ this.get_g = function() {
+ return self.ellipse.parent('g');
+ }
+
+ this.enter_node = function(evt) {
+ self.ellipse.attr( 'fill', '#ffccff' );
+ }
+
+ this.leave_node = function(evt) {
+ self.ellipse.attr( 'fill', '#fff' );
+ }
+
+ this.greyout_edges = function() {
+ $.each( self.node_elements, function(index, value) {
+ value.grey_out('.edge');
+ });
+ }
+
+ this.ungreyout_edges = function() {
+ $.each( self.node_elements, function(index, value) {
+ value.un_grey_out('.edge');
+ });
+ }
+
+ this.move_elements = function() {
+ $.each( self.node_elements, function(index, value) {
+ value.move(self.dx,self.dy);
+ });
+ }
+
+ this.reset_elements = function() {
+ $.each( self.node_elements, function(index, value) {
+ value.reset();
+ });
+ }
+
+ this.update_elements = function() {
+ self.node_elements = node_elements_for(self.ellipse);
+ }
+
+ self.set_draggable( true );
+}
+
+function svgshape( shape_element ) {
+ this.shape = shape_element;
+ this.move = function(dx,dy) {
+ this.shape.attr( "transform", "translate(" + dx + " " + dy + ")" );
+ }
+ this.reset = function() {
+ this.shape.attr( "transform", "translate( 0, 0 )" );
+ }
+ this.grey_out = function(filter) {
+ if( this.shape.parent(filter).size() != 0 ) {
+ this.shape.attr({'stroke':'#e5e5e5', 'fill':'#e5e5e5'});
+ }
+ }
+ this.un_grey_out = function(filter) {
+ if( this.shape.parent(filter).size() != 0 ) {
+ this.shape.attr({'stroke':'#000000', 'fill':'#000000'});
+ }
+ }
+}
+
+function svgpath( path_element, svg_element ) {
+ this.svg_element = svg_element;
+ this.path = path_element;
+ this.x = this.path.x;
+ this.y = this.path.y;
+ this.move = function(dx,dy) {
+ this.path.x = this.x + dx;
+ this.path.y = this.y + dy;
+ }
+ this.reset = function() {
+ this.path.x = this.x;
+ this.path.y = this.y;
+ }
+ this.grey_out = function(filter) {
+ if( this.svg_element.parent(filter).size() != 0 ) {
+ this.svg_element.attr('stroke', '#e5e5e5');
+ this.svg_element.siblings('text').attr('fill', '#e5e5e5');
+ }
+ }
+ this.un_grey_out = function(filter) {
+ if( this.svg_element.parent(filter).size() != 0 ) {
+ this.svg_element.attr('stroke', '#000000');
+ this.svg_element.siblings('text').attr('fill', '#000000');
+ }
+ }
+}
+
+function node_elements_for( ellipse ) {
+ node_elements = get_edge_elements_for( ellipse );
+ node_elements.push( new svgshape( ellipse.siblings('text') ) );
+ node_elements.push( new svgshape( ellipse ) );
+ return node_elements;
+}
+
+function get_edge_elements_for( ellipse ) {
+ edge_elements = new Array();
+ node_id = ellipse.siblings('title').text();
+ edge_in_pattern = new RegExp( node_id + '$' );
+ edge_out_pattern = new RegExp( '^' + node_id );
+ $.each( $('#svgenlargement .edge,#svgenlargement .relation').children('title'), function(index) {
+ title = $(this).text();
+ if( edge_in_pattern.test(title) ) {
+ polygon = $(this).siblings('polygon');
+ if( polygon.size() > 0 ) {
+ edge_elements.push( new svgshape( polygon ) );
+ }
+ path_segments = $(this).siblings('path')[0].pathSegList;
+ edge_elements.push( new svgpath( path_segments.getItem(path_segments.numberOfItems - 1), $(this).siblings('path') ) );
+ }
+ if( edge_out_pattern.test(title) ) {
+ path_segments = $(this).siblings('path')[0].pathSegList;
+ edge_elements.push( new svgpath( path_segments.getItem(0), $(this).siblings('path') ) );
+ }
+ });
+ return edge_elements;
+}
+
+function relation_factory() {
+ var self = this;
+ this.color_memo = null;
+ //TODO: colors hard coded for now
+ this.temp_color = '#FFA14F';
+ this.relation_colors = [ "#5CCCCC", "#67E667", "#F9FE72", "#6B90D4", "#FF7673", "#E467B3", "#AA67D5", "#8370D8", "#FFC173" ];
+
+ this.create_temporary = function( source_node_id, target_node_id ) {
+ var relation = $('#svgenlargement .relation').filter( function(index) {
+ var relation_id = $(this).children('title').text();
+ if( ( relation_id == ( source_node_id + '->' + target_node_id ) ) || ( relation_id == ( target_node_id + '->' + source_node_id ) ) ) {
+ return true;
+ }
+ } );
+ if( relation.size() == 0 ) {
+ draw_relation( source_node_id, target_node_id, self.temp_color );
+ } else {
+ self.color_memo = relation.children('path').attr( 'stroke' );
+ relation.children('path').attr( 'stroke', self.temp_color );
+ }
+ }
+ this.remove_temporary = function() {
+ var path_element = $('#svgenlargement .relation').children('path[stroke="' + self.temp_color + '"]');
+ if( self.color_memo != null ) {
+ path_element.attr( 'stroke', self.color_memo );
+ self.color_memo = null;
+ } else {
+ path_element.parent('g').remove();
+ }
+ }
+ this.create = function( source_node_id, target_node_id, color_index ) {
+ //TODO: Protect from (color_)index out of bound..
+ var relation_color = self.relation_colors[ color_index ];
+ draw_relation( source_node_id, target_node_id, relation_color );
+ get_node_obj( source_node_id ).update_elements();
+ get_node_obj( target_node_id ).update_elements();
+ }
+ this.remove = function( source_node_id, target_id ) {
+ //TODO (When needed)
+ console.log( "Unsupported function node_obj.remove()." );
+ }
+}
+
+function draw_relation( source_id, target_id, relation_color ) {
+ var source_ellipse = get_ellipse( source_id );
+ var target_ellipse = get_ellipse( target_id );
+ var svg = $('#svgenlargement').children('svg').svg().svg('get');
+ var path = svg.createPath();
+ var sx = parseInt( source_ellipse.attr('cx') );
+ var rx = parseInt( source_ellipse.attr('rx') );
+ var sy = parseInt( source_ellipse.attr('cy') );
+ var ex = parseInt( target_ellipse.attr('cx') );
+ var ey = parseInt( target_ellipse.attr('cy') );
+ var relation = svg.group( $("#svgenlargement svg g"), {'class':'relation'} );
+ svg.title( relation, source_id + '->' + target_id );
+ svg.path( relation, path.move( sx, sy ).curveC( sx + (2*rx), sy, ex + (2*rx), ey, ex, ey ), {fill: 'none', stroke: relation_color, strokeWidth: 4});
+ var relation_element = $('#svgenlargement .relation').filter( ':last' );
+ relation_element.insertBefore( $('#svgenlargement g g').filter(':first') );
+}
+
+$(document).ready(function () {
+
+ relation_manager = new relation_factory();
+
+ scroll_ratio = $('#enlargement').height() / $('#graph').height();
+
+ $('#graph').mousedown(function (event) {
+ $(this)
+ .data('down', true)
+ .data('x', event.clientX)
+ .data('scrollLeft', this.scrollLeft);
+ return false;
+ }).mouseup(function (event) {
+ $(this).data('down', false);
+ }).mousemove(function (event) {
+ if ($(this).data('down') == true ) {
+ if ( $('#update_workspace_button').data('locked') != true ) {
+ var scroll_left = $(this).data('scrollLeft') + $(this).data('x') - event.clientX;
+ this.scrollLeft = scroll_left;
+ var enlarged_scroll_left = scroll_left * scroll_ratio;
+ $('#enlargement').scrollLeft( enlarged_scroll_left );
+ color_enlarged();
+ }
+ }
+ }).mousewheel(function (event, delta) {
+ if ( $('#update_workspace_button').data('locked') != true ) {
+ var scroll_left = delta * 30;
+ this.scrollLeft -= scroll_left;
+ var enlarged_scroll_left = $('#enlargement').scrollLeft();
+ enlarged_scroll_left -= (scroll_left * scroll_ratio);
+ $('#enlargement').scrollLeft( enlarged_scroll_left );
+ color_enlarged();
+ }
+ }).css({
+ 'overflow' : 'hidden',
+ 'cursor' : '-moz-grab'
+ });
+
+
+ $( "#dialog-form" ).dialog({
+ autoOpen: false,
+ height: 270,
+ width: 290,
+ modal: true,
+ buttons: {
+ "Ok": function() {
+ $('#status').empty();
+ form_values = $('#collapse_node_form').serialize()
+ ncpath = window.location.pathname + '/relationship';
+ var jqjson = $.post( ncpath, form_values, function(data) {
+ $.each( data, function(item, source_target) {
+ relation_manager.create( source_target[0], source_target[1], $('#rel_type').attr('selectedIndex') );
+ });
+ relation_manager.remove_temporary();
+ $( "#dialog-form" ).dialog( "close" );
+ }, 'json');
+ },
+ Cancel: function() {
+ relation_manager.remove_temporary();
+ $( this ).dialog( "close" );
+ }
+ },
+ create: function(event, ui) {
+ $(this).data( 'relation_drawn', false );
+ //TODO? Err handling?
+ var jqjson = $.getJSON( 'relationship_definition', function(data) {
+ var types = data.types.sort();
+ $.each( types, function(index, value) {
+ $('#rel_type').append( $('<option>').attr( "value", value ).text(value) );
+ $('#keymaplist').append( $('<li>').css( "border-color", relation_manager.relation_colors[index] ).text(value) );
+ });
+ var scopes = data.scopes;
+ $.each( scopes, function(index, value) {
+ $('#scope').append( $('<option>').attr( "value", value ).text(value) );
+ });
+ });
+ },
+ open: function() {
+ relation_manager.create_temporary( $('#source_node_id').val(), $('#target_node_id').val() );
+ $(".ui-widget-overlay").css("background", "none");
+ $("#dialog_overlay").show();
+ $("#dialog_overlay").height( $("#enlargement_container").height() );
+ $("#dialog_overlay").width( $("#enlargement_container").width() );
+ $("#dialog_overlay").offset( $("#enlargement_container").offset() );
+ },
+ close: function() {
+ $( '#status' ).empty();
+ $("#dialog_overlay").hide();
+ }
+ }).ajaxError( function(event, jqXHR, ajaxSettings, thrownError) {
+ if( ( ajaxSettings.url.split("?")[0] == 'set_relationship' ) && jqXHR.status == 403 ) {
+ $('#status').append( '<p class="error">The relationship can not be made in this way between these nodes.</p>' );
+ }
+ } );
+
+ $('#update_workspace_button').click( function() {
+ var svg_enlargement = $('#svgenlargement').svg().svg('get').root();
+ if( $(this).data('locked')==true) {
+ $.each( ellipses_in_magnifier, function( index, ellipse ) {
+ ellipse.data( 'node_obj' ).ungreyout_edges();
+ ellipse.data( 'node_obj' ).set_draggable( false );
+ ellipse.data( 'node_obj', null );
+ })
+ svg_enlargement.children[0].setAttribute( 'transform', $(this).data('transform_memo') );
+ $('#enlargement').scrollLeft( $(this).data('scrollleft_memo') );
+ $(this).data('locked', false);
+ $(this).css('background-position', '0px 0px');
+ } else {
+ $(this).css('background-position', '0px 17px');
+ var y_min = parseInt( ellipses_in_magnifier[0].attr('cy') ) - parseInt( ellipses_in_magnifier[0].attr('ry') );
+ var y_max = parseInt( ellipses_in_magnifier[0].attr('cy') ) + parseInt( ellipses_in_magnifier[0].attr('ry') );
+ $.each( ellipses_in_magnifier, function( index, ellipse ) {
+ var ny_min = parseInt( ellipse.attr('cy') ) - parseInt( ellipse.attr('ry') );
+ var ny_max = parseInt( ellipse.attr('cy') ) + parseInt( ellipse.attr('ry') );
+ if( ny_min < y_min ) { y_min = ny_min };
+ if( ny_max > y_max ) { y_max = ny_max };
+ if( ellipse.data( 'node_obj' ) == null ) {
+ ellipse.data( 'node_obj', new node_obj( ellipse ) );
+ } else {
+ ellipse.data( 'node_obj' ).set_draggable( true );
+ }
+ ellipse.data( 'node_obj' ).greyout_edges();
+ })
+ var graph_frag_height = y_max - y_min ;
+ var svg_enlargement_vbheight = svg_enlargement.viewBox.baseVal.height;
+ var svg_enlargement_vbwidth = svg_enlargement.viewBox.baseVal.width;
+ var scale = svg_enlargement_vbheight / graph_frag_height;
+ mousemove_enlargement_ratio = scroll_enlargement_ratio * scale;
+ var scroll_padding = $('#enlargement_container').width();
+ var scroll_scale = svg_enlargement_vbwidth / ( parseFloat( $('#svgenlargement svg').attr('width') ) - scroll_padding );
+ var vbx_of_scroll = ( $('#enlargement').scrollLeft() ) * scroll_scale;
+ var translate_x = vbx_of_scroll;
+ var transform = svg_enlargement.children[0].getAttribute('transform');
+ $(this).data('transform_memo', transform );
+ $(this).data('scrollleft_memo', $('#enlargement').scrollLeft() );
+ $(this).data('locked', true );
+ $('#enlargement').scrollLeft(0);
+ transform = 'scale(' + scale + ') translate(' + (-1 * translate_x) + ',' + (-1 * y_min) + ')';
+ svg_enlargement.children[0].setAttribute( 'transform', transform );
+ }
+ });
+
+});
+
+$(window).mouseout(function (event) {
+ if ($('#graph').data('down')) {
+ try {
+ if (event.originalTarget.nodeName == 'BODY' || event.originalTarget.nodeName == 'HTML') {
+ $('#graph').data('down', false);
+ }
+ } catch (e) {}
+ }
+});
+
+function color_enlarged() {
+ ellipses_in_magnifier = [];
+ var scroll_offset = parseInt( $('#enlargement').scrollLeft() );
+ var scroll_padding = $('#enlargement_container').width()/2;
+ $('#svgenlargement ellipse,#svgbasics ellipse' ).each( function( index ) {
+ var cpos_inscrollcoor = parseInt( $(this).attr('cx') ) * scroll_enlargement_ratio;
+ if ( ( cpos_inscrollcoor > (scroll_offset - scroll_padding) ) && ( cpos_inscrollcoor < ( scroll_offset + scroll_padding ) ) ) {
+ $(this).attr( {stroke:'green', fill:'#b3f36d'} );
+ if( $(this).parents('#svgenlargement').size() == 1 ) { ellipses_in_magnifier.push( $(this) ) };
+ } else {
+ $(this).attr( {stroke:'black', fill:'#fff'} );
+ }
+ });
+}
+
+
+
+
<ul>
[% SET i = 0 -%]
[% FOREACH t IN texts -%]
- <li><span class="traditionname" onClick="loadTradition('[% t.id %]')">[% t.name %]</span></li>
+ <li><span class="traditionname" onClick="$('.traditionname').removeClass('selected');$(this).addClass('selected');loadTradition('[% t.id %]')">[% t.name %]</span></li>
[% i = i + 1 -%]
[% END -%]
</table>
<META http-equiv="Content-Type" content="text/html; charset=utf-8">
<link type="text/css" href="[% c.uri_for('/css/cupertino/jquery-ui-1.8.13.custom.css') %]" rel="stylesheet" />
<link type="text/css" href="[% c.uri_for('/css/style.css') %]" rel="stylesheet" />
- <script type="text/javascript" src="/js/jquery-1.4.4.min.js"></script>
- <script type="text/javascript" src="/js/jquery-ui-1.8.10.custom.min.js"></script>
- <script type="text/javascript" src="/js/jquery.svg.js"></script>
- <script type="text/javascript" src="/js/jquery.svgdom.js"></script>
+ <script type="text/javascript" src="[% c.uri_for('/js/jquery-1.4.4.min.js') %]"></script>
+ <script type="text/javascript" src="[% c.uri_for('/js/jquery-ui-1.8.10.custom.min.js') %]"></script>
+ <script type="text/javascript" src="[% c.uri_for('/js/jquery.mousewheel.min.js') %]"></script>
+ <script type="text/javascript" src="[% c.uri_for('/js/jquery.svg.js') %]"></script>
+ <script type="text/javascript" src="[% c.uri_for('/js/jquery.svgdom.js') %]"></script>
<script type="text/javascript" src="[% applicationjs %]"></script>
[% content %]
<title>[% pagetitle %]</title>
[% WRAPPER header.tt
pagetitle = "Stemmaweb - Text tradition tools"
- applicationjs = "js/componentload.js"
+ applicationjs = c.uri_for( 'js/componentload.js' )
%]
<script type="text/javascript">
$(document).ready(function() {
+[% WRAPPER header.tt
+ pagetitle = "Stemmaweb - Relationship mapper"
+ applicationjs = "../js/relationship.js"
+%]
+<script type="text/javascript">
+$(function() {
+ $('#svgbasics').svg({loadURL: '[% svg_string %]', onLoad: svgLoaded});
+ $('#svgenlargement').svg({loadURL: '[% svg_string %]', onLoad: svgEnlargementLoaded});
+});
+</script>
+<link type="text/css" href="[% c.uri_for('/css/relationship.css') %]" rel="stylesheet" />
+[% END %]
+
+ <div id="graph_container">
+ <div id="graph_underlay"></div>
+ <div id="visor"></div>
+ <div id="graph">
+ <!-- width seems to need to be as wide as the graph -->
+ <!-- a translation of -487 in the svg itself was needed to adjust the graph to the left of the div -->
+ <!-- unclear how to cope with height that doesn't fit box -->
+ <div id="svgbasics" style="height: 100px;"></div>
+ </div>
+ </div>
+
+ <div id="enlargement_container">
+ <div id="enlargement">
+ <div id="svgenlargement" style="height: 500px;"></div>
+ </div>
+ </div>
+
+ <div id="update_workspace_button"></div>
+
+ <div id="dialog-form" title="Create relation between two nodes..">
+ <form id="collapse_node_form">
+ <fieldset>
+ <input type="hidden" name="source_id" id="source_node_id"/>
+ <input type="hidden" name="target_id" id="target_node_id"/>
+ <label for="rel_type">Relation type.. </label>
+ <select name="rel_type" id="rel_type" class=".ui-widget select">
+ </select>
+ <br/><br/>
+ <label for="scope">Scope of relation.. </label>
+ <select name="scope" id="scope" class=".ui-widget select">
+ </select>
+ <br/><br/>
+ <label for="note">Annotation on note.. </label>
+ <input type="text" width="60" name="note" id="note" class=".ui-widget input" />
+ </fieldset>
+ <div id="status"></div>
+ </form>
+ </div>
+ <div id="dialog_overlay"></div>
+
+ <div id="keymap">
+ <ul id="keymaplist">
+ </ul>
+ </div>
+
+[% PROCESS footer.tt %]
\ No newline at end of file
plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
-all_pod_coverage_ok();
+my %mods;
+map { $mods{$_} = 1 } all_modules();
+if( -e 'MANIFEST.SKIP' ) {
+ open( SKIP, 'MANIFEST.SKIP' ) or die "Could not open skip file";
+ while(<SKIP>) {
+ chomp;
+ next unless /^lib/;
+ s/^lib\///;
+ s/\.pm//;
+ s/\//::/g;
+ delete $mods{$_};
+ }
+ close SKIP;
+}
+
+foreach my $mod ( keys %mods ) {
+ pod_coverage_ok( $mod, { also_private => [ qw/ BUILD throw / ] } );
+}
+
+done_testing();
\ No newline at end of file
is( scalar @svg_edges, 32, "Correct number of edges in the graph" );
# Test svg creation for a subgraph
-my $part_svg = $parser->parse_string( $collation->svg_subgraph( 15 ) ); # start, no end
+my $part_svg = $parser->parse_string( $collation->as_svg( { from => 15 } ) ); # start, no end
is( $part_svg->documentElement->nodeName(), 'svg', "Got an svg subgraph to end" );
my $part_xpc = XML::LibXML::XPathContext->new( $part_svg->documentElement() );
$part_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' );
print OUT $part_svg->toString();
close OUT;
-$part_svg = $parser->parse_string( $collation->svg_subgraph( 10, 13 ) ); # start, no end
+$part_svg = $parser->parse_string( $collation->as_svg( { from => 10, to => 13 } ) ); # start, no end
is( $part_svg->documentElement->nodeName(), 'svg', "Got an svg subgraph in the middle" );
$part_xpc = XML::LibXML::XPathContext->new( $part_svg->documentElement() );
$part_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' );
"Correct number of edges in the subgraph" );
-$part_svg = $parser->parse_string( $collation->svg_subgraph( 0, 5 ) ); # start, no end
+$part_svg = $parser->parse_string( $collation->as_svg( { to => 5 } ) ); # start, no end
is( $part_svg->documentElement->nodeName(), 'svg', "Got an svg subgraph from start" );
$part_xpc = XML::LibXML::XPathContext->new( $part_svg->documentElement() );
$part_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' );
use Test::More;
use lib 'lib';
use Text::Tradition;
-use Text::Tradition::StemmaUtil qw/ make_character_matrix /;
+use Text::Tradition::StemmaUtil;
use XML::LibXML;
use XML::LibXML::XPathContext;
is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" );
# Test for character matrix creation
-my $m = make_character_matrix( $c->make_alignment_table() );
+my $m = Text::Tradition::StemmaUtil::_make_character_matrix( $c->make_alignment_table() );
## check number of rows
is( scalar @$m, 3, "Found three witnesses in char matrix" );
## check number of columns
'file' => 't/data/simple.txt',
);
+is( $t->stemma_count, 0, "No stemmas added yet" );
my $s;
ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
-is( $t->stemma, $s, "Stemma is the right one" );
+is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
+is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
}
my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
ok( $d->save( $t ), "Updated tradition with stemma" );
is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
- is( $d->tradition( $uuid )->stemma, $s, "...and it has the correct stemma" );
+ is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
try {
$d->save( $s );
} catch( Text::Tradition::Error $e ) {
is( scalar $f->tradition_ids, 2, "Directory index has both traditions" );
my $tf = $f->tradition( $uuid );
is( $tf->name, $t->name, "Retrieved the tradition from a new directory" );
- my $sid = $f->object_to_id( $tf->stemma );
+ my $sid = $f->object_to_id( $tf->stemma(0) );
try {
$f->tradition( $sid );
} catch( Text::Tradition::Error $e ) {
projects / scpubgit/stemmatology.git / commitdiff
