#!/usr/bin/perl -w
# Generate a passenger-centric LP to optimize an airline flight scedule
# Rowin Andruscavage
# ENCE 667 SP02 Dr. S. Gabriel
#
# 5/15/2003  Add input/output metrics for ENPM642 trade study
# 8/12/2005  Modularize and modify for arcology simulation transit optimization

require ("schedopt.pm");

## initialize common variables based on preset parameters
&parametricInit;


## Multicriteria optimization loops
#@opt_bases = ("numacdev", "numunsrv", "profit");
@opt_bases = ("profit");  # perform a single run
foreach $opt_base (@opt_bases) {

    ## re-sort @opt_bases array so the current entry goes first
    @opt_bases2 = @opt_bases;
    until ($opt_base eq $opt_bases2[0]) {
	push(@opt_bases2, shift(@opt_bases2));
	## actually, we can just get rid of half or our cases
#	shift(@opt_bases2);
    }
#    print join(':', @opt_bases) . "\n";
#    print join(':', @opt_bases2). "\n";
    
    foreach $opt_subcrit (@opt_bases2) {
	if ($opt_subcrit eq $opt_base) {
	    $dir = "$opt_base";
	} else {
	    $dir = "$opt_base/$opt_subcrit";
	}
	mkdir($dir);


##
## Tweak base optimal solutions as constraints
##


	## number of points to try to relax values at
	## correspondes to resolution of the tradeoff curve
	$numpts = 1;
	$relax = 0;
	$first = 0;
	if (!($opt_subcrit eq $opt_base)) {
	    $relax = 1;  ## Turn on the relaxation loop
	    $first = 1;
## read the optimal value of the base optimization
	    %baseresults = &readresults("$opt_base/output.csv");
	    $basevalue = $baseresults{$opt_base};
	}	    

	$value = "";
	foreach (my $relx=0.0; $relx<1.0; $relx+=1.0/$numpts) {

	if ($relax == 1) {
# profit
	    if ($opt_base eq "profit") {
		my $newvalue = $basevalue - 2 * $basevalue * $relx;
		if ($value == $newvalue) {
		    unless ($first == 1) {
			next;  # no change, skip to next $relx
		    }
		}
		$value = $newvalue;
		$relaxbaseopt = "profit >= $value;\n";
	    }
	    
# number of unserved people
	    elsif ($opt_base eq "numunsrv") {    
		my $newvalue = int($basevalue + ($population - $basevalue) 
			     * $relx + 0.5);
		if ($value == $newvalue) {
		    unless ($first == 1) {
			next;  # no change, skip to next $relx
		    }
		}
		$value = $newvalue;
		$relaxbaseopt = "numunsrv <= $value; \n";
	    }
	    
# deviation from standard fleet size
	    elsif ($opt_base eq "numacdev") {
		my $maxdev = ($desirednumac > ($maxaircraft - $desirednumac) ? 
		    $desirednumac : $maxaircraft - $desirednumac);
		my $newvalue = int($basevalue + $maxdev * $relx + 0.5);
		if ($value == $newvalue) {
		    unless ($first == 1) {
			next;  # no change, skip to next $relx
		    }
		}
		$value = $newvalue;
		$relaxbaseopt = "numacdev <= $value; \n";
	    }
	}


##
## output metrics
##
	
	# profit
	if ($opt_subcrit eq "profit" || ($opt_base eq "profit" && $opt_subcrit eq "profit")) {
	    $optcriteria = "max: profit;\n";
	}
	
	# number of unserved people
	elsif ($opt_subcrit eq "numunsrv" || ($opt_base eq "numunsrv" && $opt_subcrit eq "numunsrv")) {    
	    $optcriteria = "min: numunsrv ;  /*  number of unserved passengers  */\n";
	}
	
	# deviation from standard fleet size
	elsif ($opt_subcrit eq "numacdev" || ($opt_base eq "numacdev" && $opt_subcrit eq "numacdev")) {
	    $optcriteria = "min: numacdev;  /*  number of aircraft in service */\n";
	}
	
	## relax base optimal value constraints
	if ($relax == 1) {
	    $optcriteria += $relaxbaseopt;
	}




	
	%input = (
		  population => "$population",
		  r_hub_node => "$r_hub_node",
		  node_maxthroughput => "$node_maxthroughput",
		  hub_maxthroughput => "$hub_maxthroughput",
		  numnodes => "$numnodes",
		  numhubs => "$numhubs",
		  r_pop_numnodes => "$r_pop_numnodes",
		  maxaircraft => "$maxaircraft",
		  desirednumac => "$desirednumac",
		  r_pop_aircraft => "$r_pop_aircraft",
		  time_incr => "$nt",
		  defsc => "$defsc",
		  fc => "$fc[0]",
		  aac => "$aac[0]",
		  fcap => "$fcap[0]",
		  );


	##
	##  Create and run the optimization problem
	##
       
	&writeModel;	
	&solveModel;
	&summarizeResults;


	print "Collecting results from $dir/sched.ogl to $dir/output.csv ";
	open(RESULTS, "$dir/sched.ogl");
	@rawresults = <RESULTS>;
	close(RESULTS);

	@results = (grep(/profit/, @rawresults), 
		    grep(/tfc/, @rawresults),
		    grep(/tpr/, @rawresults),
		    grep(/numac/, @rawresults),
		    grep(/numacdev/, @rawresults),
		    grep(/numunsrv/, @rawresults));
# print join("\n", @results);
	
	%output = ();
	foreach $line (@results) {
	    @field = split(/\s+/,$line);
#    print join(':', @field) . "\n";
	    $output{$field[2]} = $field[3];
	}


	if ($relax == 0 || ($relax == 1 && $first == 1)) {
	    open (OUTPUT, ">$dir/output.csv");
	    ## print line of column numbers
	    print OUTPUT "#";
	    my $xiter = 0;
	    foreach $key (keys %input) {
		$xiter++;
		print OUTPUT "$xiter,";
	    }
	    foreach $key (keys %output) {
		$xiter++;
		print OUTPUT "$xiter,";
	    }
	    print OUTPUT "\n";

	    ## print line of keys
	    print OUTPUT "#";
	    foreach $key (keys %input) {
		print OUTPUT "$key,";
	    }
	    foreach $key (keys %output) {
		print OUTPUT "$key,";
	    }
	    if ($relax == 1) {
		chomp $relaxbaseopt;
		print OUTPUT $relaxbaseopt; 
	    }
	    print OUTPUT "\n";
	    close (OUTPUT);
	} 
	
	open (OUTPUT, ">>$dir/output.csv");
	foreach $key (keys %input) {
	    print OUTPUT "$input{$key},";
	}
	foreach $key (keys %output) {
	    print OUTPUT "$output{$key},";
	}
	if ($relax == 1) {
	    $first = 0;  ## not first relax loop anymore
 ## record how this line was constrained
	    print OUTPUT "$value"; 
	}
	## no trailing comma
	print OUTPUT "\n";
	close (OUTPUT);

## only loop through once if not playing with relaxed constraints
	unless ($relax == 1) {
	    last;  
	}
    }   # foreach $relx 
    }	# foreach $opt_subcrit
}	# foreach $opt_base




## Reads first two lines of a csv file (name given in $_[0]) and
## returns a hash of its keys => values
sub readresults {
    open (BASERESULTS, $_[0]);
    my @baseresults = <BASERESULTS>;
    close (BASERESULTS);
    
    ## skip first line are just column numbers
    my @bkeys = split(/,/, $baseresults[1]);
    my @bvals = split(/,/, $baseresults[2]);
    
    my %baseresults = ();
    for (my $x=0; $x<$#bkeys; $x++) {
	$baseresults{$bkeys[$x]} = $bvals[$x];
    }
    return %baseresults;
}
