#!/usr/bin/perl

use 5.040;

# Generador de programas DEA a resolver con lp_solve
#     Q: I did not read dea.c, I have no idea on using...
#     A: dea <your_data_file>
#          where the data file contents is
#
#                Ninputs Moutputs
#                col1in .. colNin col1out .. colMout
#                 ..     ..    ..    ..    ..    ..
#                etc    etc   etc   etc   etc   etc
#
#    Q: Ok, DEA... but what kind of DEA?
#    A: The simple one! (CCR) I don't agree using parametric DEA, since DEA is
#       a great model for non-parametric estimation on efficiency, forgiving
#       human assumptions on DMU operations.
#       Ps: DEA = Data Envelopment Analysis, DMU = Decision Making Units
#
#    Take x inputs, y outputs on n delegations, generate the set of programs
#                               Max  SUM wy'  for each delegation'(1..n)
#                               s.t. SUM vx - SUM wy >= 0
  any n
#                                    SUM vx' = 1
#                                    all v,w >= 0
# Easy questions: jesuslozanomosterin@gmail.com
#
# Example of input
#
# Whitout '#':

# 2 3
# 1 1 0 0 1
# 1 1 0 1 1
# 1 1 1 1 1
# 2 2 2 0 0 
# 2 2 0 1 2
# 2 0 1 0 1
# 0 1 0 0 1
# 3 3 9 0 0
# 1 3 5 0 2
# 3 1 4 0 3
# 0 3 0 4 0
# Y1 <= Y2

#
# The last line is a parametric bound. Tipically: number of foreing students are more important than native ones
#
# Warning: By doing this kind of thing, you switch to use a parametric evaluation of efficiency. You should
# remember that one of the pros of the DEA model is that it is not a parametric evaluation.

if (@ARGV<1){
    unless (-e $ARGV[0] && -t $ARGV[0]) {
	say "";
	say "Usage: $0 <inputfile>\n";
	say "";
	exit 2 ;
    }
}

open (my $FIN, "<", $ARGV[0]) or die "Cannot open $ARGV[0]: $!";

my @m;
my $ok=0;
my ($nume, $numein, $numeout);
my ($ndatos, $k, $minus, @string); 
my $n = 0;
while (my $l = <$FIN>){
    next if ($l =~ /^#/);    # comments available
    chomp $l;
    if ($ok==0){
	($numein, $numeout) = split /\s+/,$l; 
	$nume=$numein+$numeout;
	say "$numein $numeout";
	$ok=1;
	next;
    }elsif ($ok < 2){
	if ($l =~ /X/ || $l =~ /Y/){ $ok=3; goto restr; }
	my @line = split /\s+/,$l;
	say "@line";
	$n=0;
	$ndatos++;
	for my $d (@line){
	    $m[$ndatos][++$n]=$d;
	}
	if ($n!=$nume) { die "Data does not match with header in line $ndatos+1"; }
    }
    # Aquí se leen las restricciones de parámetros, que pueden poner en peligro la factibilidad 
restr:
    if ($ok >= 3){	
	if ( $l =~ /X/ xor $l =~ /Y/ ){   # solo pueden relacionarse las X o las Y entre sí
	    if  ($l =~ /\>/){
		my @vars;
		while ($l =~ /([\+|\-]?[X|Y]\d+).*\>/g){
		  push @vars, $1;
		}
	        $l =~ /(\>\=?)\s*([X|Y]\d+)/;
		my $minus = "-".$2.$1;
		
		if (@vars && $minus){
		    $k++;
		    for (@vars){
			$string[$k] .= $_;
		    }
		    $string[$k] .= $minus." 0;"; 
		}
		
	    }elsif ($l =~ /\</){
		my @vars;
		while ($l =~ /([\+|\-]?[X|Y]\d+).*\</g){
		    push @vars, $1;
		}
		$l =~ /(\<\=?)\s*([X|Y]\d+)/;
		my $minus = "-".$2.$1;
		
		if (@vars && $minus){
		    $k++;
		    for (@vars){
			$string[$k] .= $_;
		    }
		    $string[$k] .= $minus." 0;"; 
		}		
	    }
	}
    }
}
close $FIN;

open my $FSH, ">", "lp$ndatos.bat" or die "Cannot open lp$ndatos.bat";

my $namenum;
for my $nn (1..$ndatos){
    $namenum = "DMU" . (1000+$nn);
    
    open (my $FOUT, ">", $namenum) or die "Cannot open $namenum";
    for my $x (1..$numein) { $m[$ndatos+1][$x]=$m[$nn][$x]; }   # inputs
    for my $y ($numein+1..$nume) { $m[0][$y]=$m[$nn][$y]; }  # outputs
       
    print $FOUT "max: ";
    for my $y ($numein+1 .. $nume){
#	if (exists $m[0][$y]) { 
	    print $FOUT " +$m[0][$y] Y$y";
#	} 
    }
    say $FOUT ";";
	
    for my $ndat (1..$ndatos){     # ndatos
	for my $x (1..$numein){
	    unless (defined $m[$ndat][$x]) { $m[$ndatos][$x]=0; }
	    print $FOUT " +$m[$ndat][$x] X$x";
	}
	for my $y ($numein+1..$nume){
	    unless (defined $m[$ndat][$y]){  $m[$ndatos][$y]=0; }
	    print $FOUT " -$m[$ndat][$y] Y$y";
	}
	say $FOUT " >= 0;";
    }
 
    for my $x (1..$numein){
	if (defined $m[$ndatos+1][$x]) { print $FOUT " +$m[$ndatos+1][$x] X$x"; }     # sum inputs = 1
    }
    say $FOUT " = 1;";

    for (1 .. scalar @string){
	print $FOUT "$string[$_]" if ($string[$_]);
    }
    close $FOUT;

    say $FSH "lp_solve \< $namenum \>\> results$ndatos";

}
# print FSH "find objective @results > RESULT\n";
close $FSH;
system "bash lp$ndatos.bat";
system "grep objective results$ndatos > RESULT$ndatos";

exit 2;

__END__

v.1 Non parametric DEA original by Charnes, Cooper & Rhodes
v.2 This beta version