#!/usr/bin/env perl

use strict;
use warnings;
use lib 'lib';
use feature 'say';
use Test::More;
use Text::Tradition;
use Text::Tradition::Analysis qw/ run_analysis /;

binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';
eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };

my $tradition = Text::Tradition->new(
	'input' => 'Self',
	'file' => 't/data/besoin.xml' );
$tradition->add_stemma( 'dotfile' => 't/data/besoin.dot' );

# Run the analysis of the tradition

my %expected = (
    2 => 'type1',
    3 => 'genealogical',
    28 => 'genealogical',
    39 => 'genealogical',
    62 => 'type1',
    63 => 'type1',
    73 => 'reverted',
    76 => 'genealogical',
    91 => 'conflict',
    93 => 'genealogical',
    94 => 'genealogical',
    99 => 'reverted',
    110 => 'type1',
    117 => 'type1',
    136 => 'reverted',
    142 => 'conflict',
    155 => 'genealogical',
    170 => 'genealogical',
    182 => 'type1',
    205 => 'genealogical',
    219 => 'genealogical',
    239 => 'genealogical',
    244 => 'genealogical',
    245 => 'type1',
    251 => 'genealogical',
    252 => 'genealogical',
    293 => 'genealogical',
    295 => 'genealogical',
    309 => 'genealogical',
    310 => 'type1',
    314 => 'type1',
    315 => 'type1',
    317 => 'reverted',
    318 => 'genealogical',
    319 => 'genealogical',
    324 => 'type1',
    328 => 'reverted',
    334 => 'type1',
    335 => 'genealogical',
    350 => 'reverted',
    361 => 'reverted',
    367 => 'type1',
    370 => 'type1',
    382 => 'reverted',
    385 => 'reverted',
    406 => 'genealogical',
    413 => 'genealogical',
    417 => 'type1',
    418 => 'reverted',
    459 => 'type1',
    493 => 'genealogical',
    497 => 'reverted',
    499 => 'type1',
    500 => 'reverted',
    515 => 'reverted',
    556 => 'type1',
    558 => 'conflict',
    597 => 'type1',
    615 => 'type1',
    617 => 'type1',
    632 => 'genealogical',
    634 => 'genealogical',
    636 => 'genealogical',
    685 => 'genealogical',
    737 => 'genealogical',
    742 => 'reverted',
    743 => 'reverted',
    744 => 'reverted',
    745 => 'type1',
    746 => 'type1',
    747 => 'type1',
    757 => 'type1',
    762 => 'type1',
    763 => 'type1',
    777 => 'reverted',
    780 => 'genealogical',
    802 => 'type1',
    803 => 'type1',
    815 => 'type1',
    837 => 'genealogical',
    854 => 'type1',
    855 => 'type1',
    856 => 'type1',
    857 => 'type1',
    858 => 'type1',
    859 => 'type1',
    860 => 'type1',
    861 => 'type1',
    862 => 'type1',
    863 => 'type1',
    864 => 'type1',
    865 => 'type1',
    866 => 'type1',
    867 => 'type1',
    868 => 'type1',
    869 => 'type1',
    870 => 'type1',
    871 => 'type1',
    872 => 'type1',
    873 => 'type1',
    874 => 'type1',
    875 => 'type1',
    876 => 'type1',
    877 => 'type1',
    878 => 'type1',
    879 => 'type1',
    880 => 'type1',
    881 => 'type1',
    882 => 'type1',
    883 => 'type1',
    884 => 'type1',
    885 => 'type1',
    886 => 'type1',
    887 => 'type1',
    888 => 'type1',
    889 => 'type1',
    890 => 'type1',
    891 => 'type1',
    892 => 'type1',
    893 => 'type1',
    894 => 'type1',
    895 => 'type1',
    896 => 'type1',
    897 => 'conflict',
    898 => 'conflict',
    899 => 'type1',
    900 => 'type1',
    901 => 'type1',
    902 => 'type1',
    903 => 'type1',
    904 => 'type1',
    905 => 'type1',
    906 => 'type1',
    907 => 'type1',
    915 => 'type1',
    916 => 'type1',
    925 => 'genealogical',
    927 => 'type1',
    952 => 'genealogical',
    954 => 'genealogical',
    969 => 'genealogical',
    972 => 'genealogical',
    973 => 'genealogical',
    974 => 'type1',
    1003 => 'genealogical',
    1004 => 'genealogical' # check for transp
);

my %num_readings;

my @all_variant_ranks = sort { $a <=> $b } keys( %expected );
# Look through the results
my $c = $tradition->collation;
my %analysis_opts;
my $results = run_analysis( $tradition, %analysis_opts );
my @analyzed;
foreach my $row ( @{$results->{'variants'}} ) {
	push( @analyzed, $row->{id} );
	$num_readings{$row->{id}} = scalar @{$row->{'readings'}};
	my $type = 'genealogical';
	if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
		$type = 'conflict';
	} elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
		$type = 'reverted';
	}
	my $expected = $expected{$row->{'id'}};
	$expected = 'genealogical' if $expected eq 'type1';
	is( $type, $expected, "Got expected genealogical result for rank " . $row->{'id'} );
	# If the row is genealogical, there should be one reading with no parents,
	# every reading should independently occur exactly once, and the total
	# number of changes + maybe-changes should equal the total number of
	# readings who have that one as a parent.
	ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
	next if exists $row->{'unsolved'};
	if( $row->{'genealogical'} ) {
		# Make the mapping of parent -> child readings
		my %is_parent;
		my @has_no_parent;
		foreach my $rdg ( @{$row->{'readings'}} ) {
			my $parents = $rdg->{'source_parents'} || {};
			foreach my $p ( keys %$parents ) {
				push( @{$is_parent{$p}}, $rdg->{'readingid'} );
			}
			push( @has_no_parent, $rdg->{'readingid'} ) unless keys %$parents;
		}
		# Test some stuff
		foreach my $rdg ( @{$row->{'readings'}} ) {
			is( @{$rdg->{'independent_occurrence'}}, 1, 
				"Genealogical reading originates exactly once" );
		}
		is( @has_no_parent, 1, "Only one genealogical reading lacks a parent" );
	}
}
# Check that run_analysis ran an analysis on all our known variant ranks
is_deeply( \@all_variant_ranks, \@analyzed, "Ran analysis for all expected rows" );

# Now run it again, excluding type 1 variants.
map { delete $expected{$_} if $expected{$_} eq 'type1' } keys %expected;
my @useful_variant_ranks = sort { $a <=> $b } keys( %expected );
$analysis_opts{'exclude_type1'} = 1;
@analyzed = ();
$results = run_analysis( $tradition, %analysis_opts );
foreach my $row ( @{$results->{'variants'}} ) {
	ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
	next if exists $row->{'unsolved'};
	push( @analyzed, $row->{id} );
	my $type = 'genealogical';
	if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
		$type = 'conflict';
	} elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
		$type = 'reverted';
	}
	is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on exclude_type1 run for rank " . $row->{'id'} );
}
is_deeply( \@analyzed, \@useful_variant_ranks, "Ran analysis for all useful rows" );

# Now run it again, excluding orthography / spelling.
my @merged_exclude = qw/ 76 136 142 155 293 317 319 335 350 361 413 500 515 636 685 
	737 954 1003 /;
# 205 now conflicts; it and 493 should also have one fewer reading
$expected{205} = 'conflict';
$num_readings{205}--;
$num_readings{493}--;
map { delete $expected{$_} } @merged_exclude;
my @merged_remaining = sort { $a <=> $b } keys( %expected );
$analysis_opts{'merge_types'} = [ qw/ orthographic spelling / ];
@analyzed = ();
$results = run_analysis( $tradition, %analysis_opts );
foreach my $row ( @{$results->{'variants'}} ) {
	push( @analyzed, $row->{id} );
	ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
	next if exists $row->{'unsolved'};
	my $type = 'genealogical';
	if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
		$type = 'conflict';
	} elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
		$type = 'reverted';
	}
	is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on merge_types run for rank " . $row->{'id'} );
	is( scalar @{$row->{'readings'}}, $num_readings{$row->{id}}, "Got expected number of readings during merge" );
}
is_deeply( \@analyzed, \@merged_remaining, "Ran analysis for all useful unmerged rows" );

done_testing();
