package MpmasRImport;

use strict;
use warnings;
use Exporter;
use Storable qw(dclone);
use Data::Dumper;
use MpmasInputfile;
use MpmasInputBlock;
our @ISA = qw(MpmasInputfile);

sub filename {
	"R_import";
}

sub write {
  my ($self, $inihash, $scenlist, $num_periods, $saveCONSTYPEforRimport, $saveSHDW_SWITCHforRimport) = @_;

  #Create strings from options to be inserted into R script
  $inihash->{R_ROOT} = "./" unless (exists $inihash->{R_ROOT});

  unless (exists $inihash->{R_MPMASOUT}) {
	$inihash->{R_MPMASOUT} = "out/" ;
	$inihash->{R_MPMASOUT} = $inihash->{RUNOUTDIR}."/out/"   if (exists $inihash->{RUNOUTDIR});
  }
  unless (exists $inihash->{R_MPMASLAB}) {
	$inihash->{R_MPMASLAB} = "input/dat/" ;
	$inihash->{R_MPMASLAB} = $inihash->{RUNINDIR}."/input/dat/"   if (exists $inihash->{RUNINDIR});
  }

  my $prefix = "untitled";
  $prefix = $inihash->{PREFIX} if(defined $inihash->{PREFIX});
  my $scenstring = "\"".join("\", \"", @$scenlist)."\"";
  my $periodstring = join(", " , (1..$num_periods));

  my $o_keep = "TRUE";
  $o_keep = "FALSE" if (exists $inihash->{R_TO_WORKSPACE} and not $inihash->{R_TO_WORKSPACE});

  my $o_tab = "TRUE";
  $o_tab = "FALSE" if (exists $inihash->{R_TO_TAB} and not $inihash->{R_TO_TAB});

  my $o_lean = "TRUE";
  $o_lean = "FALSE" if ($inihash->{R_ALL});

  my $o_join_raw = "TRUE";
  $o_join_raw = "FALSE" if (exists $inihash->{R_JOIN_RAW} and not $inihash->{R_JOIN_RAW});

  my $o_join_group = "TRUE";
  $o_join_group = "FALSE" if (exists $inihash->{R_NO_USERSET} and not $inihash->{R_NO_USERSET});

  my $o_nogroup = "FALSE";
  $o_nogroup = "TRUE" if ($inihash->{R_NO_USERVARS});

  my $shdw = "FALSE";
  $shdw = "TRUE" if ($saveSHDW_SWITCHforRimport);

  my $o_filter = "FALSE";
  my $filterstring = "1";
  if (defined $inihash->{R_FILTER} and $inihash->{R_FILTER}) {
      $o_filter = "TRUE"
      ;
      $filterstring = "\"".join("\", \"", split ( /\s*,\s*/ ,  $inihash->{R_FILTER})) ."\"";
  }
  my $performancestring = '"TotalGrossMargin", "Cashflow", "Income",
					"ValueAdded", "EquityCapital", "PaymentToLand",
					"RelativeFactorPayments", "OnFarmLabor", "OnFarmCapital",
					"InterestsPaid", "DistanceCosts",
					"AdditionalTransportCosts", "WithdrawalsForConsumption",
					"LiquidMeans", "MigrationDecision",
					"LastLpSolved", "FixCosts",
					"TranspCosts", "Deposits", "Depreciation",
					"LiqMeansUsedForInvestment", "PrincipalPaid", "DebtCapital", "ExpRemainingLifetime", "AgeHHead", "RentalPayments", "GrossInvestments", "AssetSales"';
  my $nonzeroact_string = 'activities';
  if( $saveCONSTYPEforRimport == 1) {
	    $performancestring = '"HouseholdIncome", "NetCashEarningsFromMILP", "NetInKindEarningsFromMILP",
					"AppreciationOfDurableAssets", "DepreciationOfDurableAssets", "Savings", "ExtraConsumption",
					"TotalConsumption", "ValueAdded", "EquityCapital", "PaymentToLand", "RelativeRactorPayment",
					"OnFarmLabor", "OnFarmCapital", "InterestsPaid", "DistanceCosts", "AdditionalTransportCosts",
					"NumberOfMaleAdults", "NumberOfFemaleAdults", "NumberOfMaleChildren", "NumberOfFemaleChildren",
					"WithdrawalsForConsumption", "LiquidMeans", "MigrationDecision", "LastLpSolved(inv=1,prd=2,con=3)", "DebtCapital"';
	    $nonzeroact_string='activities';
  }

  #Open file
  open(my $R_import_out, ">",  $inihash->{RUNSCRIPTDIR}.$inihash->{PREFIX}."import.R") or print STDERR "$!" and exit(1);
  
  #Print script
  print $R_import_out 
<<RIMPORTSCRIPT;
########################################################################################################
# Script to import Mpmas output into R (or transform it into more readable text files using R) 
# automatically generated by mpmasql
#
# (c)  Christian Troost, Universität Hohenheim, 2012
#######################################################################################################
# Part I: Settings
# These settings might be adapted by the user


#Directories
dir_root<-"$inihash->{R_ROOT}"
dir_out<-"$inihash->{R_ROOT}$inihash->{R_MPMASOUT}"
dir_lab<-"$inihash->{R_ROOT}$inihash->{R_MPMASLAB}"
dir_file_out<-"$inihash->{R_ROOT}R/data/"

#Scenarios & periods to import
prefix = "$prefix"
scenarios<-c($scenstring)
periods<-c($periodstring)

#What to do with them
keep_in_workspace<-$o_keep
save_as_tab<-$o_tab
lean<-$o_lean
join_raw<-$o_join_raw
join_group<-$o_join_group
nogroup<-$o_nogroup
filter<-$o_filter
filter_vars<-c($filterstring)
shdwyno<-$shdw
#
########################################################################################################
# Part II:  The actual script 

#Constants
header_all<-c("DataType","AgentID", "CatchmentID", "SectorID","FarmsteadID","PopulationID","ClusterID","NetworkID","SegmentID","TypeOfExpectations","ColorInMaps","Xcoordinate","Ycoordinate","NumberOfPlots")
header_end_all<-c("period","scenario","exit")
p_header<-c($performancestring)
notfirst14 <-array(,dim=14)
notfirst14[1:14]<-FALSE
notheaderend<-c(FALSE, FALSE, FALSE)

#Make output directory unless it exists
if(save_as_tab) {
	dir.create(paste(dir_file_out,"tab/",prefix,"/", sep=""), recursive=TRUE)
}
if(keep_in_workspace) {
	dir.create(paste(dir_file_out,"workspaces/", sep=""), recursive=TRUE)
}
#auxiliary flag
first_period<-TRUE

#loop over scenarios
for (s in scenarios) {
#loop over periods
	for (p in periods) {

##Read files and split by content type
### k
		a<-file.info(paste(dir_out, prefix,s,"_k", sprintf("%02d",p),".out", sep = ""))
		if (! is.na(a\$size) && a\$size > 0) {
			tmp<-read.table(paste(dir_out, prefix,s,"_k", sprintf("%02d",p),".out", sep = ""))
			tmp\$period = p
			tmp\$scenario = s
			tmp\$exit = FALSE
			rhs_<-tmp[ tmp[1] == 4, ]
			lhs_<-tmp[ tmp[1] == 5, ]
			
			if( shdwyno == TRUE) {
				shdw_<-tmp[ tmp[1] == 6, ]
			}
			rm(tmp)
		}
		else {
			rhs_ <- NULL
			lhs_ <- NULL
			if( shdwyno == TRUE) {
				shdw_<-NULL
			}
		}
### xk
		a<-file.info(paste(dir_out, prefix,s,"_xk", sprintf("%02d",p),".out", sep = ""))
		if (! is.na(a\$size) && a\$size > 0) {
			tmp<-read.table(paste(dir_out, prefix,s,"_xk", sprintf("%02d",p),".out", sep = ""))
			tmp\$period = p
			tmp\$scenario =  s
			tmp\$exit = TRUE
			rhsx_<-tmp[ tmp[1] == 4, ]
			lhsx_<-tmp[ tmp[1] == 5, ]

			if( shdwyno == TRUE) {
				shdwx_<-tmp[ tmp[1] == 6, ]
			}
			rm(tmp)
		}
		else {
			rhsx_ <-NULL
			lhsx_ <- NULL
			if( shdwyno == TRUE) {
				shdwx_<-NULL
			}
		}
### u		
		a<-file.info(paste(dir_out, prefix,s,"_u", sprintf("%02d",p),".out", sep = ""))
		if (! is.na(a\$size) && a\$size > 0) {
			tmp<-read.table(paste(dir_out, prefix,s,"_u", sprintf("%02d",p),".out", sep = ""))
			tmp\$period = p
			tmp\$scenario = s
			tmp\$exit = FALSE
			sol_<-tmp[ tmp[1] == 2, ]
			prices_<-tmp[ tmp[1] == 3, ]
			obj_ <- sol_[c(notfirst14, rep(TRUE, length(sol_) - length(notfirst14) - length(notheaderend)), notheaderend)] * prices_[c(notfirst14, rep(TRUE, length(sol_) - length(notfirst14) - length(notheaderend)), notheaderend)]
			obj_ <- cbind(sol_[1:14],obj_ ,sol_[ (length(sol_) -3 ): length(sol_)])
			rm(tmp)
		}
		else {
			sol_ <- NULL
			prices_ <- NULL
			obj_<-NULL
		}
### xu
		a<-file.info(paste(dir_out, prefix,s,"_xu", sprintf("%02d",p),".out", sep = ""))
		if (! is.na(a\$size) && a\$size > 0) {
			tmp<-read.table(paste(dir_out, prefix,s,"_xu", sprintf("%02d",p),".out", sep = ""))
			tmp\$period = p
			tmp\$scenario =  s
			tmp\$exit = TRUE
			solx_<-tmp[ tmp[1] == 2, ]
			pricesx_<-tmp[ tmp[1] == 3, ]
			objx_ <- solx_[c(notfirst14, rep(TRUE, length(solx_) - length(notfirst14) - length(notheaderend)), notheaderend)] * pricesx_[c(notfirst14, rep(TRUE, length(solx_) - length(notfirst14) - length(notheaderend)), notheaderend)]
			objx_ <- cbind(solx_[1:14],objx_ ,solx_[ (length(solx_) -3 ): length(solx_)])

			rm(tmp)
		}
		else {
			solx_ <-NULL
			pricesx_ <- NULL
			objx_<-NULL
		}		
### p
		a<-file.info(paste(dir_out, prefix,s,"_p", sprintf("%02d",p),".out", sep = ""))
		if (! is.na(a\$size) && a\$size > 0) {
			tmp<-read.table(paste(dir_out, prefix,s,"_p", sprintf("%02d",p),".out", sep = ""))
			tmp\$period = p
			tmp\$scenario = s
			tmp\$exit = FALSE
			perf_<-tmp[ tmp[1] == 1, ]
			rm(tmp)
		}
		else {
			perf_ <- NULL
		}
### xp
		a<-file.info(paste(dir_out, prefix,s,"_xp", sprintf("%02d",p),".out", sep = ""))
		if (! is.na(a\$size) && a\$size > 0) {
			tmp<-read.table(paste(dir_out, prefix,s,"_xp", sprintf("%02d",p),".out", sep = ""))
			tmp\$period = p
			tmp\$scenario =  s
			tmp\$exit = TRUE
			perfx_<-tmp[ tmp[1] == 1, ]
			rm(tmp)
		}
		else {
			perfx_ <-NULL
		}


#Merge with other periods
		if(first_period) {
			rhs<-rbind(rhs_, rhsx_)
			lhs<-rbind(lhs_, lhsx_)
			solution<-rbind(sol_, solx_)
			prices<-rbind(prices_, pricesx_)
			obj<-rbind(obj_, objx_)
			performance<-rbind(perf_, perfx_)
			first_period<-FALSE
			if( shdwyno == TRUE) {
				shdw<-rbind(shdw_, shdwx_)
			}
		}	
		else {	
			rhs<-rbind(rhs, rhs_, rhsx_)
			lhs<-rbind(lhs, lhs_, lhsx_)
			solution<-rbind(solution, sol_, solx_)
			prices<-rbind(prices, prices_, pricesx_)
			obj<-rbind(obj, obj_, objx_)
			performance<-rbind(performance, perf_, perfx_)
			if( shdwyno == TRUE) {
				shdw<-rbind(shdw, shdw_, shdwx_)
			}
		}
		rm(rhs_, lhs_, rhsx_, lhsx_, a, prices_, pricesx_, sol_, solx_, obj_, objx_, perf_, perfx_)
		if( shdwyno == TRUE) {
			rm(shdw_, shdwx_)
		}
	}
#Set column names
	constraints<-read.table(paste(dir_lab, prefix,s,"_ConstraintInfo.txt", sep = ""), header=TRUE, sep="\\t", quote="")
	nonzero_constraints<-constraints[constraints\$MpmasqlType != "MASzero" &    constraints\$MpmasqlType != "MASforget" ,]

	activities<-read.table(paste(dir_lab, prefix,s,"_ActivityInfo.txt", sep = ""), header=TRUE, sep="\\t", quote="")
	nonzero_activities<-$nonzeroact_string

	names(performance)<-c(header_all, p_header, header_end_all)
	names(solution)<-c(header_all, as.character(nonzero_activities[, "Code"]), header_end_all)
	names(prices)<-c(header_all, lapply(as.character(nonzero_activities[, "Code"]), function(x) paste("prices_",x, sep="")), header_end_all)
	names(obj)<-c(header_all, lapply(as.character(nonzero_activities[, "Code"]), function(x) paste("obj_",x, sep="")), header_end_all)

	names(rhs)<-c(header_all,lapply(as.character(nonzero_constraints[, "Code"]), function(x) paste("rhs_",x, sep="")), header_end_all)
	names(lhs)<-c(header_all, lapply(as.character(nonzero_constraints[, "Code"]), function(x) paste("lhs_",x, sep="")), header_end_all)
	if( shdwyno == TRUE) {
		names(shdw)<-c(header_all, lapply(as.character(nonzero_constraints[, "Code"]), function(x) paste("shdw_",x, sep="")), header_end_all)
	}

	info_block<-performance[,c("FarmsteadID" ,header_end_all)]
	if (join_group) {
		userset<-performance
	}
#Column aggregation
	if (!nogroup) {
#Aggregate columns and create result variable datasets for constraints
		cgroups<-names(constraints)
		if ( length(cgroups) >  5) {
		    for (g in cgroups[6: (length(cgroups) ) ] ) {
			    res<-as.data.frame(sapply( unique(nonzero_constraints[nonzero_constraints[[g]] != "-1",g ]), function (t) rowSums(as.matrix(rhs[, c(notfirst14, nonzero_constraints[[g]] == as.character(t), notheaderend ) ] ))))
			    if(NROW(rhs) == 1 ) {
						res<-as.data.frame(t(res))
				 }
			    names(res)<-lapply( unique(nonzero_constraints[nonzero_constraints[[g]] != "-1", g]), function(x) paste(g, "_rhs_",x, sep="")) 
			    if (NROW(res) > 0 ) {
				  if(join_group) {
					  userset<-cbind(userset, res)
				  }

				  res<-cbind(info_block,res)

				  if (keep_in_workspace) {
					  assign(paste(s, "_rhs_", g, sep=""), res)
				  }
				  if (save_as_tab) {
					  write.table(res, paste(dir_file_out,"tab/",prefix,"/",s,"_rhs_",g,".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)	
				  }
			    }
			    rm(res)

			    res<-as.data.frame(sapply( unique(nonzero_constraints[nonzero_constraints[[g]] != "-1",g]), function (t) rowSums(as.matrix(rhs[, c(notfirst14, nonzero_constraints[[g]] == as.character(t), notheaderend) ] ))))
			    if(NROW(rhs) == 1 ) {
						as.data.frame(res<-t(res))
				 }
			    names(res)<-lapply(unique(nonzero_constraints[nonzero_constraints[[g]] != "-1",g]), function(x) paste(g, "_lhs_",x, sep="")) 
			    if (NROW(res) > 0 ) {
				  if(join_group) {
					  userset<-cbind(userset, res)
				  }

				  res<-cbind(info_block,res)
				  if (keep_in_workspace) {
					  assign(paste(s, "_lhs_", g, sep=""), res)
				  }
				  if (save_as_tab) {
					  write.table(res, paste(dir_file_out,"tab/",prefix,"/",s,"_lhs_",g,".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)	
				  }
			    }
			    rm(res)

		    }
		}
#Aggregate columns and create result variable datasets for activities
		agroups<-names(activities)
		if (length(agroups) > 6) {
		      for (g in agroups[7: (length(agroups)) ] ) {
			      res<-as.data.frame(sapply( unique(nonzero_activities[nonzero_activities[[g]] != "-1",g]), function (t) rowSums(as.matrix(solution[, c(notfirst14, nonzero_activities[[g]] == as.character(t), notheaderend) ] ))))
			      if(NROW(solution) == 1 ) {
						res<-as.data.frame(t(res))
				   }
			      names(res)<-lapply(unique(nonzero_activities[nonzero_activities[[g]] != "-1",g]), function(x) paste(g, "_",x, sep="")) 
			      if (NROW(res) > 0 ) {    
				      if(join_group) {
					      userset<-cbind(userset, res)
				      }

				      res<-cbind(info_block,res)
				      if (keep_in_workspace) {
					      assign(paste(s, "_solution_", g, sep=""), res)
				      }
				      if (save_as_tab) {
					      write.table(res, paste(dir_file_out,"tab/",prefix,"/",s,"_solution_",g,".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)								
				      }
			      }
			      rm(res)
		      }
		}

#Aggregate columns and create result variable datasets for accounts

		for (g in agroups[6] ) {
			res<-as.data.frame(sapply( unique(nonzero_activities[nonzero_activities[[g]] != "-1",g]), function (t) rowSums(as.matrix(obj[, c(notfirst14, nonzero_activities[[g]] == as.character(t), notheaderend) ] ))))
			if(NROW(obj) == 1 ) {
				res<-as.data.frame(t(res))
			}
			names(res)<-lapply(unique(nonzero_activities[nonzero_activities[[g]] != "-1",g]), function(x) paste("account_",x, sep="")) 
			if (NROW(res) > 0 ) {    
				if(join_group) {
					userset<-cbind(userset, res)
				}

				res<-cbind(info_block,res)
				if (keep_in_workspace) {
					assign(paste(s, "_account", sep=""), res)
				}
				if (save_as_tab) {
					write.table(res, paste(dir_file_out,"tab/",prefix,"/",s,"_account",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)								
				}
			}
			rm(res)
		}
	}

#Make a combined dataset of raw data
	if (join_raw || (lean && !join_group)) {
		raw_joint<-cbind(performance, solution, rhs)
		if (keep_in_workspace) {
			assign(paste(s, "_combined", sep=""), raw_joint)
		}
		if (save_as_tab) {
			write.table(raw_joint, paste(dir_file_out,"tab/",prefix,"/",s,"_combined",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)								
		}
	}
	if (join_group) {
		if (keep_in_workspace) {
			assign(paste(s, "_userset", sep=""), userset)
		}
		if (save_as_tab) {
			write.table(userset, paste(dir_file_out,"tab/",prefix,"/",s,"_userset",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)								
		}		
	}
	if (join_group && filter) {
		if (keep_in_workspace) {
			assign(paste(s, "_userset_filtered", sep=""), userset[, c(header_end_all, filter_vars)])
		}
		if (save_as_tab) {
			write.table(userset[, c(header_end_all, filter_vars)], paste(dir_file_out,"tab/",prefix,"/",s,"_userset_filtered",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)								
		}

	}

#Attach scenario prefix to raw datasets, in case the user chose to keep them in the workspace
	if (keep_in_workspace && !lean) {
		assign(paste(s, "_rhs", sep=""), rhs)
		assign(paste(s, "_solution", sep=""), solution)
		assign(paste(s, "_obj", sep=""), obj)
		assign(paste(s, "_lhs", sep=""), lhs)
		assign(paste(s, "_performance", sep=""), performance)
		assign(paste(s, "_orow", sep=""), prices)
		assign(paste(s, "_nz_constraints", sep=""), nonzero_constraints)
		assign(paste(s, "_nz_activities", sep=""), nonzero_activities)
		if( shdwyno == TRUE) {
			assign(paste(s, "_shdw", sep=""), shdw)
		}

	}
	if( save_as_tab && shdwyno == TRUE) {
		write.table(shdw, paste(dir_file_out,"tab/",prefix,"/",s,"_shdw",".txt", sep=""), sep="	", quote=FALSE, row.names=FALSE)				
	}
#Save raw datasets as tab-separated text files if the user requests this
	if (save_as_tab && !lean) {
		write.table(rhs, paste(dir_file_out,"tab/",prefix,"/",s,"_rhs",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)				
		write.table(lhs, paste(dir_file_out,"tab/",prefix,"/",s,"_lhs",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)				
		write.table(solution, paste(dir_file_out,"tab/",prefix,"/",s,"_solution",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)
		write.table(obj, paste(dir_file_out,"tab/",prefix,"/",s,"_obj",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)				
		write.table(performance, paste(dir_file_out,"tab/",prefix,"/",s,"_performance",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)				
		write.table(prices, paste(dir_file_out,"tab/",prefix,"/",s,"_orow",".txt", sep=""), sep="\t", quote=FALSE, row.names=FALSE)				
	}



#Remove temporary objects
	rm(rhs, lhs, solution, obj, performance, prices, constraints, activities, agroups,cgroups, g, userset, raw_joint, info_block, nonzero_activities, nonzero_constraints)
	if( shdwyno == TRUE) {
		rm(shdw)
	}
#Set firstperiod to TRUE
	first_period<-TRUE
}

#Remove auxiliary objects
rm(s,p,first_period)
rm(save_as_tab,dir_lab, dir_out, dir_root, join_raw, join_group, lean, nogroup, header_all, header_end_all, p_header)

#Save workspace
if (keep_in_workspace) {
    save.image(paste(dir_file_out,"workspaces/",prefix, ".RData", sep=""))
}
rm(keep_in_workspace, dir_file_out)
###### end of script ######################################################################################################################################################
RIMPORTSCRIPT

  #Close file
  close($R_import_out);
}
