# A quick and dirty program to covert the problem instance data 
# for the WDM problems to AMPL format.

# requires:
# AMPL (this program opens a pipe to AMPL and sends it commands to create the data file)
# write_data_file.run

# On a Unix system with Perl and AMPL, the following command would be used to convert the
# data for the problem instance EUR03 with translation at the switches into AMPL format:
# perl create_data_file.pl EUR03.txt 2 > EUR03.pts


$translation_level_text = "translation level:\n0 = no translation (default)\n1 = translation allowed on the protection path\n2 = translation allowed at switches\n3 = full translation\n";

$argc = @ARGV;
if ($argc < 1) {
    die "Usage: create_data_file.pl [data file name] [translation level]\n$translation_level_text";
} elsif (not -r $ARGV[0]) {
    die "Can't read $ARGV[0]\n";
}

# Set the translation level
if ($argc >= 2) {
    $translation = $ARGV[1];
} else {
    $translation = 0;
}


open(INFILE,"$ARGV[0]");
open(AMPL,"|ampl");
select(AMPL);
$num_sizes = 0;
$current_cycle = 0;
$current_path = 0;
$current_node = 0;
$node = 0;
$current_structure = 0;

while (<INFILE>) {
    @fields = split(/\s+/);
    if (/Problem Name/) {
	$file_name = $fields[3];
	print "# Problem $file_name\n";
	print "set N default {};\n";
	print "set S default {};\n";
	print "set C default {};\n";
	print "set E within {N, N} default {};\n";
	print "set Es {S} within E default {};\n";
	print "set D within {N, N} default {};\n";
	print "param r {D};\n";
	print "set DEMAND_PAIRS default {};\n";
	print "param source {DEMAND_PAIRS};\n";
	print "param sink {DEMAND_PAIRS};\n";
	print "set P default {};\n";
	print "set K default {};\n";
	print "set Pk {K} within P default {};\n";
	print "set J {D} within K default {};\n";
	print "set L {C} within P default {};\n";
	print "set W default {};\n";
	print "param a {s in S, w in W};\n";
	print "param f {c in C, w in W};\n";
	print "set Pes {E,S} within P default {};\n";
    } elsif (/Total Nodes/) {
	# Write out the set of nodes
	$nodes = $fields[3];
	print "let N := 1 .. $nodes;\n";
    } elsif (/Total Links/) {
	$links = $fields[3];
    } elsif (/Total Demands/) {
	$demands = $fields[3];
    } elsif (/Total Structures/) {
	$structures = $fields[3];
	print  "\nlet S := 1 .. $structures;\n";
	for ($i=1;$i <= $structures;$i++) {
	    $links_in_structure[$i] = "";
	    $nodes_in_structure[$i] = "";
	}
    } elsif (/Total Switches/) {
	$switches = $fields[3];
	print  "\nlet C := 1 .. $switches;\n";
    }

    # Skip down until we get the list of links
    if (/links/ && !/-/) {
	s/N0//g;
	s/N//g;
	@fields = split(/\s+/);
	print  "let E := E union {($fields[1], $fields[2])};\n";
	for ($i=1;$i<$links;$i++) {
	    $_ = <INFILE>;

	    s/N0//g;
	    s/N//g;
	    @fields = split(/\s+/);
	    print  "let E := E union {($fields[1], $fields[2])};\n";
	}
    }


    # Read in the demands
    if (/demands/ && !/-/) {
	s/D0//g;
	s/D//g;
	s/N0//g;
	s/N//g;
	s/W0//g;
	s/W//g;
	@fields = split(/\s+/);

	print "let D := D union {($fields[2],$fields[3])};\n";
	print "let r[$fields[2],$fields[3]] := $fields[4];\n";
	print "let DEMAND_PAIRS := DEMAND_PAIRS union {$fields[1]};\n";
	print "let source[$fields[1]] := $fields[2];\n";
	print "let sink[$fields[1]] := $fields[3];\n";
	
	$sink[$fields[1]] = $fields[3];
	$source[$fields[1]] = $fields[2];

	for ($i=1;$i<$demands;$i++) {
	    $_ = <INFILE>;
	    s/D0//g;
	    s/D//g;
	    s/N0//g;
	    s/N//g;
	    s/W0//g;
	    s/W//g;
	    s/N0//g;
	    s/N//g;
	    @fields = split(/\s+/);

	    print "let D := D union {($fields[2],$fields[3])};\n";
	    print "let r[$fields[2],$fields[3]] := $fields[4];\n";
	    print "let DEMAND_PAIRS := DEMAND_PAIRS union {$fields[1]};\n";
	    print "let source[$fields[1]] := $fields[2];\n";
	    print "let sink[$fields[1]] := $fields[3];\n";

	    $sink[$fields[1]] = $fields[3];
	    $source[$fields[1]] = $fields[2];

	}
	print  "\n";
    }

    if (/structures/ && !/-/) {
	s/S0//g;
	s/S//g;
	s/N0//g;
	s/N//g;
	@fields = split(/\s+/);
	print "if ($fields[2],$fields[3]) in E then {let Es[$fields[1]] := Es[$fields[1]] union {($fields[2],$fields[3])};}\n";
	print "if ($fields[3],$fields[2]) in E then {let Es[$fields[1]] := Es[$fields[1]] union {($fields[3],$fields[2])};}\n";
    }

    # read in the cycle data
    if (/cycles/ && !/-/) {
	
	# We have are reading in the first line of a new cycle
	print "\n# start of optical cycle\n";
	$current_path = $current_path + 1;
	print "let P := P union {$current_path};\n";

	$end_of_cycle = 0;
	while ($end_of_cycle < 2) {

	    if ($end_of_cycle) {
		$_ = <INFILE>;
	    }

	    s/P0//g;
	    s/P//g;
	    s/D0//g;
	    s/D//g;
	    s/C0//g;
	    s/C//g;
	    s/S0//g;
	    s/S//g;
	    s/N0//g;
	    s/N//g;

	    @fields = split(/\s+/);
	    $current_cycle = $fields[1];

	    $pair = $fields[2];
	    $current_structure = $fields[3];
	    $current_node = $fields[4];
	    $old_node = $fields[4];

	   
	    # read the working path
	    # keep reading until we reach the d node of this o-d pair
	    if ($end_of_cycle == 0) {
		print "# start of working path\n";
		print "let K := K union {$current_cycle};\n";
		print "let J[$source[$pair],$sink[$pair]] := J[$source[$pair],$sink[$pair]] union {$current_cycle};\n";
		print "let Pk[$current_cycle] := Pk[$current_cycle] union {$current_path};\n";
	    } else {
		print "# start of protection path\n";
	    }
	    while ($current_node != $sink[$pair]) {
		$_ = <INFILE>;
		
		if (/C/) {
		    $switch_line = 1;
		} else {
		    $switch_line = 0;
		}
		
		s/P0//g;
		s/P//g;
		s/D0//g;
		s/D//g;
		s/C0//g;
		s/C//g;
		s/S0//g;
		s/S//g;
		s/N0//g;
		s/N//g;
		@fields = split(/\s+/);
		if ($switch_line == 0) {
		    $current_node = $fields[4];
		    if ($old_node < $current_node) {
			$pes = "Pes[$old_node,$current_node,$current_structure]";
		    } elsif ($current_node < $old_node) {
			$pes = "Pes[$current_node,$old_node,$current_structure]";
		    }
		    print "let $pes := $pes union {$current_path};\n";
		    $old_node = $current_node;
		} else {
		    print "# switching structures\n";
		    print "let L[$fields[3]] :=  L[$fields[3]] union {$current_path};\n";
		    $switch = $fields[3];
		    $_ = <INFILE>;
		    s/S0//g;
		    s/S//g;
		    s/N0//g;
		    s/N//g;
		    @fields = split(/\s+/);
		    $current_structure = $fields[3];
		    $old_node = $fields[4];

		    if ($translation == 2) {
			# We are using translation at the switches, so we start a new path here
			$current_path = $current_path + 1;
			print "let P := P union {$current_path};\n";
			print "let L[$switch] :=  L[$switch] union {$current_path};\n";
			print "let Pk[$current_cycle] := Pk[$current_cycle] union {$current_path};\n";
		    }
		}
		
	    }
	    if ($end_of_cycle == 0) {
		print "# end of working path\n";
		if ($translation == 1) {
		    # treat the protection and working paths as different paths
		    # in the same cycle
		    $current_path = $current_path + 1;
		    print "let P := P union {$current_path};\n";
		    print "let Pk[$current_cycle] := Pk[$current_cycle] union {$current_path};\n";
		}
	    } else {
		print "# end of protection path\n";
	    }
	    $end_of_cycle = $end_of_cycle + 1;

	} # while (end_of_cycle < 2) 
    }
    
    # Now look for the set of available sizes
    if (/waves/ && !/Wxx/) {
	s/W0//;
	s/W//;
	@fields = split(/\s+/);
	print "let W := W union {$fields[1]};\n";
	$num_sizes = $num_sizes + 1;
    }
    
    # Finally, we get to the structure and switch costs
    if (/costs/ && !/-/) {

	s/\$//;
	s/W//;
	if (/S/) {
	    s/S//;
	    @fields = split(/\s+/);
	    print "let a[$fields[1], $fields[2]] := $fields[3];\n";
	} else {
	    s/C//;
	    @fields = split(/\s+/);
	    print "let f[$fields[1], $fields[2]] := $fields[3];\n";
	}
    }
    
}

$title = "printf " . "\"" . "# Problem instance $file_name with ";
if ($translation == 0) {
    $title = $title . "no translation.\\n";
} elsif ($translation == 1) {
    $title = $title . "translation on the protection path.\\n";
} elsif ($translation == 2) {
    $title = $title . "translation at the switches.\\n";
} else {
    $title = $title . "full translation.\\n";
}

$title = $title . "\"";
print "$title;\n";
print "param translation := $translation;\n";
print "commands write_data_file.run;\n";
close(AMPL);
close(INFILE);