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

#
# Author: Slaven Rezic
#
# Copyright (C) 2002,2003,2012,2013,2014,2015,2025 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.
#
# WWW:  https://github.com/eserte/bbbike
#

use strict;
use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib");
use Strassen::Core;
use Getopt::Long;

my $out;
my $force;
my $do_scale_widths = 1;
my $do_distinguish_dir = 0;
my @scale_widths = (0.25, 0.5, 0.75, 1, 1.5, 2);
my $logarithmic = undef;
my $is_coordssession_data;
my $do_last_12_months;
if (!GetOptions("logarithmic=f" => \$logarithmic,
		"f" => \$force,
		"o=s" => \$out,
		"scalewidths!" => \$do_scale_widths,
		"distinguish-dir!" => \$do_distinguish_dir,
		"coordssession-data!" => \$is_coordssession_data,
		"last12months" => \$do_last_12_months,
	       )) {
    die "usage";
}

if ($do_last_12_months) {
    if (!@ARGV) {
	die "-last12months needs the last .bbd as input file\n";
    }
    if (@ARGV != 1) {
	die "Please specify exactly one .bbd as input file for -last12months options\n";
    }
    if (my($before,$y,$sep,$m,$after) = $ARGV[0] =~ m{^(.*)(2\d{3})(\D*)(0\d|10|11|12)(.*)$}) {
	for (1..12) {
	    $m--;
	    if ($m < 1) { $y--; $m = 12 }
	    my $new_file = sprintf "%s%04d%s%02d%s", $before, $y, $sep, $m, $after;
	    if (-s $new_file) {
		unshift @ARGV, $new_file;
	    } else {
		warn "File $new_file not found, skipping...\n";
	    }
	}
	warn "Files found:\n" . join("\n", map { "  $_" } @ARGV) . "\n";
    } else {
	die "Cannot parse year and month out of '$ARGV[0]'\n";
    }
}

if (!defined $out) {
    die "Specify out file with -o option!";
}
if ($out !~ /\.bbd$/) {
    die "$out does not have .bbd extension!";
}

if ($is_coordssession_data && !$do_distinguish_dir) {
    die "-coordssession-data option requires -distinguish-dir option!";
}

my @files;
if (@ARGV == 0) {
    if (-t STDIN) {
	print STDERR "Reading from STDIN...\n";
    }
    @files = '-';
} elsif (@ARGV == 1) {
    @files = $ARGV[0];
} else {
    @files = @ARGV;
}
my $s;
if (@files == 1) {
    $s = Strassen->new($files[0]) or die "Strassen file '$files[0]' cannot be opened";
} else {
    require Strassen::MultiStrassen;
    $s = MultiStrassen->new(@files);
}
if (-e $out && !$force) {
    die "Will not overwrite existing file $out, to force use the -f option.\n";
}

my %net;
my %name;
my %hop_props; # coord -> {key -> val ...}

$s->init;
while(1) {
    my $r = $s->next;
    last if !@{ $r->[Strassen::COORDS()] };
    for my $i (0 .. $#{ $r->[Strassen::COORDS()] }-1) {
	my $c1 = join(";", @{$r->[Strassen::COORDS()]}[$i,$i+1]);
	my $c2 = join(";", @{$r->[Strassen::COORDS()]}[$i+1,$i]);
	if (!$do_distinguish_dir) {
	    if (!exists $name{$c1}) {
		if (!exists $name{$c2}) {
		    $name{$c2} = $r->[Strassen::NAME()];
		}
		$net{$c2}++;
	    } else {
		$net{$c1}++;
	    }
	} else {
	    if ($is_coordssession_data) {
		if ($r->[Strassen::NAME()] =~ m{^(\d{4}-\d{2}-\d{2})\S+\s+(\S+)\s+(.*)}) {
		    my($date, $ip, $rest) = ($1, $2, $3);
		    my $props = $hop_props{$c1};
		    if (!$props) {
			$props = $hop_props{$c1} = {};
		    }
		    $props->{_date}->{$date}++;
		    $props->{_ip}->{$ip}++;
		    for my $kv (split /\s+/, $rest) {
			my($k,$v) = split /:/, $kv;
			$props->{$k}->{$v}++;
		    }
		} else {
		    warn "Cannot parse '$r->[Strassen::NAME()]'";
		}
	    } else {
		if (!exists $name{$c1}) {
		    $name{$c1} = $r->[Strassen::NAME()];
		}
	    }
	    $net{$c1}++;
	}
    }
}

my %net2cat;
my %cat;
my $max_count = 0;
# Calculate %net2cat (the mapping line -> category)
# Calculate %cat (existence hash of used categories)
# Modify %name: make the values into a two-element array with
#  $count
#  $name
# (with -coordssession-data): build name from the most common prop values
while(my($k,$v) = each %net) {
    my $count = $v;
    if ($do_last_12_months) {
	$v /= 12; # normalize to one month
    }
    if (defined $logarithmic) {
	$v = int(log($v)/log($logarithmic));
	$v = 1 if ($v < 1);
    }
    $net2cat{$k} = $v;
    if ($is_coordssession_data) {
	my $props = $hop_props{$k};
	if ($props) {
	    my $prop2out = sub {
		my($props_key) = @_;
		my $max_count = 0;
		my $max_val;
		while(my($val,$val_count) = each %$props_key) {
		    if (!defined $max_val || $val_count > $max_count) {
			$max_count = $val_count;
			$max_val   = $val;
		    }
		}
		($max_val, $max_count != $count ? int(100*$max_count/$count) : 100);
	    };

	    # fragezeichen2org expects the count as the first field.
	    my @name;
	    # Output the "meta" properties date and ip.
	    # Show 100% is there's only one different value here, otherwise no percentage.
	    # No key ("date"/"ip") is output here, the value looks nonambiguous.
	    for my $meta_props_def (
				    [$prop2out->($props->{'_date'})],
				    [$prop2out->($props->{'_ip'})],
				   ) {
		push @name, $meta_props_def->[0] . ($meta_props_def->[1] == 100 ? '(100%)' : '');
	    }
	    # Output the normal properties like speed, quality etc.
	    # Here output is different: show a percentage only if it's not 100%
	    # Sort property keys by highest percentage.
	    my @props_out;
	    while(my($key,$props_key) = each %$props) {
		next if $key =~ m{^_};
		push @props_out, [$key, $prop2out->($props_key)];
	    }
	    for my $props_def (sort { $b->[2] <=> $a->[2] } @props_out) {
		push @name, ' ' . $props_def->[0] . ':' . $props_def->[1] . ($props_def->[2] < 100 ? '('.$props_def->[2].'%)' : '');
	    }
	    # We have the count and the name, finally.
	    $name{$k} = [$count, join(' ', @name)];
	} else {
	    $name{$k} = [0, '???']; # because this should never happen
	}
    } else {
	$name{$k} = [$count, $name{$k}];
    }
    $cat{$v}++;
    $max_count = $count if $count > $max_count;
}

{
    open my $OUT, ">", $out
	or die "Writing to $out failed: $!";

    for my $k (sort { $a <=> $b } keys %cat) {
	print $OUT "#: line_width.$k: ";
	if ($do_scale_widths) {
	    print $OUT join(",", map { my $w = int($k*$scale_widths[$_]);
				       $w == 0 ? 1 : $w;
			    } (0..5));
	} else {
	    print $OUT join(",", map { $k } (0..5));
	}
	print $OUT "\n";
    }
    print $OUT "#: line_color: #000080\n";
    if ($do_distinguish_dir) {
	print $OUT "#: line_directed_weight: 1\n";
	print $OUT "#: line_arrow: none\n";
    }
    print $OUT "#:\n"; # end of global directives

    my $rank_i = 0;
    for my $k (sort { $name{$a}->[0] <=> $name{$b}->[0] } keys %name) {
	my($count, $name) = @{ $name{$k} };
	my($c1,$c2) = split /;/, $k;
	my $cat = $net2cat{$k};

	my $percentage_string = '';
	if (1) { # percentage by $count/$max_count
	    if ($max_count) {
		$percentage_string = ' ' . sprintf('%3d%%', $count/$max_count*100);
	    } else {
		$percentage_string = '';
	    }
	} else { # percentage by rank XXX should it be possible to enable this by option?
	    $rank_i++;
	    $percentage_string = ' ' . sprintf('%3d%%', $rank_i/scalar(keys %name)*100);
	}

	print $OUT $count . ':' . $percentage_string . ' ' . $name . "\t" . $cat . ($do_distinguish_dir ? ';' : '') . " " . $c1 . " " . $c2 . "\n";
    }
    close $OUT;
}

__END__

=head1 NAME

weight_bbd - create weighted bbd files

=head1 DESCRIPTION

Creates bbd files with frequency of route search results rendered for
streets on the map.

=head2 OPTIONS

  -logarithmic <real>: 1.5 seems a nice choise: 100 => 11, 500 => 15
  -f: force overwriting existing file
  -o outfile: bbd file for output
  -[no]scalewidths: scale widths (default: true)
  -[no]distinguish-dir: distinguish between both directions (default: false)
  -last12months: create a plot of last 12 months (instead of 1 month)

=head1 BBD OUTPUT

The names in the bbd records have currently following information
included:

=over

=item * number of searches

=item * percentage of the maximum search count

=item * ISO date+time of a sample search

=item * IP address of a sample search

=item * following key:value pairs with most frequent search settings

=back

A sample entry:

    363:  75% 2015-10-07T22:10:07 127.0.0.1 speed:20    6; 11393,10390 11291,10438

=head2 EXAMPLES

Create a monthly weighted plot from bbbike.de coordssessions (session
packed in a zip file):

    YYYYMM=2013-09
    WEIGHTEDTMP=$HOME/src/bbbike/tmp/weighted
    mkdir -p $WEIGHTEDTMP
    ~/src/bbbike/miscsrc/coordssession2bbd coordssession-$YYYYMM.zip > $WEIGHTEDTMP/$YYYYMM.bbd
    ~/src/bbbike/miscsrc/weight_bbd                  -logarithmic=2.5 -f $WEIGHTEDTMP/$YYYYMM.bbd -o $WEIGHTEDTMP/${YYYYMM}_weighted_25.bbd
    ~/src/bbbike/miscsrc/weight_bbd -distinguish-dir -logarithmic=2.5 -f $WEIGHTEDTMP/$YYYYMM.bbd -o $WEIGHTEDTMP/${YYYYMM}_weighted_dir_25.bbd

Create a plot of last 12 months (also needs defined C<YYYYMM> and
C<WEIGHTEDTMP>):

    ~/src/bbbike/miscsrc/weight_bbd -distinguish-dir -logarithmic=2.5 -f $WEIGHTEDTMP/$YYYYMM.bbd -o $WEIGHTEDTMP/${YYYYMM}_last12months_weighted_dir_25.bbd -last12months

Create a yearly plot (prerequisite: monthly bbd files from
coordssession2bbd):

    YYYY=2013
    ~/src/bbbike/miscsrc/weight_bbd -distinguish-dir -logarithmic=2.5 -f $WEIGHTEDTMP/$YYYY-??.bbd -o $WEIGHTEDTMP/${YYYY}_weighted_dir_25.bbd

=cut
