#!/usr/bin/perl -w
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2002,2010,2014 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://bbbike.de
#

# Match a bbd file against other bbd files.

# XXX The implementation is not optimal. Some work on the fuzziness is
# needed.

use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib", "$FindBin::RealBin/../data");
use Strassen::Core;
use Strassen::MultiStrassen;
use Strassen::StrassenNetz;
use Strassen::Util;
use strict;
use Getopt::Long;
use BBBikeXS;

use vars qw($ax $ay $bx $by $cx $cy); # global because of glob manipulations, see below

# REPO BEGIN
# REPO NAME pi /home/e/eserte/src/repository 
# REPO MD5 bb2103b1f2f6d4c047c4f6f5b3fa77cd
sub pi ()   { 4 * atan2(1, 1) } # 3.141592653
# REPO END

my $incat_rx  = "^GPSs\$"; # XXX allow array?
my $outcat = "#0000c0";
my $fuzzydist = 50;
my $v = 0;
my $optimize = "auto";
my @gpsfile;
my $gridwidth;
my $do_autoconnect;

if (!GetOptions("incatrx=s" => \$incat_rx,
		"outcat=s" => \$outcat,
		"fuzzydist=i" => \$fuzzydist,
		"optimize=s" => \$optimize,
		"gridwidth=i" => \$gridwidth,
		"v+" => \$v,
		"gpsfile=s@" => \@gpsfile,
		"autoconnect" => \$do_autoconnect,
	       )) {
    usage();
}
$|=1;
my %seen;

$incat_rx = qr/$incat_rx/;

if (!is_interactive()) {
    $v = 0;
}

Strassen::set_verbose($v);
if ($v && $v > 1) {
    require Data::Dumper;
}

if (!@ARGV) {
    usage();
}
unshift @gpsfile, shift;

my @files = @ARGV;
if (!@files) {
    die "bbd files to match @gpsfile against?";
}

if (grep { /data_corrected/ } @files) {
    $Strassen::Util::cacheprefix = $Strassen::Util::cacheprefix
	= "b_de_corrected";
}

my $s1 = MultiStrassen->new(map { Strassen->new($_, UseLocalDirectives => 1, PreserveTime => 1) } @gpsfile);
my $s2 = MultiStrassen->new(@files);

if (!$gridwidth) {
    $gridwidth = 1000; # small, lowmem
    if ($optimize eq 'large' ||
	($optimize eq 'auto' && -s $gpsfile[0] > 100000)) {
	$gridwidth = 100;
    } elsif ($optimize eq 'medium') {
	$gridwidth = 500;
    }
}

if ($v) {
    warn "Match @gpsfile against @files...\n";
}

# Creates a huge grid and is slow, but the matching afterwards is faster
# XXX Problems in my algorithm: with small values like 100 the algorithm
# seems to miss some streets...
warn "Creating grid with width=$gridwidth ...\n" if $v;
@Strassen::Util::cacheable = qw(Storable CDB_File); # Storable is
                                                    # faster, but
                                                    # memory consuming!
$s2->make_grid(UseCache => 1,
	       GridWidth => $gridwidth,
	       Exact => 1);

my $autoconnect_net;
if ($do_autoconnect) {
    require Strassen::SimpleSearch;
    $autoconnect_net = StrassenNetz->new($s2);
    $autoconnect_net->make_net(UseCache => 0);
}

my $iter = 0;
$s1->init;
my $tp = eval {
    die "Not interactive" if !$v;
    require Time::Progress;
    my $tp = Time::Progress->new;
    $tp->attr(min => 0, max => scalar @{$s1->{Data}},
	      format => "\rdone %p ETA %f %30b",
	     );
    $tp->restart;
    $tp;
};
    
my $out_s = Strassen->new;
while(1) {
    if ($tp) {
	print STDERR $tp->report(undef, $iter++);
    } else {
	printf STDERR " %d%% (%d/%d)   \r", ($iter / @{$s1->{Data}})*100, $iter++, scalar @{$s1->{Data}} if $v;
    }
    my $r = $s1->next;
    my $coords = $r->[Strassen::COORDS];
    last if !@$coords;
    next unless $r->[Strassen::CAT] =~ /$incat_rx/;
    my $directives = $s1->get_directives;
    my $last_nearest_point;
    my @out_recs;
 COORDS_LOOP:
    #for(my $i = 0; $i < $#{ $coords }; $i++) {
    for my $i (0 .. $#{ $coords }-1) {
	my $near;
	if (!defined $last_nearest_point) {
	    $near = $s2->nearest_point($coords->[$i], FullReturn => 1, AllReturn => 1);
	} else {
	    $near = $last_nearest_point;
	}
	undef $last_nearest_point;
	if ($near && $near->[0]{Dist} < $fuzzydist) {
	    my $near2 = $s2->nearest_point($coords->[$i+1], FullReturn => 1, AllReturn => 1);
	    if (defined $near2) {
		$last_nearest_point = $near2;
	    }
	    if ($v > 1) {
		print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([$near,$near2],[])->Indent(1)->Useqq(1)->Dump;
	    }
	    if ($near2 && $near2->[0]{Dist} < $fuzzydist) {
		my @a = map { $_->{N} } @$near;
		my @b = map { $_->{N} } @$near2;
		my $inx = _match_sets(\@a, \@b);
		next COORDS_LOOP if (!defined $inx);

		# get best coordinate pair
		my $best_near = $near->[$inx];
		($ax,$ay,$bx,$by) = @{$best_near->{Coords}};
		if (!defined $bx || !defined $by) { # may happen for places
		    ($bx,$by) = ($ax,$ay);
		}
		($cx,$cy) = (undef, undef);
		my $do_neighbor_check = 1; # always do neighbor check
                                           # (see below)
		for my $best_near2 (@$near2) {
		    if ($best_near->{N} eq $best_near2->{N}) {
			my $best_near2_coords = $best_near2->{Coords};
			if ($best_near2_coords->[0] eq $ax &&
			    $best_near2_coords->[1] eq $ay) {
			    if ($best_near2_coords->[2] eq $bx &&
				$best_near2_coords->[3] eq $by) {
				# all coordinates the same
			    } else {
				($cx,$cy) = @{$best_near2_coords}[2,3];
			    }
			} elsif ($best_near2_coords->[2] eq $ax &&
				 $best_near2_coords->[3] eq $ay) {
			    if ($best_near2_coords->[0] eq $bx &&
				$best_near2_coords->[1] eq $by) {
				# all coordinates the same, but reversed
			    } else {
				($cx,$cy) = @{$best_near2_coords}[0,1];
			    }
			} else {
			    if ($best_near2_coords->[2] eq $bx &&
				$best_near2_coords->[3] eq $by) {
				($cx,$cy) = @{$best_near2_coords}[0,1];
			    } else {
				($cx,$cy) = @{$best_near2_coords}[2,3];
			    }
			}
			last;
		    }
		}

		my($x0,$y0) = split /,/, $coords->[$i];
		my($x1,$y1) = split /,/, $coords->[$i+1];
		my($rx0,$ry0, $rx1,$ry1);

		if (defined $cx) {
		    #
		    # A  B  C  --- real points
		    # -------
		    # 0  1     --- fuzzy points
		    # 0     1
		    #    0  1
		    # 1  0
		    # 1     0
		    #    1  0
		    #
		    push my @distances,
			[[\$ax, \$ay, \$bx, \$by],
			 Strassen::Util::strecke([$ax,$ay],[$x0,$y0])+
			 Strassen::Util::strecke([$bx,$by],[$x1,$y1]),
			],
			[[\$ax, \$ay, \$cx, \$cy],
			 Strassen::Util::strecke([$ax,$ay],[$x0,$y0])+
			 Strassen::Util::strecke([$cx,$cy],[$x1,$y1]),
			],
			[[\$bx, \$by, \$cx, \$cy],
			 Strassen::Util::strecke([$bx,$by],[$x0,$y0])+
			 Strassen::Util::strecke([$cx,$cy],[$x1,$y1]),
			],
			[[\$bx, \$by, \$ax, \$ay],
			 Strassen::Util::strecke([$ax,$ay],[$x1,$y1])+
			 Strassen::Util::strecke([$bx,$by],[$x0,$y0]),
			],
			[[\$cx, \$cy, \$ax, \$ay],
			 Strassen::Util::strecke([$ax,$ay],[$x1,$y1])+
			 Strassen::Util::strecke([$cx,$cy],[$x0,$y0]),
			],
			[[\$cx, \$cy, \$bx, \$by],
			 Strassen::Util::strecke([$bx,$by],[$x1,$y1])+
			 Strassen::Util::strecke([$cx,$cy],[$x0,$y0]),
			],
			;
		    @distances = sort { $a->[1] <=> $b->[1] } @distances;
		    #XXX no strict 'refs';
		    ($rx0,$ry0,$rx1,$ry1) = map { ${$_} } @{$distances[0]->[0]};
		} else {
		    ($rx0,$ry0,$rx1,$ry1) = ($ax,$ay,$bx,$by);
		}

		if ($do_neighbor_check) {
		TRY: {
			my $c_ref = $best_near->{StreetObj}->[Strassen::COORDS];
			my $r0 = "$rx0,$ry0";
			my $r1 = "$rx1,$ry1";
			#for(my $i=0; $i<$#$c_ref; $i++) {
			for my $i (0 .. $#$c_ref-1) {
			    if (($c_ref->[$i]   eq $r0 &&
				 $c_ref->[$i+1] eq $r1) ||
				($c_ref->[$i+1] eq $r0 &&
				 $c_ref->[$i]   eq $r1)
			       ) {
				# OK, r0 and r1 are neigbors:
				last TRY;
			    }
			}
			# not neigbors:
			next COORDS_LOOP;
		    }
		}

		my $dir_fuzzy = atan2($y1-$y0, $x1-$x0);
		my $dir_r     = atan2($ry1-$ry0, $rx1-$rx0);
		my $dir_diff = angle_diff($dir_r,$dir_fuzzy);
		if ($dir_diff > 0.34) {
		    if ($v > 1) {
			print STDERR "skip $r->[Strassen::NAME] (angle=@{[ int($dir_diff/pi*180) ]}; ($rx0,$ry0) ($rx1,$ry1))\n";
		    }
		    next;
		}
		my $coords;
		if (abs($dir_r-$dir_fuzzy) >= pi/2) {
		    $coords = ["$rx1,$ry1", "$rx0,$ry0"];
		} else {
		    $coords = ["$rx0,$ry0", "$rx1,$ry1"];
		}
		my $key = "$r->[Strassen::NAME]/@$coords";
		if (!$seen{$key}) {
		    push @out_recs, ["$r->[Strassen::NAME]/$near->[$inx]{StreetObj}[Strassen::NAME]", $outcat, $coords, $directives];
		    $seen{$key}++;
		}
	    }
	}
    }

    for my $i (0 .. $#out_recs) {
	my $out_rec = $out_recs[$i];
	my($name,$cat,$coords,$directives) = @$out_rec;
	if ($autoconnect_net && $i >= 1) {
	    my $last_coord = $out_recs[$i-1][2][-1];
	    my $this_coord = $out_recs[$i][2][0];
	    if ($last_coord ne $this_coord) {
		if (Strassen::Util::strecke_s($last_coord, $this_coord) < 200) { # XXX don't hardcode, or introduce constant
		    my $res = Strassen::SimpleSearch::simple_search($autoconnect_net, $last_coord, [$this_coord]);
		    if ($res) {
			$out_s->push_ext([$name, $res->{route}, $cat], $directives);
		    }
		}
	    }
	}
	$out_s->push_ext([$name, $coords, $cat], $directives);
    }
}
print $out_s->as_string;

printf STDERR "\nReady\n" if $v;

# Return the index to the first array if there is a match or undef
sub _match_sets {
    my($a,$b) = @_;
    my $i=0;
    my %b = map { ($_=>$i++) } @$b;
    for my $j (0..$#$a) {
	return $j if exists $b{$a->[$j]};
    }
    undef;
}

sub angle_diff {
    my($a1,$a2) = @_;
    my $d = abs($a1-$a2);
    $d -= pi if $d > pi;
    return $d       if ($d > -pi()/2 && $d < pi()/2);
    return pi()-$d  if ($d >= pi()/2);
    return -pi()-$d;
}

sub usage {
    die "usage: $0 [-v] [-gpsfile bbdfile] [-incatrx cat] [-outcat cat] [-fuzzydist int] [-optimize opt] bbdfile1 bbdfile2 ...
where: <bbdfile2 ...> are the original street files (i.e. strassen etc.)
       <bbdfile1>     is the fuzzy street file
-optimize [auto|large|small|lowmem]: automatic, for large files, for small files
Additional fuzzy street files may be added with the -gpsfile option.
-v: be verbose (but only if interactive)
";
}

# REPO BEGIN
# REPO NAME is_interactive /home/e/eserte/work/srezic-repository 
# REPO MD5 87e9e2500fbe4a3ffe5f977de8513d47
sub is_interactive {
    if ($^O eq 'MSWin32' || !eval { require POSIX; 1 }) {
	# fallback
	return -t STDIN && -t STDOUT;
    }

    # from perlfaq8, slightly changed (no die, but return)
    open(TTY, "/dev/tty") or return 0;
    my $tpgrp = POSIX::tcgetpgrp(fileno(*TTY));
    my $pgrp = getpgrp();
    if ($tpgrp == $pgrp) {
	1;
    } else {
	0;
    }
}
# REPO END

__END__
