# Partitioning to Target Unachieved Goals

# PartTUG-NSGA2.tz (c) 2010 Jacob Schrum.
# See Simulation.tz for more copyright information

@use Abstract.
@use File.
@include "Lists.tz".
@include "NSGA2.tz".

# Information about each individual
# Mostly taken from NSGA2.tz, but SLOT_ACHIEVED_GOALS
# is new to PartTUG
#@define SLOT_ID 0.
#@define SLOT_OBJECTIVES 1.
#@define SLOT_VARIANCES 2.
#@define SLOT_NUM_EVALS 3.
#@define SLOT_CROWDING_DISTANCE 4.
#@define SLOT_RANK 5.
@define SLOT_ACHIEVED_GOALS 6.
# Indexes for partition sequence
@define PART_BITCODE 0.
@define PART_PARTITION 1.
# Indexes for support partition types
@define SUPPORT_FAVORED 0.
@define SUPPORT_SECONDARY 1.

NSGA2 : PartTUG-NSGA2 {
	+ variables:
		objective-goals (list).
		partitions (hash).
		taken (hash).
		tapped (list).
		all-partition-labels (list).
		pareto-front-first (int).
		anti-duplicate-partition (int).
		even-selection (int).
	
	+ to string-equal lhs s1 (string) rhs s2 (string):
		i (int).

		if ( |s1| != |s2| ) : return 0.
		else {
			for i = 0, i < |s1|, i++ : {
				if (s1{i} != s2{i}) : {
					return 0.
				}
			}
			return 1.
		}

	+ to init:
		all-partition-labels = {}.
		# Selecting from the Pareto front takes preference over the partition achieving all goals
		pareto-front-first = ((controller get-commandline) bit-param named "pareto-front-first").		
		# Partition for duplicates that is selected with lowest priority
		anti-duplicate-partition = ((controller get-commandline) bit-param named "anti-duplicate-partition").		
		# Option to group all partitions at the same level to select evenly from them.
		# The top level (achieving everything) is still separate, but the rest are at the same level/priority
		even-selection = ((controller get-commandline) bit-param named "even-partition-selection").		

		# Must be called in simulation whenever goals change	
	+ to set-objective-goals to goals (list):
		objective-goals = goals.

		# OVERRIDE
		# Changed to add goal achievement markers to meta-data, and to disable Preference Point option.
	+ to get-first-part-of-meta-fitness given fitnesses (list):
		fitnesses-with-crowding-distance (list).
		i (int).
		j (int).
		achieved (list).

		# Makes each entry (ID,objectives,crowding distance)
		# Preference point option not sensical in PartTUG
		fitnesses-with-crowding-distance = (self assign-crowding-distances to-population fitnesses).

		for i = 0, i < |fitnesses-with-crowding-distance|, i++ : {
			# Add blank slot for rank
			push 0 onto fitnesses-with-crowding-distance{i}.
			# Add goal achievement markers
			achieved = {}.
			for j = 0, j < |objective-goals|, j++ : {
				if (fitnesses-with-crowding-distance{i}{SLOT_OBJECTIVES}{j} > objective-goals{j}) : {
					push 1 onto achieved.
				} else {
					push 0 onto achieved.
				}
			}
			push achieved onto fitnesses-with-crowding-distance{i}.
		}	

		return fitnesses-with-crowding-distance.

		# OVERRIDE
		# Changed to favor individuals achieving more goals. Given a tie, super method is called.
	+ to get-best between a (object) and b (object) given fitnessA (list) and fitnessB (list):
		sumA (int).
		sumB (int).
		i (int).

		# Includes achieved goal information
		if (|fitnessA| == 5) : {
			sumA = 0.
			sumB = 0.
			for i = 0, i < |objective-goals|, i++ : {
				sumA += (fitnessA{SLOT_ACHIEVED_GOALS}{i}).
				sumB += (fitnessB{SLOT_ACHIEVED_GOALS}{i}).
			}
			# Higher sum means more goals are achieved
			if sumA > sumB : return a.
			else if sumB > sumA : return b.
			# Else fall through to standard selection mechanism
		}
		
		return (super get-best between a and b given fitnessA and fitnessB).
	
	+ to get-size-of-partition bits code (string):
		if (partitions{code}) : {
			return |partitions{code}|.
		} else {
			return 0.
		}

	+ to get-num-taken bits code (string):
		if (taken{code}) : {
			return (taken{code}).
		} else {
			return 0.
		}

	+ to take individuals n (int) from code (string):
		#print "Take $n from $code out of", (self get-size-of-partition bits code).
		if (taken{code}) : {
			taken{code} = taken{code} + n.
		} else {
			taken{code} = n.
		}

	+ to get-all-partitions:
		if ( |all-partition-labels| == 0 ) : {
			self build-partition-list bits ( |objective-goals| ).
			if pareto-front-first : {
				push "front" onto all-partition-labels.
			}
			if anti-duplicate-partition : {
				push "anti-duplicate" onto all-partition-labels.
			}
		}
		return all-partition-labels.

	+ to get-partitions-at-level achieving num (int):
		i (int).
		temp (list).
		result (list).

		result = {}.
		temp = (self get-all-partitions).
		for i = 0, i < |temp|, i++ : {
			if ((self count-goals-achieved partition (temp{i})) == num) : {
				push (temp{i}) onto result.
			}
		}

		return result.
	
	+ to build-partition-list bits num (int) code code = "" (string):
		if (num == 0) : { # Base case
			push code onto all-partition-labels.
		} else { # Recursive case
			self build-partition-list bits (num - 1) code "0$code".
			self build-partition-list bits (num - 1) code "1$code".
		}

	+ to filter-to-occupied-partitions in ps (list):
		i (int).
		result (list).
		list-ops (object).

		list-ops = (controller get-list-ops).

		result = {}.		
		for i = 0, i < |ps|, i++ : {
			# Tapped partitions are considered empty
			if (!(list-ops contains-string element (ps{i}) in-list tapped)
			&& ((self get-size-of-partition bits (ps{i})) > 0) ) : {
				push (ps{i}) onto result.
			}
		}
		return result.

	+ to count-goals-achieved partition code (string):
		i (int).
		count (int).

		if (self string-equal lhs code rhs "front") : {
			# Treat the Pareto front as if it is achieving more goals than possible
			count = ( |objective-goals| + 1 ).
		} else if (self string-equal lhs code rhs "anti-duplicate") : {
			# Anti-duplicate partition is treated as achieving negative goals, resulting in low priority
			count = ( 0 ).
		} else {
			count = 0.
			for i = 0, i < |code|, i++ : {
				if (code{i} == "1") : {
					count++.
				}
			}
		}

		return count.

	+ to get-same-level-partitions partition code (string):
		return (self get-partitions-at-level achieving (self count-goals-achieved partition code)).

	+ to get-other-same-level-partitions partition code (string):
		i (int).
		temp (list).		

		temp = (self get-partitions-at-level achieving (self count-goals-achieved partition code)).
		for i = 0, i < |temp|, i++ : {
			if (temp{i} == code) : {
				remove temp{i}.
				return temp.
			}
		}
	
		print "Should have been able to find and remove partition in \"get-other-same-level-partitions\"".
		controller end-simulation.

	+ to add-all-ids from source (list) to keepers (list):
		i (int).

		for i = 0, i < |source|, i++ : {
			push (source{i}{SLOT_ID}) onto keepers.
		}

	+ to add-entire-partition-layer from layers (list) to keepers (list):
		i (int).

		for i = 0, i < |layers|, i++ : {
			self take individuals (|layers{i}{PART_PARTITION}|) from (layers{i}{PART_BITCODE}).				
			self add-all-ids from (layers{i}{PART_PARTITION}) to keepers.
		}

	+ to get-categorized-support-partitions level-of code (string):
		level (list).
		occupied (list).
		support-occ (list).
		empty (list).
		favored (list).
		second-choice (list).
		support-empty (list).
		list-ops (object).

		list-ops = (controller get-list-ops).

		#print "Code: $code".
		level = (self get-same-level-partitions partition code).
		#print "Same level: $level".
		occupied = (self filter-to-occupied-partitions in level).
		#print "Occupied: $occupied".
		support-occ = (self get-set-support-partitions for-set occupied).
		#print "Support of occupied: $support-occ".	
	
		empty = (list-ops set-diff lhs level rhs occupied).
		#print "Empty: $empty".
		support-empty = (self get-set-support-partitions for-set empty).
		#print "Support of empty: $support-empty".

		favored = (list-ops set-diff lhs support-empty rhs support-occ).
		second-choice = (list-ops set-diff lhs support-empty rhs favored).

		return {favored, second-choice}.

	+ to reduce-support-to-occupied level-of code (string):
		support (list).
		occ-favored (list).
		occ-secondary (list).
	
		support = (self get-categorized-support-partitions level-of code).
		#print "Support before filtering: $support".

		occ-favored = (self filter-to-occupied-partitions in (support{0})).
		occ-secondary = (self filter-to-occupied-partitions in (support{1})).

		return {occ-favored, occ-secondary}.

	+ to get-best-available-support-partition level-of code (string):
		occupied (list).
		i (int).
		j (int).
		best (string).
		num-achieved (int).
		temp (list).
		list-ops (object).

		list-ops = (controller get-list-ops).

		best = "".
		num-achieved = (self count-goals-achieved partition code).

		#print "Support for empty partitions at level of $code (achieving $num-achieved)".

		if (num-achieved == 0) : {
			#print "No support because bottom was reached (i.e. achieved = 0)".
			return "".
		} else {
			occupied = (self reduce-support-to-occupied level-of code).
			#print "Occupied support partitions: $occupied".
			
			for i = 0, ((i < |occupied|) && (best == "")), i++ : {
				for j = 0, ((j < |occupied{i}|) && (best == "")), j++ : {
					if !(list-ops contains-string element (occupied{i}{j}) in-list tapped) : {
						best = (occupied{i}{j}).
					}
				}
			}

			# All available support partitions were empty
			if (best == "") : {
				temp = (self get-partitions-at-level achieving (num-achieved - 1)).
				#print "Recursive call: partitions at level of", temp{0}.
				best = (self get-best-available-support-partition level-of (temp{0})).
			}
		}

		return best.

	+ to get-set-support-partitions for-set ps (list):
		list-ops (object).
		result (list).
		i (int).
	
		list-ops = (controller get-list-ops).

		result = {}.
		for i = 0, i < |ps|, i++ : {
			result = (list-ops union lhs result rhs (self get-support-partitions partition (ps{i}))).
		}

		return result.

		# Given bit code for a partition, return a list of bit codes
		# for supporting partitions.
	+ to get-support-partitions partition code (string):
		i (int).
		j (int).
		result (list).
		code-in-progress (string).
		num-partitions (int).
		temp (string).
		targets (string).
		fill-out (int).
		
		num-partitions = 0.
		targets = "".
		for i = 0, i < |code|, i++ : {
			temp = code{i}.
			if (temp == "1") : {
				num-partitions++.
			}
			targets = "$targets$temp".
		}

		result = {}.
		for i = 0, i < |num-partitions|, i++ : {
			fill-out = 0.
			code-in-progress = "".
			for j = 0, j < |code|, j++ : {
				temp = code{j}.
				if (temp == "0" || fill-out || targets{j} == "0") : {
					code-in-progress = "$code-in-progress$temp".
				} else {
					targets{j} = "0".
					temp = "0".
					fill-out = 1.
					code-in-progress = "$code-in-progress$temp".
				}
			}
			push code-in-progress onto result.
		} 

		return result.

	+ to get-available-support-size partition code (string):
		i (int).
		sum (int).
		support (list).

		support = (self get-support-partitions partition code).
		sum = 0.
		for i = 0, i < |support|, i++ : {
			sum += (self get-size-of-partition bits (support{i})). 
		}

		return sum.

	+ to get-bit-code-from achieved goals (list):
		k (int).
		bit-code (string).
		bit (int).

		bit-code = "".
		for k = 0, k < |goals|, k++ : {
			bit = goals{k}.
			bit-code = "$bit-code$bit".
		}

		return bit-code.

	+ to count-num-of achieved goals (list):
		k (int).
		sum (int).

		sum = 0.
		for k = 0, k < |goals|, k++ : {
			sum += goals{k}.
		}

		return sum.

	+ to assign-all-to-partitions fronts nondominated-pareto-fronts (list):
		sum (int).
		priorities (hash).
		bit-code (string).
		i (int).
		j (int).
		k (int).
		part (list).
		dup (int).

		# Completely re-sort the fronts into partitions based on goal achievement.
		# Somewhat wasteful for non-dominated sort to have preceded this.
		for i = 0, i < |nondominated-pareto-fronts|, i++ : {
			for j = 0, j < |nondominated-pareto-fronts{i}|, j++ : {
				dup = 0.
				if (pareto-front-first && (i == 0) && partitions{"front"}) : {
					for k = 0, (!dup && k < |partitions{"front"}|), k++ : {
						if (super equal-scores this (nondominated-pareto-fronts{i}{j}{SLOT_OBJECTIVES}) 
						                        and (partitions{"front"}{k}{SLOT_OBJECTIVES})) : {
							dup = 1.
						}
					}
				}

				# The Pareto front is a special partition
				if (!dup && pareto-front-first && (i == 0)) : {
					#print "In the Pareto front".
					bit-code = "front".
				} else if (dup && anti-duplicate-partition) : {
					bit-code = "anti-duplicate".
				} else {
					# Unique bit code for goal-achievement partition
					bit-code = (self get-bit-code-from achieved (nondominated-pareto-fronts{i}{j}{SLOT_ACHIEVED_GOALS})).
					sum = (self count-num-of achieved (nondominated-pareto-fronts{i}{j}{SLOT_ACHIEVED_GOALS})).
				}

				# Get previous partition
				if (partitions{bit-code}) : {
					part = partitions{bit-code}.
				} else {
					part = {}.
					# i == 0 is for the Pareto front of the set
					if (!dup && pareto-front-first && (i == 0)) : {
						priorities{bit-code} = ( |objective-goals| + 1 ).
					} else if (dup && anti-duplicate-partition) : {
						priorities{bit-code} = ( 0 ).
					} else if (even-selection) : {
						# Two levels: top and right below it.
						priorities{bit-code} = max(sum, (|objective-goals| - 1)).
					} else {
						priorities{bit-code} = sum.
					}
				}
				#print bit-code,"has priority",priorities{bit-code}.
				# Update partition
				push (nondominated-pareto-fronts{i}{j}) onto part.
				partitions{bit-code} = part.
				#print "Partition: $bit-code: size ", |partitions{bit-code}|.
			}
		}

		return priorities.

	+ to reduce-objectives-to-achieved original individual (list):
		k (int).
		objs (list).

		objs = (individual{SLOT_OBJECTIVES}).
		individual{SLOT_OBJECTIVES} = {}.
		for k = 0, k < |objs|, k++ : {
			if !(individual{SLOT_ACHIEVED_GOALS}{k}) : {
				push (objs{k}) onto (individual{SLOT_OBJECTIVES}).
			}
		}

		# Default limit is meant to be bigger than any partition can be, hence 1000
	+ to select-from-each-front these partition-fronts (list) into keepers (list) amount smallest-front-size (int) stop-at limit = 1000 (int):
		i (int).
		j (int).
		count (int).
		bit-code (string).
		from-this-partition (int).

		count = 0.
		for i = 0, i < |partition-fronts|, i++ : {
			sort (partition-fronts{i}{0}) with compare-crowding-distance.
			
			bit-code = (self get-bit-code-from achieved (partition-fronts{i}{0}{0}{SLOT_ACHIEVED_GOALS})).
			from-this-partition = 0.
			for j = 0, j < smallest-front-size, j++ : {
				if (count < limit) : {
					#print "Add: $bit-code:",partition-fronts{i}{0}{0}.
					push (partition-fronts{i}{0}{0}{SLOT_ID}) onto keepers.
					remove partition-fronts{i}{0}{0}.
					count++.
					from-this-partition++.
				}
			}
			self take individuals from-this-partition from bit-code.				

			# Remove empty fronts
			if (|partition-fronts{i}{0}| == 0) : remove partition-fronts{i}{0}. 
		}

	+ to non-dominated-sort-by-relevant-objectives in partition (list):
		j (int).	

		if !(self string-equal lhs (partition{PART_BITCODE}) rhs "front") 
                && !(self string-equal lhs (partition{PART_BITCODE}) rhs "anti-duplicate") : {	
			# Remove achieved objectives
			for j = 0, j < |partition{PART_PARTITION}|, j++ : {
				#print "Before:", partition{PART_PARTITION}{j}. 
				self reduce-objectives-to-achieved original (partition{PART_PARTITION}{j}).
				#print "After:", partition{PART_PARTITION}{j}. 
			}
		}

		return ( self sort-into-nondominated-pareto-fronts population (partition{PART_PARTITION}) ).

	+ to upgrade-support bits code (string) level level (int) within partition-sequence (list):
		i (int).
		j (int).

		for i = (level - 1), i >= 0, i-- : {
			for j = 0, j < |partition-sequence{i}|, j++ : { 
				if (self string-equal lhs code rhs (partition-sequence{i}{j}{PART_BITCODE})) : {
					# Upgrade the support partition
					push (remove (partition-sequence{i}){j}) onto (partition-sequence{level}).
					return.
				}
			}
		}

		# OVERRIDE
		# Takes goal-achievement partitions into account
		# n: number of individuals to select
		# nondominated-pareto-fronts: list of solutions sorted into non-dominated Pareto fronts
	+ to elitist-selection get n (int) from nondominated-pareto-fronts (list):
		priorities (hash).
		keepers (list).
		bit-code (string).
		partition-sequence (list).
		current-priority (int).
		partition-fronts (list).
		smallest-front-size (int).
		needed (int).
		new-hash (hash).
		new-hash2 (hash).
		i (int).
		j (int).
		rem (int).
		support (int).
		others (list).
		support-source (string).
		front-labels (list).
		target (int).
		tempList (list).

		# Force empty partitions to pull from support partitions
		support = ((controller get-commandline) bit-param named "empty-partition-support").

		free partitions.
		partitions = new-hash.
		free taken.
		taken = new-hash2.
		free tapped.
		tapped = {}.

		keepers = {}.

		# Puts individuals in the global variable "partitions" and returns "priorities", which makes code to num of goals achieved	
		priorities = (self assign-all-to-partitions fronts nondominated-pareto-fronts).	

		# Group the partitions into layers according to number of achieved goals.
		partition-sequence = {}.
		for i = 0, i <= (|objective-goals| + pareto-front-first), i++ : {
			push {} onto partition-sequence.
			foreach bit-code in keys( priorities ): {
				#print bit-code,":",(self get-support-partitions partition bit-code).
				if (priorities{bit-code} == i) : {
					#print "$i: $bit-code: size", |partitions{bit-code}|. #,(partitions{bit-code}).
					push ({bit-code, partitions{bit-code} }) onto (partition-sequence{i}).
				}
	                }
		}

		#print "--------------------------------------------------".

		# Select best individuals, favoring those in partitions achieving the most goals
		current-priority = |objective-goals|.
		if (pareto-front-first) : {
			# Pareto front given artificially high priority
			current-priority++.
		}
		while |keepers| < n : {
			#print "Current priority: $current-priority".
			# Special case: if partition achieving all goals too big for next gen, then use original NSGA2 on it.
			if ((current-priority >= |objective-goals|) 
			&& ( |partition-sequence{current-priority}| > 0 ) 
			&& ( |partition-sequence{current-priority}{0}{PART_PARTITION}| > (n - |keepers|) )) : {
				#print "Use regular NSGA2 on best partition".
				needed = (n - |keepers|).
				nondominated-pareto-fronts = (self sort-into-nondominated-pareto-fronts 
								   population (partition-sequence{current-priority}{0}{PART_PARTITION})).
				self take individuals needed from (partition-sequence{current-priority}{0}{PART_BITCODE}).
				tempList = (super elitist-selection get needed from nondominated-pareto-fronts).
				for i = 0, i < |tempList|, i++ : {
					push (tempList{i}) onto keepers.
				}
			} else {
				if (current-priority >= |objective-goals| && |partition-sequence{current-priority}| > 0) : {
					needed = |partition-sequence{current-priority}{0}{PART_PARTITION}|.
					#print "Push all $needed:",(partition-sequence{current-priority}{0}{PART_BITCODE}).
					#print ":", partition-sequence{current-priority}{0}{PART_PARTITION}.
					self take individuals needed from (partition-sequence{current-priority}{0}{PART_BITCODE}).
					for i = 0, i < needed, i++ : {
						push (partition-sequence{current-priority}{0}{PART_PARTITION}{i}{SLOT_ID}) onto keepers.
						#remove partition-sequence{current-priority}{0}{PART_PARTITION}{0}.
					}
				} else {
					#print "Will be pulling from multiple layers".

					if (support && (current-priority < |objective-goals|)) : {
						others = (self get-partitions-at-level achieving current-priority).
						for i = 0, i < |others|, i++ : {
							for j = 0, j < |partition-sequence{current-priority}|, j++ : {
								if (self string-equal lhs (partition-sequence{current-priority}{j}{PART_BITCODE}) rhs (others{i})): {
									others{i} = "".
								}
							}
						}

						# for every missing partition, pull in support
						for i = 0, i < |others|, i++ : {
							if (others{i} != "") : {
								# Get support partitions
								support-source = (self get-best-available-support-partition level-of (others{i})).
								#print "Getting support for", others{i}, "... $support-source".
								if (support-source != "") : {
									push support-source onto tapped.
									# Now find the supporting partition in the partition-sequence
									self upgrade-support bits support-source level current-priority within partition-sequence.
								}
							}
						}
					}

					# Get partitions sorted into non-dominated layers
					partition-fronts = {}.
					# List to remember the partition codes for each group
					front-labels = {}.
					for i = 0, i < |partition-sequence{current-priority}|, i++ : {
						#print "Sort ",(partition-sequence{current-priority}{i}{PART_BITCODE}).
						push (partition-sequence{current-priority}{i}{PART_BITCODE}) onto front-labels.
						push (self non-dominated-sort-by-relevant-objectives in (partition-sequence{current-priority}{i})) 
						 onto partition-fronts.
					}

					# Select evenly across those layers.
					while ( |keepers| < n ) && ( |partition-fronts| > 0 ) : {
						# Remove empty partitions
						for i = (|partition-fronts| - 1), i >= 0, i-- : {
							# Fronts are sometimes emptied by the following operations
							if (|partition-fronts{i}| == 0) : {
								remove partition-fronts{i}.
								push (front-labels{i}) onto tapped.
								if (support && (|partition-fronts| > 0)) : {
									#print front-labels{i}, "emptied, get support".
									support-source = (self get-best-available-support-partition level-of (front-labels{i})).
									#print "Getting support for", front-labels{i}, "... $support-source".
									if (support-source != "") : {
										push support-source onto tapped.
										# Now find the supporting partition in the partition-sequence
										self upgrade-support bits support-source level current-priority 
										     within partition-sequence.
										# Need to add to partition-fronts as well
										target = (|partition-sequence{current-priority}| - 1).
										push (partition-sequence{current-priority}{target}{PART_BITCODE}) onto front-labels.
										push (self non-dominated-sort-by-relevant-objectives 
											in (partition-sequence{current-priority}{target}))
										 onto partition-fronts.
									}
								}
								remove front-labels{i}.
							}
						}

						#print "Drawing from partitions: $front-labels".

						needed = (n - |keepers|).
						# Which of the avilable partitions has the smallest front?
						smallest-front-size = needed.
						for i = 0, i < |partition-fronts|, i++ : {
							smallest-front-size = min(smallest-front-size, |partition-fronts{i}{0}|).
						}

						# Can an equal number from each partition fit easily into keepers?
						if (smallest-front-size * |partition-fronts|) > needed : {
							# This basically implements a ceiling function, so that smallest-front-size
							# times |partition-fronts| will either just equal needed or be slightly over.
							rem = (needed % (|partition-fronts|)).
							smallest-front-size = (needed / (|partition-fronts|)). #Int division will truncate/floor
							if (rem > 0) : smallest-front-size++.
						}
						self select-from-each-front these partition-fronts into keepers amount smallest-front-size stop-at needed.
					}
				}
			}
			current-priority--.
		}
		
		# Just the id numbers, which are original indexes
		return keepers.
}