package MpmasDistMainDistTypes;


use strict;
use warnings;
use Exporter;

#use Math::Random::MT::Auto qw/rand srand/ ???

use Storable qw(dclone);
use EmpiricalDF;
use Carp;
use POSIX;
use List::Util qw(max);
use Scalar::Util qw(looks_like_number);
use Data::Dumper qw(Dumper);
use Term::ReadKey;

use CtUtilities qw(cartesian is_in_list fisher_yates_shuffle determine_class_by_upperbound);
use IndexedTable;
use MpmasQLFunctionLanguage;
use MasMapAgent;
use MasMapRegion;
use EnhancedGrid;
use SimpleObject;
use SimpleObjectRegistry;
use MpmasDistSharedFunctions qw(prepare_icdf predraw_from_uniform draw_value_from_cdf do_assignment do_hhmember_assignment do_post_assignment evaluate_constraints divide_constraints set_verbosity);;

##CT110826 max
use MpmasMILP;
my $milpcheck = "/usr/local/bin/MilpCheck";
use constant INFTY => 10**31;

our @ISA = qw(Exporter);
#our @EXPORT_OK qw();


		
sub distribute_observation_list {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	my @pre_potential_owners;
	## compile a first list of potential owners based on fixed and not observation_specific contraints
	AGENTLOOP: foreach my  $curAgent ($agentregistry->object_list) {
		my %loc2 = %$locvarhash;
		$loc2{agent_id} = $curAgent->get_attribute("id");
		$loc2{agent}	= $curAgent;
		push @pre_potential_owners, $curAgent if (evaluate_constraints($constraints, ["fixed"], [0,2], \%loc2, $verbose) == 1);
	}
	print $observationregistry->counter(). " endowment observations to distribute among ".scalar @pre_potential_owners. " agents\n" if $verbose;
	for my $curEndow (sort {$a->get_attribute("DEL_priority") <=> $b->get_attribute("DEL_priority")} $observationregistry->object_list()) {
		my $no_restriction_applied = 0;
		my %loc = %$locvarhash;
		$loc{observation_id} = $curEndow->get_attribute("id");
		$loc{observation}	= $curEndow;
		print "Trying to distribute ".$curEndow->get_attribute("DEL_count")." unit(s) of ". $curEndow->get_attribute("id")."\n" if ($verbose == 2);
		my @potential_owners;
		## compile list of potential owners based on fixed observation specific and all dynamic constraints if exist
		if (exists $constraints->{dynamic} or exists $constraints->{fixed}->{1} or exists $constraints->{fixed}->{3}) {
			AGENTLOOP: foreach my  $curAgent (@pre_potential_owners) {
				my %loc2 = %loc;
				$loc2{agent_id} = $curAgent->get_attribute("id");
				$loc2{agent}	= $curAgent;
				push @potential_owners, $curAgent if (evaluate_constraints($constraints, ["dynamic"], [0,1,2,3], \%loc2, $verbose) == 1 and evaluate_constraints($constraints, ["fixed"], [1,3], \%loc2, $verbose) == 1);
			}
		}
		else {
				$no_restriction_applied = 1;
				@potential_owners = @pre_potential_owners;
		}
		print scalar @potential_owners . " potential owners\n" if ($verbose == 2);
		## distribute as many as indicated by DEL_count attribute
		while ($curEndow->get_attribute("DEL_count") > 0) {
			if (@potential_owners <= 0) {
				print "\e[K \r\nNot assigned ".$curEndow->get_attribute("id"). " ".$curEndow->get_attribute("DEL_count")."\n" ;
				$notassigned->add_objects($curEndow);
				last;			
			}	
			###Random draw from potential agents
			my $draw = int(rand(@potential_owners));
			my $agent_to_assign_to = $potential_owners[$draw];
				
			my %loc2 = %loc;
			$loc2{agent_id} = $agent_to_assign_to->get_attribute("id");
			$loc2{agent}	= $agent_to_assign_to;
			do_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
			do_hhmember_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
			do_post_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
			
			$curEndow->add_to_attribute("DEL_count", -1); 
			
			if ( not $curEndow->get_attribute("DEL_accumulate")   or (exists ($constraints->{dynamic}) && evaluate_constraints($constraints, ["dynamic"], [0,1,2,3], \%loc2, $verbose) == 0 ) ) {
				my @lower = @potential_owners[0..$draw -1 ];
				my @upper = @potential_owners[$draw + 1 .. $#potential_owners];
				@potential_owners = (@lower, @upper);
			}
			if (defined $curEndow->get_attribute("DEL_exclusive")  and $curEndow->get_attribute("DEL_exclusive") == 1) {
				my $index;
				if ($no_restriction_applied) {
					  $index = $draw;
				}
				else {
					  foreach my $i (0..$#pre_potential_owners) {
						if ($pre_potential_owners[$i]->id() == $loc2{agent_id}) {
							$index = $i; 
							last;
						}
					  }
				}
				my @plower = @pre_potential_owners[0..$index -1 ];
				my @pupper = @pre_potential_owners[$index + 1 .. $#pre_potential_owners];
				@pre_potential_owners = (@plower, @pupper);
			}
		}
	}
}
sub assign_by_cdf {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	my @prepre_potential_owners;
	## compile a first list of potential owners based on fixed and not observation_specific contraints
	AGENTLOOP: foreach my  $curAgent ($agentregistry->object_list) {
		my %loc2 = %$locvarhash;
		$loc2{agent_id} = $curAgent->get_attribute("id");
		$loc2{agent}	= $curAgent;
		push @prepre_potential_owners, $curAgent if (evaluate_constraints($constraints, ["fixed"], [0,2], \%loc2, $verbose) == 1);
	}
	my @standard;
	my @ensure;#
	print "No suitable agents left after applying fixed constraints\n" and return unless (scalar @prepre_potential_owners > 0);
	for my $curEndow ( $observationregistry->object_list()) {
		&prepare_icdf($curEndow);
		$curEndow->get_attribute("CDF_cdf")->qf_plot("@$clu"."_".$curEndow->get_attribute("id").".png") if ($verbose > 4 );
		$curEndow->get_attribute("CDF_cdf")->print_points() if ($verbose > 4);

		if (defined $curEndow->get_attribute("CDF_ensure_full") and $curEndow->get_attribute("CDF_ensure_full") ) {
			push @ensure, $curEndow;
		}
		else {
			push @standard, $curEndow;
		}
	}
	if (@ensure > 0) {
		for my $curEndow (sort { $a->get_attribute("CDF_priority") <=> $b->get_attribute("CDF_priority") } @ensure) {
			my @pre_potential_owners;
			  ## reduce list of potential owners based on fixed and  observation_specific contraints
				AGENTLOOP: foreach my  $curAgent (@prepre_potential_owners) {
				  my %loc2 = %$locvarhash;
				  $loc2{agent_id} = $curAgent->get_attribute("id");
				  $loc2{agent}	= $curAgent;
				  push @pre_potential_owners, $curAgent if (evaluate_constraints($constraints, ["fixed"], [0,2], \%loc2, $verbose) == 1);
				}
			my $lbatt =  $curEndow->get_attribute("CDF_part_lb_attribute");
			my $ubatt =  $curEndow->get_attribute("CDF_part_ub_attribute");
			my $binsize =  0.2;
			$binsize = $curEndow->get_attribute("CDF_ensure_binsize") if (defined $curEndow->get_attribute("CDF_ensure_binsize"));
			my %loc = %$locvarhash;
			$loc{observation_id} = $curEndow->get_attribute("id");
			$loc{observation}	= $curEndow;
			
			my $plevels = predraw_from_uniform(\@pre_potential_owners, $lbatt, $ubatt);
			my @levels = @$plevels;
			if ($curEndow->get_attribute("CDF_ensure_skip_zero") ) {
				@levels =();
				foreach (@$plevels) {
				  push @levels, $_ unless ($curEndow->get_attribute("CDF_cdf")->qf($_) == 0);
				}
			}
			my $N = scalar @pre_potential_owners;
			#my $eps =  1.001 / $N;
			#print "EPS: $eps\n";
			#foreach my $i (1..$N) {
			#    push @levels, ($i  / $N) ;
			#}
			print $curEndow->get_attribute("id").": Distribute ". scalar @levels." levels among ". scalar @pre_potential_owners. " potential_owners\n" if $verbose;
			my $sign =   $curEndow->get_attribute("CDF_ensure_full_sorting") || 1;
			my $maxstage =  (defined  $curEndow->get_attribute("CDF_ensure_max_attempts")) ? ( $curEndow->get_attribute("CDF_ensure_max_attempts") - 1 ) : 0  ;
			my @missed_levels;
			my $last_missed;
			for my $stage (0 ..$maxstage) {
				my @stack;
				if ($stage == 0) {
					if ($curEndow->get_attribute("CDF_ensure_full_shuffle")) {
						@stack = @levels;
					}
					else {
						@stack = sort {$b * $sign <=> $a * $sign} @levels;
					}
				}
				else {
					@stack = @missed_levels;
					undef $last_missed;
					undef @missed_levels;
				}
				foreach my $l ( @stack ) {
					$l = 1 if ($l > 1);
					$curEndow->set_attribute("CDF_value_assigned", $curEndow->get_attribute("CDF_cdf")->qf($l) );
					my $no_restriction_applied = 0;
					my @potential_owners;
					
					## compile list of potential owners based on fixed observation specific and all dynamic constraints if exist
					if (defined $last_missed and $curEndow->get_attribute("CDF_value_assigned") == $last_missed) {
						print "Skipping $l --> ".$curEndow->get_attribute("CDF_value_assigned")."\n";
					}
					elsif (defined $lbatt or defined $ubatt or exists $constraints->{dynamic} or exists $constraints->{fixed}->{1} or exists $constraints->{fixed}->{3} ) {
						
						AGENTLOOP: foreach my  $curAgent (@pre_potential_owners) {
							if (defined $lbatt or defined $ubatt){
							my $lb = -1;
							my $ub = -1;
							$lb = $curAgent->get_attribute($lbatt)  / 100 if (defined $lbatt and defined $curAgent->get_attribute($lbatt) );
							$ub = $curAgent->get_attribute($ubatt)  / 100 if (defined $ubatt and defined $curAgent->get_attribute($ubatt) );
							if ($ub == -1 or $lb == -1) {
								next unless ($stage == 1);
								$ub = 1;
								$lb = 0;  
							}
							next unless ($l >= $lb  and $l <= $ub );
							}
							my %loc2 = %loc;
							$loc2{agent_id}	= $curAgent->get_attribute("id");
							$loc2{agent}	= $curAgent;
							$loc2{attempt}	= $stage +1;	
							push @potential_owners, $curAgent if (evaluate_constraints($constraints, ["dynamic"], [0,1,2,3], \%loc2, $verbose) == 1 and evaluate_constraints($constraints, ["fixed"], [1,3], \%loc2, $verbose) == 1);
						}
					}
					else {
							$no_restriction_applied = 1;
							@potential_owners = @pre_potential_owners;
					}
					#print $curEndow->get_attribute("id")." $l :".$curEndow->get_attribute("CDF_value_assigned"). " : ". scalar @potential_owners."\n";
					
					
					if (@potential_owners <= 0) {
						print "Not assigned ".$curEndow->get_attribute("id"). " $l -> ". $curEndow->get_attribute("CDF_value_assigned")."\n" if $verbose;
						push @missed_levels, $l;
						$last_missed = $curEndow->get_attribute("CDF_value_assigned");
						next;			
					}	
					###Random draw from potential agents
					my $draw = int(rand(@potential_owners));
					my $agent_to_assign_to = $potential_owners[$draw];
						
					my %loc2 = %loc;
					$loc2{agent_id} = $agent_to_assign_to->get_attribute("id");
					$loc2{agent}	= $agent_to_assign_to;
					do_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
					do_hhmember_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
					do_post_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
					my $index;
					if ($no_restriction_applied) {
							$index = $draw;
					}
					else {
						foreach my $i (0..$#pre_potential_owners) {
						  if ($pre_potential_owners[$i]->id() == $loc2{agent_id}) {
							  $index = $i; last;
						  }
						}
					}
					my @plower = @pre_potential_owners[0..$index -1 ];
					my @pupper = @pre_potential_owners[$index + 1 .. $#pre_potential_owners];
					@pre_potential_owners = (@plower, @pupper);
				}
				print "Missed ".scalar @missed_levels. " levels.\n";
			}
	  }
	}
	if (@standard > 0) {
		  foreach my  $curAgent (@prepre_potential_owners) {
			  my %loc = %$locvarhash;
			  $loc{agent_id} = $curAgent->get_attribute("id");
			  $loc{agent}	= $curAgent;
			  
			  for my $curEndow (sort { $a->get_attribute("CDF_priority") <=> $b->get_attribute("CDF_priority") } $observationregistry->object_list()) {
				  
				  my %loc2 = %loc;
				  $loc2{observation_id} = $curEndow->get_attribute("id");
				  $loc2{observation}	= $curEndow;
				  my $lb = 0;
				  my $ub = 1;
				  my $lbatt =  $curEndow->get_attribute("CDF_part_lb_attribute");
				  my $ubatt =  $curEndow->get_attribute("CDF_part_ub_attribute");
				  $lb = $curAgent->get_attribute($lbatt)  / 100 if (defined $lbatt and defined $curAgent->get_attribute($lbatt) );
				  $ub = $curAgent->get_attribute($ubatt)  / 100 if (defined $ubatt and defined $curAgent->get_attribute($ubatt) );
	  
				  
				  #skip observation if constraints for lowest assignment > 0 are not fulfilled
				  if ($curEndow->get_attribute("CDF_skip_if_lowest_not_possible") ) {
					  $curEndow->set_attribute("CDF_value_assigned", $curEndow->get_attribute("CDF_cdf")->lowest_nonzero() );
					  next unless (evaluate_constraints($constraints, ["dynamic"], [0,1,2,3], \%loc2, $verbose) == 1 and evaluate_constraints($constraints, ["fixed"], [1,3], \%loc2, $verbose) == 1);
					  $curEndow->set_attribute("CDF_value_assigned", undef );
					}
				  my $maxit =  $curEndow->get_attribute("CDF_maxiterations") || 30;
				  my $it = 0;
				  while ($it++ < $maxit) {	
					  $curEndow->set_attribute("CDF_value_assigned", undef );
					  my $size_drawn = draw_value_from_cdf($curEndow->get_attribute("CDF_cdf"), $lb, $ub);
					  $curEndow->set_attribute("CDF_value_assigned", $size_drawn);
					  next unless (evaluate_constraints($constraints, ["dynamic"], [0,1,2,3], \%loc2, $verbose) == 1 and evaluate_constraints($constraints, ["fixed"], [1,3], \%loc2, $verbose) == 1);
					  do_assignment($disinfo, $curAgent, $curEndow,  \%loc2, $verbose);
					  do_hhmember_assignment($disinfo, $curAgent, $curEndow,  \%loc2, $verbose);
					  do_post_assignment($disinfo, $curAgent, $curEndow,  \%loc2, $verbose);
					  
					  last;
				  }	
				  $curEndow->set_attribute("CDF_value_assigned", undef );
				  
			  }
		  
		  }	
	}

}	
sub fixed {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	#fixed assignment for all agents that satisfy constraints
	foreach my  $curAgent ($agentregistry->object_list) {
		my %loc = %$locvarhash;
		$loc{agent_id} = $curAgent->get_attribute("id");
		$loc{agent}	= $curAgent;
		next unless (evaluate_constraints($constraints, [("dynamic", "fixed")], [(0,1,2,3)], \%loc, $verbose) == 1 );
		do_assignment($disinfo, $curAgent, undef,  \%loc, $verbose);
		do_hhmember_assignment($disinfo, $curAgent, undef,  \%loc, $verbose);
		do_post_assignment($disinfo, $curAgent, undef,  \%loc, $verbose);
	}
}
sub fixed_repeated {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	#fixed assignment for all agents that satisfy constraints
	foreach my  $curAgent ($agentregistry->object_list) {
		my %loc = %$locvarhash;
		$loc{agent_id} = $curAgent->get_attribute("id");
		$loc{agent}	= $curAgent;
		next unless (evaluate_constraints($constraints, [("fixed")], [(0,1,2,3)], \%loc, $verbose) == 1 );
		while (evaluate_constraints($constraints, [("dynamic")], [(0,1,2,3)], \%loc, $verbose) == 1) { 
			do_assignment($disinfo, $curAgent, undef,  \%loc, $verbose);
			do_hhmember_assignment($disinfo, $curAgent, undef,  \%loc, $verbose);
			do_post_assignment($disinfo, $curAgent, undef,  \%loc, $verbose);
		}
	}
}
sub fit_into_subarea {
	  my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	  if (not defined $disinfo->{SUBAREAS}->{list} or $disinfo->{SUBAREAS}->{list} =~ /^\s*$/) {
		  unless ($subarearegistry->counter > 0){
		  print STDERR "Error: You did not provide a SUBAREA list for STEP $d\n";
		  exit(1); 
		  }
	  }
	  
	  elsif ($disinfo->{SUBAREAS}->{list} =~ /^\s*RESTORE\s+(.*)$/)  {
		  my $fn = MpmasQLFunctionLanguage->convert($1,$locvarhash);
		  $subarearegistry = SimpleObjectRegistry->recreate($fn);
		  print "SUBAREAS restored from $fn\n";
	  }
	  else {
		  $subarearegistry->clear();
		  my @subarealist = MpmasQLFunctionLanguage->convert($disinfo->{SUBAREAS}->{list},$locvarhash);
		  #next unless (defined $subarealist[0]);
		  map { my $eid = $_; my $subarea = SimpleObject->create(id => $eid); $subarearegistry->add_objects($subarea); } @subarealist
	  }
	  my %obs_in_area;
	  for my $curArea ($subarearegistry->object_list()) {
		  $obs_in_area{$curArea->get_attribute("id")} = SimpleObjectRegistry->create();
		  my %locvars1  = %$locvarhash;
		  $locvars1{area_id} = $curArea->get_attribute("id");
		  $locvars1{area} = $curArea;
		  for my $i (0..$#{$disinfo->{SUBAREAS}->{lines}}) {
			  my ($field, $content) = split /\s*#=\s*/, $disinfo->{SUBAREAS}->{lines}->[$i];
			  $|=1;
			  my ($keys, $fors) = MpmasQLFunctionLanguage->translate_and_interprete($field,\%locvars1);
			  for my $j (0..$#{$keys}) {		
				  my %locvars2  = %locvars1;		
				  $locvars2{attribute} = $fors->[$j];
				  $curArea->set_attribute($keys->[$j], MpmasQLFunctionLanguage->convert($content,\%locvars2) || 0 );
			  }
		  }
	  }		
	  
	  for my $o ($observationregistry->object_list() ) {
		  my $x = $o->get_attribute("FIT_subarea");
		  
		  print STDERR "Observation ". $o->get_attribute("id"). " is missing the FIT_subarea attribute!\n" and exit(1) unless (defined $x);
		  print STDERR "Observation ". $o->get_attribute("id"). " is supposed to lie in subarea $x, which does not exist!\n" and exit(1) unless (exists $obs_in_area{$x});
		  $obs_in_area{$x}->add_objects($o);
	
	  }
	  print STDERR "SUBAREA_CONSTRAINED_FIELDS not defined or empty\n" and exit(1) unless defined ($disinfo->{SUBAREA_CONSTRAINED_FIELDS});
	  my @areafields = MpmasQLFunctionLanguage->convert($disinfo->{SUBAREA_CONSTRAINED_FIELDS},{});
	  print "@areafields\n" if $verbose > 1;

	  my @agents_without_match;
	  my @agentlist = sort {$a->get_attribute("FIT_priority") <=> $b->get_attribute("FIT_priority")} $agentregistry->object_list();
	  MTCAGLOOP: while  (@agentlist) {
		my $curAgent = shift @agentlist;
		$curAgent->set_attribute("FIT_split",0);
		my %loc = %$locvarhash; 
		$loc{agent_id} = $curAgent->get_attribute("id");
		$loc{agent}	= $curAgent;
		if (defined $disinfo->{DO_NOT_MATCH_IF}) {
		for my $j (0..$#{$disinfo->{DO_NOT_MATCH_IF}->{lines}}) {
				  my $L = $disinfo->{DO_NOT_MATCH_IF}->{lines}->[$j];
				  next if ($L =~ /^\s*$/);
				  next MTCAGLOOP if MpmasQLFunctionLanguage->convert($L, \%loc ) ;	
		}
		}
		my @potential_observations;
		my $predef_s = $curAgent->get_attribute("FIT_subarea");
		unless ( defined $predef_s ) {
		  $curAgent->set_attribute("FIT_second", 0);
		  SUBSEARCH: for my $s ($subarearegistry->object_list()) {
			  for my $f (@areafields) {
			  print STDERR "Attribute $f not found for agent ". $curAgent->id."\n" and exit(1) unless (defined  $curAgent->get_attribute("$f"));
			  print STDERR "Attribute $f not found for subarea ". $s->get_attribute("id")."\n"  and exit(1) unless (defined  $s->get_attribute("$f"));
			  next SUBSEARCH if ($curAgent->get_attribute("$f") > $s->get_attribute("$f") );
			  }  
			  push @potential_observations, $obs_in_area{ $s->get_attribute("id") }->object_list;
		  }
		}
		else {
		   $curAgent->add_to_attribute("FIT_second", 1);
		   push @potential_observations, $obs_in_area{ $predef_s }->object_list;

		}
		if (scalar @potential_observations == 0 ) {
			push (@agents_without_match, $curAgent) and print "No match for agent ". $curAgent->id." (no subarea with capacity)\n" unless $curAgent->get_attribute("FIT_second");
			next ; 
		}
		my %agglikelihoods;
		my $sum_of_likelihoods = 0;
		
		
		foreach my $curEndow (@potential_observations) {
					my %loc2 = %loc;
					$loc2{observation_id} = $curEndow->get_attribute("id");
					$loc2{observation}	= $curEndow;
					#calculate likelihoods
					$agglikelihoods{ $curEndow->get_attribute("id")} = 1;
					
					for my $j (0..$#{$disinfo->{LIKELIHOODS}->{lines}}) {
					  my $L = $disinfo->{LIKELIHOODS}->{lines}->[$j];
					  next if ($L =~ /^\s*$/);
					  my $res = MpmasQLFunctionLanguage->convert($L, \%loc2 ) ;	
					  
					  $agglikelihoods{ $curEndow->get_attribute("id")} *= $res;
					}
					$sum_of_likelihoods += $agglikelihoods{$curEndow->get_attribute("id")};
		}
	my @obs_drawn;
	if ($sum_of_likelihoods > 0) {
		  my $curEndow = fit_into_subarea_draw (\@potential_observations, \%agglikelihoods, $observationregistry, $sum_of_likelihoods);
		  push @obs_drawn, $curEndow;
		  $obs_in_area{$curEndow->get_attribute("FIT_subarea")}->delete_objects($curEndow);
	}
	elsif (defined $disinfo->{AGENT_SPLIT_ATTRIBUTES}) {
		my @splitattributes = MpmasQLFunctionLanguage->convert($disinfo->{AGENT_SPLIT_ATTRIBUTES}, {} );
		my $matchfound = 0;
		my @agent_parts = ($curAgent);
		
		SPLITLOOP: while (scalar @agent_parts <= $disinfo->{MAX_SPLIT}) {
			  print "Split round ". scalar @agent_parts ."\n" if ($verbose > 2);
			  my $smallsh = rand(.5);
			  my $largesh = 1 -$smallsh;
			  @agent_parts = sort {$b->get_attribute($splitattributes[0]) <=> $a->get_attribute($splitattributes[0]) } @agent_parts;
			  my $to_split = shift @agent_parts;
			  my $largepart = $to_split->create_copy();
			  my $smallpart = $to_split->create_copy();
			  $largepart->set_attribute("FIT_split",1);
			  $smallpart->set_attribute("FIT_split",1);
			  foreach (@splitattributes) {
			  $largepart->set_attribute($_, $to_split->get_attribute($_) * $largesh);
			  $smallpart->set_attribute($_, $to_split->get_attribute($_) * $smallsh);
			  }
			  push @agent_parts, $largepart;
			  push @agent_parts, $smallpart;
			  #print "Parts:";
			  #foreach (@agent_parts) {print $_->get_attribute("water")." ";};
			  #print "\n";
			  my %agglikelihoods;
			  my %sum_of_likelihoods_per_sector_per_part;
		
		
			  foreach my $curEndow (@potential_observations) {
				
				my %loc2 = %loc;
				$loc2{observation_id} = $curEndow->get_attribute("id");
				$loc2{observation}	= $curEndow;
				#calculate likelihoods
				
				foreach my $p (0..$#agent_parts) {
					$agglikelihoods{$p}->{ $curEndow->get_attribute("id")} = 1;
					my %loc3 = %loc2;
					$loc3{agent_id} = $agent_parts[$p]->get_attribute("id");
					$loc3{agent}	= $agent_parts[$p];
					for my $j (0..$#{$disinfo->{LIKELIHOODS}->{lines}}) {
						  my $L = $disinfo->{LIKELIHOODS}->{lines}->[$j];
						  next if ($L =~ /^\s*$/);
						  my $res = MpmasQLFunctionLanguage->convert($L, \%loc3 ) ;	
						  
						  $agglikelihoods{$p}->{ $curEndow->get_attribute("id")} *= $res;
					}
					my $sec =  $curEndow->get_attribute("FIT_subarea");
					$sum_of_likelihoods_per_sector_per_part{$sec}->{$p} = 0 if (not exists $sum_of_likelihoods_per_sector_per_part{$sec}->{$p});
					$sum_of_likelihoods_per_sector_per_part{$sec}->{$p} += $agglikelihoods{$p}->{$curEndow->get_attribute("id")};
				}
			  }
			  my @secs_with_likelihood_for_all;
			  #print Dumper(\%sum_of_likelihoods_per_sector_per_part);
			  O1: foreach my $sec (keys %sum_of_likelihoods_per_sector_per_part) {
				O2: foreach my $p (keys %{$sum_of_likelihoods_per_sector_per_part{$sec}} ) {  
					next O1 if  ($sum_of_likelihoods_per_sector_per_part{$sec}->{$p} <= 0);
				}
				 push @secs_with_likelihood_for_all, $sec;
			  }
			  next SPLITLOOP unless (scalar @secs_with_likelihood_for_all > 0);
			  print "Sectors: @secs_with_likelihood_for_all\n" if ($verbose > 2);
			  my @obs_in_sec_with_likelihood_for_all;
			  my %sum_of_likelihoods_per_part;
			  for my $sec (@secs_with_likelihood_for_all){
				  push @obs_in_sec_with_likelihood_for_all, $obs_in_area{ $sec }->object_list;
				  
			  }
			  my $firstEndow = fit_into_subarea_draw (\@obs_in_sec_with_likelihood_for_all ,$agglikelihoods{0}, $observationregistry, undef());
			  my $sec =  $firstEndow->get_attribute("FIT_subarea");
			  push @obs_drawn, $firstEndow;
			  $obs_in_area{$sec}->delete_objects($firstEndow);
			  
			  foreach my $p (1..$#agent_parts) {
				my $othEndow = fit_into_subarea_draw ( [$obs_in_area{ $sec }->object_list] ,$agglikelihoods{$p}, $observationregistry, undef());
				if (not defined $othEndow) {  
					$obs_in_area{$sec}->add_objects(@obs_drawn);
				@obs_drawn = ();
				next SPLITLOOP
				}
				
				push @obs_drawn, $othEndow;
				$obs_in_area{$sec}->delete_objects($othEndow);
			  }
			  $matchfound = 1;
			  last SPLITLOOP;
		}
		unless ($matchfound) {
			push (@agents_without_match, $curAgent) and print "No match for agent ". $curAgent->id." (reached MAX_SPLIT)\n" if (not $curAgent->get_attribute("FIT_second")); 
			  next MTCAGLOOP;
		}
	}
	else {
		push (@agents_without_match, $curAgent) and print "No match for agent ". $curAgent->id." (no positive likelihoods in subareas with capacity)\n" if (not $curAgent->get_attribute("FIT_second")); 
		next MTCAGLOOP;
	}
	foreach my $o (0..$#obs_drawn) {
		  my $curEndow = $obs_drawn[$o];
		  my %loc2 = %loc;
		  $loc2{observation_id} = $curEndow->get_attribute("id");
		  $loc2{observation}	= $curEndow;
		  do_assignment($disinfo, $curAgent, $curEndow,  \%loc2, $verbose);
		  do_hhmember_assignment($disinfo, $curAgent, $curEndow,  \%loc2, $verbose);
		  do_post_assignment($disinfo, $curAgent, $curEndow,  \%loc2, $verbose);
		  $curAgent->set_attribute( "FIT_match_$o", $loc2{observation_id}  );
		  my $s = $curEndow->get_attribute("FIT_subarea");
		  if ($o == 0) {
			
			$curAgent->set_attribute("FIT_subarea", $s);
			my $subarea = $subarearegistry->get_object_by_id($s);
			for my $f (@areafields) {
				$subarea->add_to_attribute("$f", -1 *  $curAgent->get_attribute("$f"));
			}
			
		  }
		  print join("\t",$curAgent->id, $curEndow->get_attribute("id"), $s)."\n" if $verbose;
		  
	   }
	  } ##END MTCAGLOOP
	  print "Remaining capacities in subareas:\n";
	  foreach my $s (sort {$a->get_attribute("id") <=>  $b->get_attribute("id")} $subarearegistry->object_list  ) {
		print $s->get_attribute("id");
		for my $f (@areafields) {
			 print "\t".$s->get_attribute("$f");
		}
		print "\n";
		$notassigned->add_objects($obs_in_area{$s->get_attribute("id")}->object_list() )
	  
	  }
}
sub match_cdf {
	&match(@_);
}
sub match {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	
	my %likelihood_lines;
	for my $j (0..$#{$disinfo->{LIKELIHOODS}->{lines}}) {
		my $i = $disinfo->{LIKELIHOODS}->{lines}->[$j];
		my ($Ldim, $L) = split (/\s*#=\s*/, $i, 2 );
		my $translated = MpmasQLFunctionLanguage->translate_to_perl($L) ;
		$likelihood_lines{$Ldim} = $translated;
	}
	my @all_agents;
	AGENTLOOP: foreach my  $curAgent ($agentregistry->object_list) {
		my %loc2 = %$locvarhash;
		$loc2{agent_id} = $curAgent->get_attribute("id");
		$loc2{agent}	= $curAgent;
		push @all_agents, $curAgent if (evaluate_constraints($constraints, ["fixed"], [0,2], \%loc2, $verbose) == 1);
	}
	
	if (defined $disinfo->{SORT} ) {
		@all_agents = sort {$b->get_attribute($disinfo->{SORT}) <=> $a->get_attribute($disinfo->{SORT}) } @all_agents;
	}
	my %match_regions;
	my $parent_observation;
	if ($disinfo->{TYPE} eq "match_cdf") {
		my @xx = $observationregistry->object_list();
		my $curEndow =  $xx[0];
		$parent_observation =  $xx[0];
		&prepare_icdf($curEndow);
		my $lbatt =  $curEndow->get_attribute("CDF_part_lb_attribute");
		my $ubatt =  $curEndow->get_attribute("CDF_part_ub_attribute");
		my $binsize =  0.2;
		$binsize = $curEndow->get_attribute("CDF_ensure_binsize") if (defined $curEndow->get_attribute("CDF_ensure_binsize"));
		my %bins;
		for my $mr (1..1/$binsize) {
			next unless ( $curEndow->get_attribute("CDF_cdf")->qf( ($mr + 1) * $binsize ) > 0 or $mr == 1 / $binsize);
			$bins{$binsize * 100 *$mr} = $binsize * 100 *$mr;
			$match_regions{$binsize * 100 *$mr}->{agents} = [];
			$match_regions{$binsize * 100 *$mr}->{observations} = [];
		}
		for my $ag (@all_agents) {
			push @{$match_regions{ determine_class_by_upperbound(\%bins,  $ag->get_attribute($ubatt) ) }->{agents} }, $ag;
		}
		my $levels = predraw_from_uniform(\@all_agents, $lbatt, $ubatt);	
		my $c = 0;
		foreach my $l (@$levels) {
				$l = 1 if ($l > 1);
				my $newobservation = SimpleObject->create(id => $c++); 
				$newobservation->set_attribute("CDF_quantile",$l);
				$newobservation->set_attribute("CDF_value_assigned", $curEndow->get_attribute("CDF_cdf")->qf($l) );
				push @{ $match_regions{determine_class_by_upperbound(\%bins, $l*100)}->{observations} }, $newobservation;
		}	    
		  
		  
	}
	else {
		  $match_regions{0}->{observations} = $observationregistry->object_list();
		  $match_regions{0}->{agents} = @all_agents;
	}
	
	foreach my $mr (sort {$b <=> $a} keys %match_regions) {
		my @observations = @{ $match_regions{$mr}->{observations} };
		my @sorted_agents = @{ $match_regions{$mr}->{agents} };
		my %likelihoods;
		my %aggloglikelihoods;
		print "Match region $mr\n";
		print "Obs: ". scalar @observations. ", Ags: ". scalar @sorted_agents ."\n";
		print "Calculating likelihoods...\n";
		foreach my  $curAgent (@sorted_agents) {
			my %loc = %$locvarhash; 
			$loc{agent_id} = $curAgent->get_attribute("id");
			$loc{agent}	= $curAgent;
			OLOOP: foreach my $curEndow (@observations) {
				my %loc2 = %loc;
				$loc2{observation_id} = $curEndow->get_attribute("id");
				$loc2{observation}	= $curEndow;
				#calculate likelihoods
				$aggloglikelihoods{ $curEndow->get_attribute("id")}-> {$curAgent->get_attribute("id")} = 0;
				for my $j (keys %likelihood_lines) {
					  my $res = MpmasQLFunctionLanguage->convert($likelihood_lines{$j}, \%loc2 , 1) ;	
					  $likelihoods{$j}->{ $curEndow->get_attribute("id")}-> {$curAgent->get_attribute("id")} = $res;
					if ( $res == 0) {
						$aggloglikelihoods{ $curEndow->get_attribute("id")}-> {$curAgent->get_attribute("id")} = undef;
						last;
					}
					$aggloglikelihoods{ $curEndow->get_attribute("id")}-> {$curAgent->get_attribute("id")} += log ($res);
				}
			}
		}
		if ($verbose >= 3) {
			  foreach my $l (keys %likelihoods) {
				foreach my $i (keys %{$likelihoods{$l}} ) { 
					foreach my $j (keys %{$likelihoods{$l}->{$i}} ) { 
					  print join ("\t", $l, $i, $j, $likelihoods{$l}->{$i}->{$j}) ."\n"; 
					}
				}
			  }
		}
		my %sumlikelihood;
		foreach my $i (keys %aggloglikelihoods ) { 
			foreach my $j (keys %{$aggloglikelihoods{$i}} ) { 
				$sumlikelihood{$j} +=  exp($aggloglikelihoods{$i}->{$j}) if ( defined $aggloglikelihoods{$i}->{$j});
			}
		}
		if ($verbose >= 2) {
			  print "obs\tagent\tlogL\tL\tP\n";
			  foreach my $i (keys %aggloglikelihoods ) { 
				  foreach my $j (keys %{$aggloglikelihoods{$i}} ) { 
					  if ( defined $aggloglikelihoods{$i}->{$j}) {
					print join ("\t", $i, $j, $aggloglikelihoods{$i}->{$j}, exp($aggloglikelihoods{$i}->{$j}), exp($aggloglikelihoods{$i}->{$j}) /$sumlikelihood{$j} ) ."\n"; 
					  }
					  else {
					print join ("\t", $i, $j, "N/A", 0, 0 ) ."\n"; 
					  }
				  }
			  }
		}
		if ($disinfo->{MATCHING} eq "max_milp") {
			  my $milp = MpmasMILP->adhoc_create();
			  if (defined $disinfo->{PERTURB_EQPROB} and $disinfo->{PERTURB_EQPROB} eq "1") {
			  

			  }
			  my $failflag = 0;
			  my @agents_left;
			  foreach my  $curAgent (@sorted_agents) {
				my @potentials = grep{ defined $aggloglikelihoods{$_}->{$curAgent->id} }  keys %aggloglikelihoods;
				print $curAgent->id."\t@potentials\n" if $verbose;
				if ( scalar @potentials == 0) {
					$failflag = 1 if (uc($disinfo->{ON_AGENTS_LEFT}) eq "FAIL") ;
					push @agents_left , $curAgent->id;
					next if (uc($disinfo->{ON_AGENTS_LEFT}) eq "FAIL" or uc($disinfo->{ON_AGENTS_LEFT}) eq "REPORT");
				}
				
				$milp->adhoc_add_constraint(
					"const_agent_".$curAgent->id,{
					name => "const_agent_".$curAgent->id,
					eqtype => 3,
					value => 1});
			  }
			if ($failflag) {
			  print STDERR "There are agents without any potential match among the observations:\n";
			  print join(",", @agents_left)."\n";
			  exit(1);
			} 
			elsif ( scalar @agents_left > 0 ) {
			  print "There are agents without any potential match among the observations:\n";
			  print join(",", @agents_left)."\n";
			}
			  foreach my $i (keys %aggloglikelihoods ) { 
				$milp->adhoc_add_constraint(
					"const_obs_$i",{
					name => "const_obs_$i",
					eqtype =>  1,
					value => 1});
				foreach my $j (keys %{$aggloglikelihoods{$i}} ) { 
				if ( defined $aggloglikelihoods{$i}->{$j}) {
					  $milp->adhoc_add_activity(
						  $i."_".$j,
						  {name => $i."_".$j,
						  integ => 1,
						  ubound => 1,
						  orow =>  $aggloglikelihoods{$i}->{$j},
						  "const_obs_$i" => 1,
						  "const_agent_$j" => 1}
					  )
				}
				elsif (defined $disinfo->{"ALLOW_BADMATCHES"} and $disinfo->{"ALLOW_BADMATCHES"} == 1) {
					  $milp->adhoc_add_activity(
						  $i."_".$j,
						  {name => $i."_".$j,
						  integ => 1,
						  ubound => 1,
						  orow =>  -1 * 10**15,
						  "const_obs_$i" => 1,
						  "const_agent_$j" => 1}
					  )
				}
				}
			  }
			  print "Started solving of maximization problem!\n";
			  $milp->adhoc_solve($milpcheck,1) or print STDERR "Solution failed!\n".$milp->adhoc_status_message()."\n"   and exit(1);
			  
			  print "agent\thhd\tchoice\n" if ($verbose);
			  foreach my $i ($milp->activities) {
				if ($i->get_attribute("solution") > 0 ) {
				$i->id =~ /(\d+)_(\d+)/;  
				print join("\t", $2,$1, $i->get_attribute("solution"))."\n" if ($verbose);
				my $agent_to_assign_to = $agentregistry->get_object_by_id($2);
				my $curEndow = $observationregistry->get_object_by_id($1);
				my %loc2 = %$locvarhash; 
				$loc2{observation_id} = $curEndow->get_attribute("id");
				$loc2{observation}	= $curEndow;
				$loc2{agent_id} = $agent_to_assign_to->get_attribute("id");
				$loc2{agent}	= $agent_to_assign_to;
				do_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
				do_hhmember_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
				do_post_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
				}
			  }

		}
		elsif ($disinfo->{MATCHING} eq "max_hungarian") {
			  my @match_matrix;
			  $disinfo->{USE_ZEROL_PENALTY} = INFTY unless (defined $disinfo->{USE_ZEROL_PENALTY});
			  my @match_column = sort {$a <=> $b } keys %aggloglikelihoods;
			  my $cct = 0;
			  foreach my $i (@match_column ) { 
				my $rct = 0;
				
				foreach my $j (@sorted_agents ) { 
				  $match_matrix[$rct++][$cct] = defined $aggloglikelihoods{$i}->{$j->id} ? -1 * $aggloglikelihoods{$i}->{$j->id} : $disinfo->{USE_ZEROL_PENALTY} ; 
				}
				$cct++;
			  }
			  if (defined $disinfo->{OBS_NONUSE_PENALTY_ATT}) {
			  my $diff =  scalar (keys (%aggloglikelihoods)) - scalar (@sorted_agents) ;
			  if ($diff > 0) {
				for my $j (0..$diff-1) {
					  for my $i (0..$#match_column) {
					my $obs = $observationregistry->get_object_by_id($match_column[$i]);
					my $val = $obs->get_attribute("$disinfo->{OBS_NONUSE_PENALTY_ATT}");
					die "Observation ". $obs->get_attribute("id"). " does not have a ". $disinfo->{OBS_NONUSE_PENALTY_ATT}. " attribute!\n" unless (defined $val);
					$match_matrix[ scalar (@sorted_agents) + $j][$i] = $val;
					  }
				}
			  }
			  }
			  my @match_result;
			  print "Start matching using Hungarian Algorithm (Kuhn, Munkres)\n";
			  use Algorithm::Munkres ();
			  Algorithm::Munkres::assign( \@match_matrix, \@match_result);
			  foreach my $j (0..$#sorted_agents) {
				  print $sorted_agents[$j]->id."\t$match_column[$match_result[$j]]\t".$aggloglikelihoods{$match_column[$match_result[$j]]}->{$sorted_agents[$j]->id}."\n" if $verbose;
				  my $agent_to_assign_to = $agentregistry->get_object_by_id($sorted_agents[$j]->id);
				my $curEndow = $parent_observation;
				my $lev;
				if ($disinfo->{TYPE} eq "match_cdf") {
					for my $o (@observations) {
					if ( $match_column[$match_result[$j]] == $o->id) {
						  $lev  = $o ;
						  last;
					}
					
					}
					print "Error: Matching observation $match_column[$match_result[$j]] not found!\n" and exit(1) unless (defined $lev);
					$curEndow->set_attribute("CDF_value_assigned", $lev->get_attribute("CDF_value_assigned") );
				}
				else {
					$curEndow  = $observationregistry->get_object_by_id($match_column[$match_result[$j]]);
				}
				my %loc2 = %$locvarhash; 
				$loc2{observation_id} = $curEndow->get_attribute("id");
				$loc2{observation}	= $curEndow;
				$loc2{agent_id} = $agent_to_assign_to->get_attribute("id");
				$loc2{agent}	= $agent_to_assign_to;
				do_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
				do_hhmember_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
				do_post_assignment($disinfo, $agent_to_assign_to, $curEndow,  \%loc2, $verbose);
			  }
			  print "Unused observations:\n" if $verbose;
			  foreach my $j ($#sorted_agents+1 .. $#match_result) {
				  print $match_column[$match_result[$j]]."\n" if $verbose;
			  }
		}
}
}
 sub maps_artificial {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	my %loc = %$locvarhash;

	my $cellsize	=	MpmasQLFunctionLanguage->convert($disinfo->{CELLSIZE},{});

	my @attr_to_distribute;
	foreach ( @{$disinfo->{SOILCODES}->{lines}}) {
		my ($attr,$suit) =  split /\s*#=\s*/, $_, 2;
		my ($attlist, $attfor) =  MpmasQLFunctionLanguage->translate_and_interprete($attr,\%loc);
		
		foreach my $k (0..$#{$attlist}) { 
				my %hash;
				$hash{field} = $attlist->[$k];
				my %loc2 = %loc;
				$loc2{attribute} = $attfor->[$k];
				$hash{soil_code} =  MpmasQLFunctionLanguage->convert($suit,\%loc2);

				push @attr_to_distribute, \%hash;
		} ;
	}

	my @soilarray;
	my @farmsteadarray;
	my @propertyarray;
	my $cellpointer = 0;
	for my $curAgent ($agentregistry->object_list ) {
		my $nplots;
		my @slist;
		for my $s (@attr_to_distribute) {
			my $n_of_s = sprintf("%.0f",$curAgent->get_attribute($s->{field}));
			push @soilarray, ($s->{soil_code}) x $n_of_s; 
			$nplots += $n_of_s;
		}
		if ($nplots > 0) { push @farmsteadarray, $curAgent->id, (-1) x ($nplots -1) };
		push @propertyarray, ($curAgent->id) x $nplots;
	}

	my $soilmap = EnhancedGrid->create_map_from_sequence(\@soilarray, $disinfo->{MAPHEIGTH},-1, "SOILMAP", $cellsize);
	my $fstmap = EnhancedGrid->create_map_from_sequence(\@farmsteadarray, $disinfo->{MAPHEIGTH},-1, "FARMSTEADMAP", $cellsize);
	my $propertymap = EnhancedGrid->create_map_from_sequence(\@propertyarray, $disinfo->{MAPHEIGTH},-1, "PROPERTYMAP", $cellsize);
	$mapregistry->add_or_replace_objects($soilmap);
	$mapregistry->add_or_replace_objects($fstmap);
	$mapregistry->add_or_replace_objects($propertymap);
}
sub make_secondary_maps_for_mpmas {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	my %loc = %$locvarhash;	
	my $farmsteadmap= $mapregistry->get_object_by_id("FARMSTEADMAP");
	my $propertymap= $mapregistry->get_object_by_id("PROPERTYMAP");

	my %reclass;
	for my $curAgent ($agentregistry->object_list ) {
		my $nplots;
		my @slist;
		for my $s ( qw(MASCluster MASPopulation MASNetwork MASSector MASCatchment) ) {
			my $c = $curAgent->get_attribute($s);
			print STDERR "Error when making Mpmas secondary maps: Attribute $s undefined for agent $curAgent\n" and exit(1) if (not defined $c);
			print STDERR "Error when making Mpmas secondary maps: Attribute $s is not numeric (= $c) for agent $curAgent\n" and exit(1) if (not looks_like_number($c));
			$reclass{$s}->{$curAgent->id} = $c;
		}
	}
	my $clumap = $farmsteadmap->create_copy_and_reclassify($reclass{"MASCluster"}, -1);
	my $popmap = $farmsteadmap->create_copy_and_reclassify($reclass{"MASPopulation"}, -1);
	my $netmap = $farmsteadmap->create_copy_and_reclassify($reclass{"MASNetwork"}, -1);
	my $secmap = $propertymap->create_copy_and_reclassify($reclass{"MASSector"}, -1);
	my $catchmap = $propertymap->create_copy_and_reclassify($reclass{"MASCatchment"}, -1);
	$clumap->set_id("CLUSTERMAP");
	$popmap->set_id("POPULATIONMAP");
	$netmap->set_id("NETWORKMAP");
	$secmap->set_id("SECTORMAP");
	$catchmap->set_id("CATCHMENTMAP");
	$mapregistry->add_or_replace_objects($clumap, $popmap, $netmap, $secmap, $catchmap);
}
sub maps_assign_farmstead {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	my %loc = %$locvarhash;

	print STDERR "Error: You need to specify MAP for maps_assign_farmstead\n" and exit(1) unless (exists $disinfo->{MAP});
	my $smapname = MpmasQLFunctionLanguage->convert($disinfo->{MAP},\%loc);
	my $suitabilitymap = $mapregistry->get_object_by_id($smapname);
	print STDERR "Unknown MAP: $smapname\n" and exit(1) unless (defined $suitabilitymap);
	my $farmsteadmap= $mapregistry->get_object_by_id("FARMSTEADMAP");
	unless (defined $farmsteadmap ) {
		$farmsteadmap = $suitabilitymap->create_alike(-1);
		$farmsteadmap->reset_nodata_to(-1);
		$farmsteadmap->set_id("FARMSTEADMAP");
	}
	
	
	my %agentgroups;
	my %suits;
	if ($disinfo->{SUITABLE} =~ /#this\s*\(\s*agent/ ) { 
		
		for my $curAgent ($agentregistry->object_list ) {
			my %loc2 = %loc;
			$loc2{agent_id} = $curAgent->get_attribute("id");
			$loc2{agent}	= $curAgent;
			my @suitable = sort {$a <=> $b} MpmasQLFunctionLanguage->convert($disinfo->{SUITABLE},\%loc2);
			my $suitcode = join ("_", @suitable);
			push @{$agentgroups{$suitcode}}, $curAgent ;
			$suits{$suitcode} = \@suitable;
			#print "Agent $loc{agent_id} , suitcode $suitcode\n" if $verbose;
		}
	}
	
	else {
		my @suitable = sort {$a <=> $b} MpmasQLFunctionLanguage->convert($disinfo->{SUITABLE},\%loc);
		my $suitcode = join ("_", @suitable);
		$suits{$suitcode} = \@suitable;
		$agentgroups{$suitcode}=[( $agentregistry->object_list() )];
	}
	for my $suitcode (keys %agentgroups) {
		print "Distributing farmsteads to ". scalar ( @{ $agentgroups{$suitcode} }) ." agents of suitability group $suitcode\n" if $verbose;
		my $region = MasMapRegion->create();
		$region->add_agents(@{ $agentgroups{$suitcode}});
		$region->set_farmsteadmap($farmsteadmap);
		$region->distribute_farmsteads($suitabilitymap, $suits{$suitcode}, $verbose) or print STDERR "Could not assign a farmstead to all agents in $suitcode\n" and exit(1);
		
		#$region->farmsteadmap->save_as_ascii("testmap.txt");
		$farmsteadmap=  $region->farmsteadmap;
		
	}
	$mapregistry->add_or_replace_objects($farmsteadmap);
	for my $curAgent ($agentregistry->object_list() ) {
		my %loc2 = %loc;
		$loc2{agent_id} = $curAgent->get_attribute("id");
		$loc2{agent}	= $curAgent;
		do_post_assignment($disinfo, $curAgent, undef, \%loc2);
	}
	
}	
sub maps_assign_plots {
	my ($disinfo, $agentregistry, $observationregistry, $notassigned, $mapregistry, $subarearegistry, $locvarhash, $constraints, $verbose, $d, $clu) = @_;	
	
	my %loc = %$locvarhash;
	my $smapname = MpmasQLFunctionLanguage->convert($disinfo->{MAP},\%loc);
	
	my $suitabilitymap = $mapregistry->get_object_by_id($smapname);
	print STDERR "Unknown MAP: $smapname\n" and exit(1) unless (defined $suitabilitymap);
	$suitabilitymap->reset_nodata_to(-1);
	my $propertymap = $mapregistry->get_object_by_id("PROPERTYMAP");
	my $farmsteadmap= $mapregistry->get_object_by_id("FARMSTEADMAP");
	print STDERR "FARMSTEADMAP undefined\nYou need to distribute farmsteads before you can use maps_assign_plots\n" and exit(1) unless (defined $farmsteadmap);

	my @attr_to_distribute;
	foreach ( @{$disinfo->{SUITABLE}->{lines}}) {
		my ($attr,$suit) =  split /\s*#=\s*/, $_, 2;
		my ($attlist, $attfor) =  MpmasQLFunctionLanguage->translate_and_interprete($attr,\%loc);
		
		foreach my $k (0..$#{$attlist}) { 
				my %hash;
				$hash{field} = $attlist->[$k];
				$hash{content} = $suit;
				$hash{thisfor} = $attfor->[$k];
				push @attr_to_distribute, \%hash;
		} ;
	}
	for my $att (@attr_to_distribute) {
		
		my %agentgroups;
		my %suits;
		#only loop through agents to determine suitability if it is agent-specific 
		if ($att->{content} =~ /#this\s*\(\s*agent/ ) { 
		
			for my $curAgent ($agentregistry->object_list ) {
				my %loc2 = %loc;
				$loc2{agent_id} = $curAgent->get_attribute("id");
				$loc2{agent}	= $curAgent;
				$loc2{attribute} = $att->{thisfor};
				my @suitable = sort {$a <=> $b} MpmasQLFunctionLanguage->convert($att->{content},\%loc2);
				my $suitcode = join ("_", @suitable);
				push @{$agentgroups{$suitcode}}, $curAgent ;
				$suits{$suitcode} = \@suitable;
				#print "Agent $loc{agent_id} , suitcode $suitcode\n" if $verbose;
			}
		}
		else {
			my %loc2 = %loc;
			$loc2{attribute} = $att->{thisfor};
			my @suitable = sort {$a <=> $b} MpmasQLFunctionLanguage->convert($att->{content},\%loc2);
			my $suitcode = join ("_", @suitable);
			$suits{$suitcode} = \@suitable;
			$agentgroups{$suitcode}=[( $agentregistry->object_list() )];
		}
		for my $suitcode (keys %agentgroups) {
			print "Distributing $att->{field}  properties to ". scalar ( @{ $agentgroups{$suitcode} }) ." agents of suitability group $suitcode\n" ;
			my $region = MasMapRegion->create();
			$region->set_farmsteadmap($farmsteadmap);
			$region->set_propertymap($propertymap) if (defined $propertymap);
			$region->add_agents(@{ $agentgroups{$suitcode}});
			$region->set_option("DISTRIBUTE_ORDER", defined $disinfo->{"DISTRIBUTE_ORDER"}? $disinfo->{"DISTRIBUTE_ORDER"}: 0);
			$region->set_option("PLOT_PDF", defined $disinfo->{"PLOT_PDF"} ? $disinfo->{"PLOT_PDF"}: 2 );
			my ($rc, $unfinished_agentlist) = $region->distribute_properties($suitabilitymap, $suits{$suitcode},  $disinfo->{AVGPLOTSIZE}, $att->{field}, $disinfo->{CELLSIZE}, $disinfo->{MAXIT}, $verbose);
			unless ($rc ) {
				print STDERR "Could not assign all properties to all agents in suitability group $suitcode\n" ;
				#print "Unfinished Agents\n".join("\n",@$unfinished_agentlist)."\n";
			}
			$region->propertymap->save_as_ascii("testproperty_$att->{field}_$suitcode.txt") if ($verbose > 2);
			$propertymap=  $region->propertymap;	
			$propertymap->set_id("PROPERTYMAP");
		}
		
	}
	$mapregistry->add_or_replace_objects($propertymap);
	for my $curAgent ($agentregistry->object_list() ) {
		my %loc2 = %loc;
		$loc2{agent_id} = $curAgent->get_attribute("id");
		$loc2{agent}	= $curAgent;
		do_post_assignment($disinfo, $curAgent, undef, \%loc2);
	}
}
sub none {
	#do nothing
}


###Auxiliary subfunctions - do not call directly

sub fit_into_subarea_draw {
	my ($observations, $likelihoods, $observationregistry, $sum_of_likelihoods) = @_;
	if (not defined $sum_of_likelihoods) {
	      $sum_of_likelihoods = 0;
	      foreach my $curEndow (@$observations) {
			$sum_of_likelihoods += $likelihoods->{$curEndow->get_attribute("id")};

	      }
	}
	return undef if ($sum_of_likelihoods == 0);
	my %probs;
	foreach my $curEndow (@$observations) {
	    $probs{$curEndow->get_attribute("id")} =  $likelihoods->{$curEndow->get_attribute("id")} / $sum_of_likelihoods;
	}
	my @v = sort {$a <=> $b} keys %probs;
	my @p = map {$probs{$_} } @v;
	my $icdf = EmpiricalDF->new(\@p, \@v, "freq", "step",{discrete => 1});
	# $icdf->qf_plot(undef,0,1,0,20);
	my $obs_id_drawn = draw_value_from_cdf($icdf, 0, 1);
	my $curEndow = $observationregistry->get_object_by_id($obs_id_drawn);
	print "No object of id $obs_id_drawn found\n" and exit(0) unless (defined $curEndow);
	
	return $curEndow;
}

1;
