output.R

# |  (C) 2006-2019 Potsdam Institute for Climate Impact Research (PIK)
# |  authors, and contributors see CITATION.cff file. This file is part
# |  of REMIND and licensed under AGPL-3.0-or-later. Under Section 7 of
# |  AGPL-3.0, you are granted additional permissions described in the
# |  REMIND License Exception, version 1.0 (see LICENSE file).
# |  Contact: remind@pik-potsdam.de
##########################################################
#### REMIND Output Generation ####
##########################################################
# Version 1.0
# Type "Rscript output.R" to start the script in the command line

# Based on the Version 2.2 of same file in the MAgPIE main folder
#########################################################################################

#Write dump file when error occurs, see help to dump.frames for more information
options(error=quote({dump.frames(to.file=TRUE); traceback(); q()}))

#load landuse library

library(lucode)

###Define arguments that can be read from command line
if(!exists("source_include")) {
  readArgs("outputdir","output","comp","remind_dir")
}
#Setting relevant paths
if(file.exists('/iplex/01/landuse')) { #run is performed on the cluster
  pythonpath <- '/iplex/01/landuse/bin/python/bin/'
  latexpath <- '/iplex/01/sys/applications/texlive/bin/x86_64-linux/'
} else {
  pythonpath <- ''
  latexpath <- NA
}

get_line <- function(){
	# gets characters (line) from the terminal of from a connection
	# and stores it in the return object
	if(interactive()){
		s <- readline()
	} else {
		con <- file("stdin")
		s <- readLines(con, 1, warn=FALSE)
		on.exit(close(con))
	}
	return(s);
}

choose_folder <- function(folder,title="Please choose a folder") {
  dirs <- NULL
  
  # Detect all output folders containing fulldata.gdx
  # For coupled runs please use the outcommented text block below

  dirs <- sub("/fulldata.gdx","",sub("./output/","",Sys.glob(file.path(folder,"*","fulldata.gdx"))))

  # DK: The following outcommented lines are specially made for listing results of coupled runs
  #runs <- findCoupledruns(folder)
  #dirs <- findIterations(runs,modelpath=folder,latest=TRUE)
  #dirs <- sub("./output/","",dirs)
  
  dirs <- c("all",dirs)
  cat("\n\n",title,":\n\n")
  cat(paste(1:length(dirs), dirs, sep=": " ),sep="\n")
	cat(paste(length(dirs)+1, "Search by the pattern.\n", sep=": "))
  cat("\nNumber: ")
	identifier <- get_line()
  identifier <- strsplit(identifier,",")[[1]]
  tmp <- NULL
  for (i in 1:length(identifier)) {
    if (length(strsplit(identifier,":")[[i]]) > 1) tmp <- c(tmp,as.numeric(strsplit(identifier,":")[[i]])[1]:as.numeric(strsplit(identifier,":")[[i]])[2])
    else tmp <- c(tmp,as.numeric(identifier[i]))
  }
  identifier <- tmp
  # PATTERN
	if(length(identifier==1) && identifier==(length(dirs)+1)){
		cat("\nInsert the search pattern or the regular expression: ")
		pattern <- get_line()
		id <- grep(pattern=pattern, dirs[-1])
		# lists all chosen directories and ask for the confirmation of the made choice
		cat("\n\nYou have chosen the following directories:\n")
		cat(paste(1:length(id), dirs[id+1], sep=": "), sep="\n")
		cat("\nAre you sure these are the right directories?(y/n): ")
		answer <- get_line()
		if(answer=="y"){
			return(dirs[id+1])
		} else choose_folder(folder,title)
	# 
	} else if(any(dirs[identifier] == "all")){
		identifier <- 2:length(dirs)
		return(dirs[identifier])
	} else return(dirs[identifier])
}


choose_module <- function(Rfolder,title="Please choose an outputmodule") {
  module <- gsub("\\.R$","",grep("\\.R$",list.files(Rfolder), value=TRUE))
  cat("\n\n",title,":\n\n")
  cat(paste(1: length(module), module, sep=": " ),sep="\n")
  cat("\nNumber: ")
  identifier <- get_line()
  identifier <- as.numeric(strsplit(identifier,",")[[1]])
  if (any(!(identifier %in% 1:length(module)))) stop("This choice (",identifier,") is not possible. Please type in a number between 1 and ",length(module))
  return(module[identifier])
}

choose_mode <- function(title="Please choose the output mode") {
  modes <- c("Output for single run ","Comparison across runs")
  cat("\n\n",title,":\n\n")
  cat(paste(1:length(modes), modes, sep=": " ),sep="\n")
  cat("\nNumber: ")
  identifier <- get_line()
  identifier <- as.numeric(strsplit(identifier,",")[[1]])
  if (identifier==1) {
    comp<-FALSE
  } else if (identifier==2) {
    comp<-TRUE
  } else {
    stop("This mode is invalid. Please choose a valid mode")
  }  
  return(comp)
}

if(exists("source_include")) {
  comp <- FALSE
} else {
  if(!exists("comp")) {
    comp<-choose_mode("Please choose the output mode")
  }
}


if (comp==TRUE) {
  print("comparison")
  # Select output modules if not defined by readArgs
  if(!exists("output")) {
    output <- choose_module("./scripts/output/comparison","Please choose the output module to be used for output generation")
  }
  # Select output directories if not defined by readArgs
  if (!exists("outputdir")) {
    if (!exists("remind_dir")) {
      temp <- choose_folder("./output","Please choose the runs to be used for output generation")
      outputdirs <- temp
      for (i in 1:length(temp)) outputdirs[i] <- path("output",temp[i])
    } else {
      temp <- choose_folder(remind_dir,"Please choose the runs to be used for output generation")
      outputdirs <- temp
      for (i in 1:length(temp)) {
        last_iteration <- max(as.numeric(sub("magpie_","",grep("magpie_",list.dirs(path(remind_dir,temp[i],"data/results")),value=T))))
        outputdirs[i] <- path(remind_dir,temp[i],"data/results/",paste("magpie_",last_iteration,sep=""))
      }
    }
  } else outputdirs <- outputdir
  
  #Set value source_include so that loaded scripts know, that they are 
  #included as source (instead of a load from command line)
  source_include <- TRUE
  
  # Execute output scripts over all choosen folders
  for(rout in output){
    name<-paste(rout,".R",sep="")
    if(file.exists(paste("scripts/output/comparison/",name,sep=""))){
      print(paste("Executing",name))
      tmp.env <- new.env()
      tmp.error <- try(sys.source(paste("scripts/output/comparison/",name,sep=""),envir=tmp.env))
      rm(tmp.env)
      gc()
      if(!is.null(tmp.error)) warning("Script ",name," was stopped by an error and not executed properly!")
    } 
  }
  
  } else {

  # Select an output directory if not defined by readArgs
  if(!exists("outputdir")) {
    if (!exists("remind_dir")) {
      temp <- choose_folder("./output","Please choose the run(s) to be used for output generation")
      outputdirs <- temp
      for (i in 1:length(temp)) outputdirs[i] <- path("output",temp[i])
    } else {
      temp <- choose_folder(remind_dir,"Please choose the runs to be used for output generation")
      outputdirs <- temp
      for (i in 1:length(temp)) {
        last_iteration <- max(as.numeric(sub("magpie_","",grep("magpie_",list.dirs(path(remind_dir,temp[i],"data/results")),value=T))))
        outputdirs[i] <- path(remind_dir,temp[i],"data/results/",paste("magpie_",last_iteration,sep=""))
      }
    } 
  } else outputdirs <- outputdir
 
  #Execute outputscripts for all choosen folders
  for (outputdir in outputdirs) {

    # Select an output module if not defined by readArgs
    if(!exists("output")) {
      output <- choose_module("./scripts/output/single","Please choose the output module to be used for output generation")
    }
    
    if(exists("cfg")) {
      title    <- cfg$title
      gms      <- cfg$gms
      input    <- cfg$input
      revision <- cfg$revision
      magpie_folder <- cfg$magpie_folder
    }
    
    # Get values of config if output.R is called standalone
    if(!exists("source_include")) {
      magpie_folder <- getwd()
	  print(path(outputdir,"config.Rdata"))
      if(file.exists(path(outputdir,"config.Rdata"))) {
        load(path(outputdir,"config.Rdata"))
        title    <- cfg$title
        gms      <- cfg$gms
        input    <- cfg$input
        revision <- cfg$revision
      } else {
        config <- grep("\\.cfg$",list.files(outputdir), value=TRUE)
        l<-readLines(path(outputdir,config))
        title <- strsplit(grep("(cfg\\$|)title +<-",l,value=TRUE),"\"")[[1]][2]
        gms <- list()
        gms$scenarios <- strsplit(grep("(cfg\\$|)gms\\$scenarios +<-",l,value=TRUE),"\"")[[1]][2]
        input <- strsplit(grep("(cfg\\$|)input +<-",l,value=TRUE),"\"")[[1]][2]
        revision <- as.numeric(unlist(strsplit(grep("(cfg\\$|)revision +<-",l,value=TRUE),"<-[ \t]*"))[2])
      }
    }
    
    #Set value source_include so that loaded scripts know, that they are 
    #included as source (instead of a load from command line)
    source_include <- TRUE
   
    if (file.exists(path(outputdir,"output.RData"))) {
      data_workspace<-path(outputdir,"output.RData")
    } else {
      tmp<-strsplit(outputdir,"/")[[1]]
      data_workspace<-paste0(outputdir,"/",tmp[length(tmp)],".RData")
    }
    print(data_workspace)
    cat(paste("\nStarting output generation for",outputdir,"\n\n"))
    
    ###################################################################################
    # Execute R scripts
    ###################################################################################
    
    for(rout in output){
      name<-paste(rout,".R",sep="")
      if(file.exists(paste0("scripts/output/single/",name))){
        print(paste("Executing",name))
        tmp.env <- new.env()
        tmp.error <- try(sys.source(paste0("scripts/output/single/",name),envir=tmp.env))
#        rm(list=ls(tmp.env),envir=tmp.env)
        rm(tmp.env)
        gc()
        if(!is.null(tmp.error)) warning("Script ",name," was stopped by an error and not executed properly!")
      }
    }
    # finished
    cat(paste("\nFinished output generation for",outputdir,"!\n\n"))
    rm(source_include)
    print(warnings())
  }
}