package MpmasNetworkSet;

use strict;
use warnings;
use Exporter;
use Storable qw(dclone);
use Data::Dumper;
use SimpleObjectRegistry;
use MpmasInputBlock;
use SimpleObject;
use IndexedTable;
use MpmasNetwork;
use CtUtilities qw(queryhash strip_sql);
our @ISA = qw(MpmasInputfileSet);

sub class_of_files{
	return "MpmasNetwork";
 }
sub filename {
	return "NetworkSet";
}
sub determine_files {
	my $self = shift;
		
	for my $n (0..$self->config_entry("NETWORKS")-1 ) {
		my $fname = sprintf("%01d", $n);
		$self->add_file($n,$fname);
	}

}
sub define_specobjs {
      my $self = shift;
      my %specobjname = (
		femhead => "Female Head of Household",
		innovativeness => "Innovativeness",
		expectations => "Form of expectations",
		liquidity => "Liquidity",
		leverage =>	"Leverage",
		zero_savings_prob	=>	"Random number for logit zero savings model",
		timepref => 	"Monthly time preference of agent",
		which_market => "Market the agent has access to"
		) ;

	my %specobjtype = (
		femhead => -1,
		innovativeness => -2,
		expectations => -3,
		liquidity => -4,
		leverage =>	-5, 
		zero_savings_prob	=>	-6,
		timepref => 	-7,
		which_market	=> -8
	) ;
	my %specobjindex = (
			femhead => 1,
			innovativeness => 2,
			expectations => 3,
			liquidity => 4,
			leverage =>	5,
			zero_savings_prob	=>	6,
			timepref => 	7,
			which_market => 8
			  ) ;
      $self->set_specobj_info(\%specobjname,\%specobjindex,\%specobjtype);

}
sub prepare_shared_files {
	my $self = shift;
	my $dbh = $self->get_dbh;

	$self->define_specobjs;
	## Determine number of Segments by counting the thresholds in the list
	my @thresholds = $self->get_cfg_list("THRESHOLDS");
	$self->set_config_entry("SEGMENTS",  scalar @thresholds);
	
	### ObjectIDs for Network, Demography and Population
	# Distribute ObjectIDs and replace activity and constraint names by LP Column and Row Indices
	my $ki = 0;
	my @temp = sort {$a->id cmp $b->id} $self->networkobjects;
	my $counter = 0;
	my @AttachedAssets;
	my $maxPlotCapLayerFound = -1;
	for my $k (@temp){
		$k->set_oid($ki++);
		unless ($self->config_entry("MPMASQL3")) {
			my $ac = $self->activity($k->act);
			my $co = $self->constraint($k->con);
			
			#print $k->id(), ":" ,$k->attr("terrain"), ":" , $k->attr("is_perennial") ,":", $k->attr("is_livestock")  , "\n";
			
			print STDERR  "Error in asset ".$k->id.": No such activity  (".$k->act.") \n" and exit(1) unless (defined $ac);
			print STDERR  "Error in asset ".$k->id.": No such constraint (endowment) (".$k->con.") \n" and exit(1) unless (defined $co);

			print STDERR "Error in asset ".$k->id.": Terrain out of range.\n" and exit(1) unless ($k->{terrain} < $self->config_entry("NSOIL"));

			my $iac = $ac;
			if($k->attr("is_perennial") or $k->attr("is_livestock") ) {
					$iac = $self->activity_at_col($ac->lp_column() -1);
			}
			print STDERR "Error in asset ".$k->id.": Asset is marked as indivisible, but the associated investment activity ".$iac->id()." is not marked as integer.\n" and exit(1) if ($k->attr("div") == 0 and $iac->attr("integ") != 1);
			print STDERR "Warning for asset ".$k->id.": Asset is marked as divisible, but the associated investment activity ".$iac->id()." is marked as integer.\n" if ($k->attr("div") == 1 and $iac->attr("integ") == 1);
			print STDERR "Error in asset ".$k->id.": Asset is marked as perennial, but the terrain field is empty/-1.\n" and exit(1) if ($k->attr("is_perennial") and $k->attr("terrain") < 0);
			print STDERR "Warning for asset ".$k->id.": Asset is marked as perennial, but the perm field is empty/-1.\n" and exit(1) if ($k->attr("is_perennial") and not defined $k->attr("perm") );



			my $lpc = $ac->lp_column;
			my $lpr = $co->lp_row;
			$k->set_act($lpc);
			$k->set_con($lpr);
			
		}
		else {
			$k->set_act(-1);
			$k->set_con(-1);
		}
		if ($k->perm ne "-1" and $k->perm ne "0" and defined $k->perm ) {
			my $perm = $self->constraint($k->perm);
			
			print STDERR "Error in asset ".$k->id.": No such constraint (yield) (".$k->perm.") \n" and exit(1) unless (defined $perm);
			my $lpr2 = $perm->lp_row;
			$k->set_perm($lpr2);
		}
		$counter++ if ($k->type == 2);
		if ($k->attr("plot_capacity_layer") > -1)
		{
			print STDERR "Error in asset ".$k->id.": plot_capacity_layer [".$k->attr("plot_capacity_layer") ."] > NUM_PLOT_CAPACITY_LAYERS [".$self->config_entry("NUM_PLOT_CAPACITY_LAYERS")."] - 1\n" and exit(1) if ($k->attr("plot_capacity_layer") > $self->config_entry("NUM_PLOT_CAPACITY_LAYERS") - 1);
			push @AttachedAssets, $k;
		}
	}
	$self->set_config_entry("LM_assets_with_land", \@AttachedAssets);
	$self->set_config_entry("SYMBOLICS", $counter);
	
	##Search for disinvestment activities
	for my $k (@{$self->sorted_activity_objects}) {

		if ($k->attr("type") eq "MASdisinvest") {
			my $on = $k->subelement_field("disinvest", "asset");
			my $o = $self->networkobject($on);
			print STDERR "Error in #disinvest> asset for activity ",$k->id,": No such asset '$on'\n" and exit (1) unless (defined $o);
			$o->set_attr("disinvest_firstcol", $k->lp_column()) unless ( defined $o->attr("disinvest_firstcol") );
			$o->set_attr("disinvest_num", defined ($o->attr("disinvest_num")) ? $o->attr("disinvest_num") + 1 : 1);
			$k->set_attr("ubound", 0); #just to be sure
			$k->set_attr("lbound", 0);
		}
	}


	#Distribute ObjectIDs for Liquidity, Female Lab etc.
	my %specindices = %{$self->get_specobj_indices()};
	my $temp2 = [];
	for my $k (keys %specindices ) {
	    
		$temp2->[ $specindices{$k} ] = $ki -1 + $specindices{$k};
	}
	$self->set_config_entry("SPECOBJS", $temp2);
	
	
	
	my %ExtraAgentCharCodes;

	my @ExtraAgentChars = $self->get_cfg_list_empty_ok("EXTRA_AGENT_ATTRIBUTES");
	
	print STDERR "Error: EXTRA_AGENT_ATTRIBUTES only possible with ASSETDISTTYPE = 2\n" and exit(1) if (scalar (@ExtraAgentChars)  && $self->config_entry("ASSETDISTTYPE") < 2);
		
		
	
	
	for my $i (0..$#ExtraAgentChars) {
		$ExtraAgentCharCodes{$ExtraAgentChars[$i]} = $i;
	}
	$self->set_agent_attribute_ids(\%ExtraAgentCharCodes);
	
	
	
	


	##Retrieve innohash from database or create empty 
	my $innohash;
	if (defined $self->config_entry("INNOVATIONS") ) {
		$innohash = $self->config_entry("INNOVATIONS")->transform($dbh, 3);
	}
	else {
	 	$innohash= IndexedTable->create_empty(3);
	}
	##Add innogrps to innohash that are not listed in innovations
	for my $k ($self->networkobjects){
		my $innogrp = $k->innogrp;
		for my $n (0.. $self->config_entry("NETWORKS") -1) {
			for my $s (0.. $self->config_entry("SEGMENTS") -1) {
				unless (defined $innohash->query([$n, $s, $innogrp], 4) ) {
					my @row;
					if (defined $innohash->query([$n, $s - 1, $innogrp], 4) ) {
						@row = ($n,$s,$innogrp, $innohash->query([$n, $s - 1, $innogrp], 4), $innohash->query([$n, $s - 1, $innogrp], 5) );
					}
					else {
						@row = ($n,$s,$innogrp, 0,1);
					}	
					$innohash->add_row(\@row);	
				}
			}
		}
	}
	# Determine InnovationIDs for Network and Segment
	my @innolist = $innohash->query([0,0],0);
	my $innos ={};
	if (scalar (@innolist) > 0 && defined $innolist[0]) {
		@innolist = sort { $a cmp $b} @innolist;  # sort to ensure replicability
		$ki = 0;
		
		for my $k (0..$#innolist){
			my $in = "$innolist[$k]";
			$innos->{$in} = ++$ki;
		}
	}
	for my $k ($self->networkobjects){
		my $f1 = $k->oid;
		my $r1 = $k->innogrp;
		my $f2 = $innos->{$r1};
		$k->set_innovid($f2);
	}	

	##Determine Order of Objects		
	my @SortedObjects = sort {$a->innovid <=> $b->innovid || $a->oid <=> $b->oid}  $self->networkobjects; ##
	my $g = -1;
	my @SortedObjectIds;
	for my $i (@SortedObjects){
		$i->set_network_row(++$g);
		push @SortedObjectIds, $i->id;
	}
	$self->set_sorted_networkobjects(\@SortedObjectIds);

	my $NN = 0; # Number of Investments in Network
	my @SortedObjectsInCurrentNetwork; 
	my %InnovationsInCurrentNetwork; # using hash instead of array  to ensure uniqueness
	for my $ddd (@SortedObjects) {
		for my $j (0..$self->config_entry("NETWORKS")-1){
				my $innofound = $ddd->innogrp;
				$InnovationsInCurrentNetwork{$innofound} = 1;
				push @SortedObjectsInCurrentNetwork, $ddd;
				$NN += 1;
				last;					
		}
	}
	#Sort InnovationsInCurrentNetwork
	my @SortedInnovationsInCurrentNetwork = sort {$innos->{$a} <=> $innos->{$b}} keys %InnovationsInCurrentNetwork;
	$self->set_global("Innovations", $innos);
	$self->set_global("InnovationInfo", $innohash);
	$self->set_global("InnovationsInCurrentNetwork", \%InnovationsInCurrentNetwork);
	$self->set_global("SortedInnovationsInCurrentNetwork", \@SortedInnovationsInCurrentNetwork);
}

sub prepare_special_files {
	my $self = shift;
	for my $f ($self->files) {
		$f->prepare_special();
	}
}
