#!/usr/local/bin/perl

# Answers DGB's $200 Lineup challenge.
# Usage: team-200 [ BUDGET [ TEAM1 TEAM2 .. TEAM31 ] ]
# (C) MoreHockeyStats.com under GPLv3.

use strict;
use warnings FATAL => 'all';
use v5.10.1;

use List::Util qw(sum);

use Algorithm::Combinatorics qw(combinations);
use List::MoreUtils qw(part);
use HTML::Tiny;

$ENV{HOCKEYDB_VERBOSE} = 1;

use Sport::Analytics::NHL::DB;
use Sport::Analytics::NHL::Config qw(%TEAMS);
use Sport::Analytics::NHL::Vars qw($DB $CACHES $CURRENT_SEASON);
use Sport::Analytics::NHL::Util qw(:debug);
use Sport::Analytics::NHL::Tools qw(get_team_full_name_at_season resolve_team);

$DB = Sport::Analytics::NHL::DB->new();
our $H = HTML::Tiny->new();
our $BUDGET = shift || 200;
our @TEAMS = @ARGV ? @ARGV : sort grep { $TEAMS{$_}->{founded} && ! $TEAMS{$_}->{folded} } keys %TEAMS;

sub print_html_header () {

	my $header = '';
	my $t = 1;
	for my $team (@TEAMS) {
		$header .= $H->a({href => "#$team"}, $team) . ' ';
		$header .= $H->br() . "\n" if (!($t % 8));
		$t++;
	}
	print $header;


}

sub find_team_players ($$) {

	my $team      = shift;
	my $players_c = shift;

	my $query = { 'career.0.team' => { '$in' => [ $team, @{$TEAMS{$team}->{short}}]	} };
	my $count = $players_c->count_documents($query);
	verbose "$count players detected for team $team";
	my $players = [ grep {
		my $total = 0;
		for my $season (@{$_->{career}[0]}) {
			if ($season->{league} eq 'NHL' || $season->{league} eq 'National Hockey League') {
				$season->{team} = resolve_team($season->{team});
				$total += $season->{gp} if $season->{team} eq $team
			}
		}
		$total < $BUDGET - 4;
	} $players_c->find($query)->all() ];
	my $g = $BUDGET - 5;
	verbose scalar(@{$players}) . " detected with $g games or less";

	$players;
}

sub set_players_data ($$) {

	my $players = shift;
	my $team    = shift;

	my $players_data = {};
	for my $player (@{$players}) {
		for my $season (@{$player->{career}[0]}) {
			$players_data->{$player->{_id}}{position} = $player->{position};
			$players_data->{$player->{_id}}{name}     = $player->{name};
			if ($season->{league} eq 'NHL' || $season->{league} eq 'National Hockey League') {
				$players_data->{$player->{_id}}{value} += ($season->{pts} || $season->{w} || 0);
				$players_data->{$player->{_id}}{cost}  += $season->{gp} if $season->{team} eq $team;
			}
			$players_data->{$player->{_id}}{_id}      = $player->{_id};
			$players_data->{$player->{_id}}{active}   = $player->{active};
		}
	};
	$players_data;
}

sub get_sorted_candidates ($) {

	my $players_data = shift;

	my @v_players = values %{$players_data};
	my $threshold = @v_players / 150;
	my @candidates = part {
		$_->{position} eq 'G' ? 2 : $_->{position} eq 'D' ? 1 : 0
	} sort {
		$b->{bang} <=> $a->{bang}
			||
			$a->{cost} <=> $b->{cost}
	} grep {
		if ($_->{cost}) {
			unless (defined $_->{value}) {
				dumper $_
			}
			$_->{bang} = $_->{value} / $_->{cost};
			$_->{bang} > $threshold
		}
		else {
			0;
		}
	} @v_players;
	my $count = sum map(scalar(@{$_}), @candidates);
	verbose "Reduced to $count candidates";
	\@candidates;
}

sub total_cost ($$$) {

	sum (
		$_[0]->[0]{cost},
		$_[0]->[1]{cost},
		$_[0]->[2]{cost},
		$_[1]->[0]{cost},
		$_[1]->[1]{cost},
		$_[2]->[0]{cost}
	);
}

sub total_value ($$$) {

	sum (
		$_[0]->[0]{value},
		$_[0]->[1]{value},
		$_[0]->[2]{value},
		$_[1]->[0]{value},
		$_[1]->[1]{value},
		$_[2]->[0]{value}
	);
}

sub get_cheapest_lineup ($) {

	my $candidates = shift;

	my $lineup = {
		players => [
			[ $candidates->[0][0], $candidates->[0][1], $candidates->[0][2] ],
			[ $candidates->[1][0], $candidates->[1][1] ],
			[ $candidates->[2][0] ],
		],
		cost    => total_cost( $candidates->[0], $candidates->[1], $candidates->[2]),
		value   => total_value($candidates->[0], $candidates->[1], $candidates->[2]),
	};
	$lineup;
}

sub prune_candidates ($) {

	my $candidates = shift;

	for my $i (0 .. 2) {
		my $c = $candidates->[$i][2-$i];
		$candidates->[$i] = [ grep {
			$_->{value} >= $c->{value} || $_->{cost} <= $c->{cost}
		} @{$candidates->[$i]} ];
	}
	verbose "Pruned to: " . join(
		'/', scalar(@{$candidates->[0]}), scalar(@{$candidates->[1]}), scalar(@{$candidates->[2]}),
	);
}

sub get_fdg_combinations ($) {

	my $candidates = shift;

	my $fdg_combinations = [];
	my @types = qw(F D G);
	for my $fdg (0..2) {
		$fdg_combinations->[$fdg] = [ grep {
			my $m = $_;
			sum map($_->{cost}, @{$m}) < $BUDGET - 2 + $fdg
		} combinations($candidates->[$fdg], 3-$fdg) ];
		verbose "Created " . scalar @{$fdg_combinations->[$fdg]} .  "$types[$fdg] combinations";
	}
	$fdg_combinations;
}

sub find_best_lineup ($) {

	my $fdg_combinations = shift;

	my $best_lineup;
	my $best_value = 0;
	my $best_cost = 0;
	my $i = 1;
	for my $f (@{$fdg_combinations->[0]}) {
		debug "$i" . '/' . scalar(@{$fdg_combinations->[0]});
		for my $d (@{$fdg_combinations->[1]}) {
			for my $g (@{$fdg_combinations->[2]}) {
				my $cost = total_cost($f, $d, $g);
				next if $cost > 200;
				my $value = total_value($f, $d, $g);
				next if $value < $best_value;
				$best_value = $value;
				$best_cost = $cost;
				$best_lineup = {
					players => [ $f, $d, $g ],
					cost    => $cost,
					value   => $value,
				};
			}
		}
		$i++;
	}
	$best_lineup;
}

sub print_html_lineup ($$$) {

	my $team   = shift;
	my $lineup = shift;
	my $type   = shift;

	my $html = '';

	$html .= $H->a({name => $team}, '');
	$html .= $H->h3(
		$type eq 'best'
			? get_team_full_name_at_season($team, $CURRENT_SEASON)
			: 'Best bang for the buck'
	);
	my $h_lineup = '';
	for my $fdg (0..2) {
		$h_lineup .= join(' -- ', map(
			sprintf(
				"%s (\$%d, %d %s)",
				$_->{active} ? $H->tag('i', $_->{name}) : $_->{name},
				$_->{cost}, $_->{value},
				($_->{position} eq 'G' ? 'wins' : 'pts'),
			), @{$lineup->{players}[$fdg]}
		)) . $H->br;
	}
	$html .= $H->p($h_lineup);
	$html .= "Total cost: "  . $H->tag('u', "\$$lineup->{cost}") . $H->br();
	$html .= "Total value: " . $H->tag('u', "$lineup->{value} (pts+wins)") . $H->br() . $H->br() . "\n";
	print $html;
}

sub print_lineup ($$$) {

	goto &print_html_lineup if $ENV{HTML_OUT};
	my $team   = shift;
	my $lineup = shift;
	my $type   = shift;

	print STDOUT (
		$type eq 'best'
			? get_team_full_name_at_season($team, $CURRENT_SEASON)
			: 'Best bang for the buck'
	), "\n";

	for my $fdg (0..2) {
		print join(' -- ', map(
			sprintf(
				"%s (\$%d, %d %s)",
				$_->{name}, $_->{cost}, $_->{value},
				($_->{position} eq 'G' ? 'wins' : 'pts'),
			), @{$lineup->{players}[$fdg]}
		)), "\n";
	}
	print "Total cost: \$$lineup->{cost}\n";
	print "Total value: $lineup->{value} (pts+wins)\n\n";
}

my $players_c = $DB->get_collection('players');
my $lineups = {};
print_html_header() if $ENV{HTML_OUT};

for my $team (@TEAMS) {
	my $players      = find_team_players($team, $players_c);
	my $players_data = set_players_data($players, $team);
	my $candidates   = get_sorted_candidates($players_data);

	$lineups->{$team}{cheapest} = get_cheapest_lineup($candidates);
	prune_candidates($candidates);
	my $fdg_combinations = get_fdg_combinations($candidates);
	$lineups->{$team}{best} = find_best_lineup($fdg_combinations);
	print_lineup($team, $lineups->{$team}{$_}, $_) for qw(best cheapest);
}

__END__
my $top = [3, 2, 1];
do {
	my $bin;
	if ($_[0]->[$top->[0]]{bang} > $_[1]->[$top->[1]]{bang}) {
		$bin = ($_[0]->[$top->[0]]{bang} > $_[2]->[$top->[2]]{bang}) ? 0 : 2;
	}
	else {
		$bin = ($_[1]->[$top->[1]]{bang} > $_[2]->[$top->[2]]{bang}) ? 1 : 2;
	}
	my $new_candidate = $_[$bin]->[$top->[$bin]];
	if ($) {
	}
} while (
	$top->[0] < @{$candidates->[0]} &&
	$top->[1] < @{$candidates->[1]} &&
	$top->[2] < @{$candidates->[2]}
);
dumper [
	$_[0]->[0],
	$_[0]->[1],
	$_[0]->[2],
	$_[1]->[0],
	$_[1]->[1],
	$_[2]->[0],
];