package MpmasNetwork;

use strict;
use warnings;
use Exporter;
use Storable qw(dclone);
use Data::Dumper;
use CtUtilities qw(queryhash extqueryhash);
use MpmasInputfile;
use MpmasInputBlock;
our @ISA = qw(MpmasInputfile);

sub filename {
	my $self = shift;
	return "Network".$self->file_suffix;
}

sub required {
	my $self = shift;
	return 1;
}
sub prepare_shared {

}

sub prepare_special {
	my $self = shift;	

	my $i = $self->argument;
	
	my @assetsWithOffspring;
	
	my $netw = MpmasInputBlock->new(3, 10);
	my $NN = $self->number_of_networkobjects;
	$netw->add_comment_row("INNOVATION NETWORK $i"); 
	$netw->add_row("","","Number of investment goods", "$NN");
	my @header = ("","Code","Description of investment object","Object ID","Innovation ID","Object type","Divisibility","Acquisition cost","Lifetime","Suitability to soil type","Minimum investment","Activity index in MILP","Constraint index in MILP","Permanent crop yield constraint","Right-hand-side value","Innovativeness","Share own capital","Interest rate on borrowed capital");
	if ($self->config_entry("ASSETDISTTYPE") == 2 ) {
	      push @header, "Object type";
	      push @header, "Land requirement";
	
	}
	#if ($self->config_entry("COUNTRY") == 5 ) {
	      push @header, "Available until period";
	      push @header, "Inflation rate past";
	      push @header, "Min. age at simulation start";
	      push @header, "Max. age at simulation start";
		  push @header, "Resale value as share of time value";
		  push @header, "Share of book value considered objective function";
		  push @header, "First disinvestment activity";
		  push @header, "Number of disinvestment activities";
		  push @header, "Disinvest completely?";
	#}
	if ($self->config_entry("MULTIPERIOD") > 0  ) {
		push @header, "Accounting in aggregates?";
		push @header, "Asset (Oid) sparked at end of life";
		push @header, "Asset (Oid) sparked when disinvested";
	}
	elsif (!$self->config_entry("MULTIPERIOD") && ($self->config_entry("COUNTRY") == 5 || $self->config_entry("PRE_INVESTMENT_EXTERNAL_SCRIPT")  )) {
		 push @header, "Resale topup";
		 push @header, "Resale topup reduction per year of age";
		 push @header, "Asset (Oid) sparked at end of life";
		 push @header, "Asset (Oid) sparked when disinvested";
	}
	push @header, "Object name";
	$netw->add_comment_row(@header);
	#loop over sorted network objects

	for my $no ($self->sorted_networkobjects){
		my $co = $self->networkobject($no);
		my @nettab;
		@nettab[0..2] = ("","$no",$co->attr("name")); 
		for my $f (qw(oid innovid type	div acqcost lifetime terrain mininvest act con perm multiplier innovativeness eqshare irate) ){
			push @nettab, $co->attr($f);
		}
		if ($self->config_entry("ASSETDISTTYPE") == 2 ) {
	      push @nettab, $co->attr("type");
	      push @nettab, $co->attr("landreq");
		}
		#if ($self->config_entry("COUNTRY") == 5 ) {#before NEWFORMAT14
		    push @nettab, $co->attr("available_until_period");
		    push @nettab, $co->attr("inflation_rate_past");
		    push @nettab, $co->attr("minimum_age_at_simulation_start");
		    push @nettab, $co->attr("maximum_age_at_simulation_start"); 
		    push @nettab, $co->attr("resale_share"); 
		    push @nettab, $co->attr("resale_book_share"); 
		    push @nettab, defined $co->attr("disinvest_firstcol") ? $co->attr("disinvest_firstcol") : -1; 
			push @nettab, defined $co->attr("disinvest_num") ? $co->attr("disinvest_num") : 0; 
			push @nettab, $co->attr("disinvest_completely"); 
		#} #before NEWFORMAT14
		if ($self->config_entry("MULTIPERIOD") > 0  ) {
			push @nettab, $co->attr("internal_accounting");
		}
		if (!$self->config_entry("MULTIPERIOD") && ($self->config_entry("COUNTRY") == 5 || $self->config_entry("PRE_INVESTMENT_EXTERNAL_SCRIPT")  )) {
		    push @nettab, $co->attr("resale_topup"); 
		    push @nettab, $co->attr("resale_topup_reduction_per_year_of_age"); 
		}
		if ($self->config_entry("MULTIPERIOD") ||  ($self->config_entry("COUNTRY") == 5 || $self->config_entry("PRE_INVESTMENT_EXTERNAL_SCRIPT")  )) {
		    my $xOid = -1; 
			if (defined $co->attr("new_asset_sparked_at_end_of_life")) {
				my $oc = $self->networkobject($co->attr("new_asset_sparked_at_end_of_life"));	
				print STDERR "Error: Asset ".$co->attr("new_asset_sparked_at_end_of_life"). " mentioned in new_asset_sparked_at_end_of_life of asset ". $co->id . " does not exist\n" and exit(1) unless (defined $oc);
				$xOid = $oc->attr("oid");
			}
		    push @nettab, $xOid; 
		    
			$xOid = -1;
			if (defined $co->attr("new_asset_sparked_when_disinvested")) {
				my $oc = $self->networkobject($co->attr("new_asset_sparked_when_disinvested"));	
				print STDERR "Error: Asset ".$co->attr("new_asset_sparked_when_disinvested"). " mentioned in new_asset_sparked_when_disinvested ". $co->id . " does not exist\n" and exit(1) unless (defined $oc);
				$xOid = $oc->attr("oid");
			}
			push @nettab, $xOid; 
			
		}
		push @nettab, $co->attr("oname");
		$netw->add_row(@nettab);
		
		if ($self->config_entry("MULTIPERIOD") > 0  ) {
			if (	defined ($co->attr("offspring_at_age") ) 
				and scalar( keys %{$co->attr("offspring_at_age")} ) > 0    
				) 
			{
				
				push @assetsWithOffspring, $co ;
			}
		
		}
	}
	$self->add_block($netw);

	if ($self->config_entry("MULTIPERIOD") > 0  ) {
		my $offsp1 = MpmasInputBlock->new(3, 20);
		my $offsp2 = MpmasInputBlock->new(3, 30);
		my $offsp1tab = MpmasInputBlock->new(3, 25);
		my $offsp2tab = MpmasInputBlock->new(3, 35);
		
		$offsp1->add_comment_row("2", "OFFSPRING");
		$offsp1->add_empty_rows(2);
		$offsp1->add_comment_row("2.1", "OFFSPRING PROBABILITIES");
		$offsp1->add_empty_rows(1);
		
		$offsp1tab->add_comment_row("","2.1.2","","ParentObjID", "ChildObjID", "Probability");
		
		
		$offsp2->add_comment_row("2.2", "NUMBER OF OFFSPRING BY AGE");
		$offsp2->add_empty_rows(1);
		$offsp2tab->add_comment_row("","2.2.2","","ObjID", "Age", "Quantity");
		
		my $numQuant = 0;
		my $numProb = 0;
		
		for my $co (@assetsWithOffspring) {
				my $parentOid = $co->attr("oid");
				my $phash  = $co->attr("offspring_probability");
				my $qhash  = $co->attr("offspring_at_age");

				my $checksum = 0;
				for my $possible_child ( sort {$a cmp $b} keys %$phash ) {
						my $chO = $self->networkobject($possible_child);
						print STDERR "Error: Asset $possible_child  if offspring_probability of asset ". $co->id() . "has not been defined\n" and exit(1) unless (defined $chO );
											
						my $p = $phash->{$possible_child};
						print STDERR "Error: invalid probability $p for potential offspring asset $possible_child in offspring_probability of asset ". $co->id() . "\n" and exit(1) unless ($p >= 0 and $p <= 1 );
						$offsp1tab->add_row("","","",$parentOid, $chO->oid(), $p);
						$numProb++;
						$checksum += $p;
				}

				print STDERR "Error in offspring_probability of asset ". $co->id() . ": the total of probabilities is greater than 1\n" and exit(1) unless ($checksum <= 1 );
				print STDERR "Info: In offspring_probability of asset ". $co->id() . ", the total of probabilities is less than 1\nThis is allowed and may make sense, but be sure you intended this\n" unless ($checksum == 1 );

				
				for my $age ( sort {$a <=> $b} keys %$qhash ) {
						print STDERR "Error: Age $age out of bounds in offspring_at_age of asset ". $co->id() . "\n" and exit(1) if ($age < 0 or $age >= $co->attr("lifetime") );
						my $q = $qhash->{$age};
						print STDERR "Error: invalid quantity of offspring $q in offspring_at_age of asset ". $co->id() . "\n" and exit(1) unless ($q >= 0 and $q =~/^[0-9]+$/ );
						$offsp2tab->add_row("","","",$parentOid, $age, $q);
						$numQuant++;
				}
				
		}
		
		$offsp1->add_row("","2.1.1", "Number of offspring probability entries", $numProb);
		$offsp2->add_row("","2.2.1", "Number of parent age entries", $numQuant);
		
		$self->add_block($offsp1);
		$self->add_block($offsp1tab);
		$self->add_block($offsp2);
		$self->add_block($offsp2tab);
		
		
		

		
		
	}
}
1;
