# gdxrrw.R
#
# Copyright (c) 2010-2021 GAMS Development Corp. <support@gams.com>
# Copyright (c) 2010-2021 GAMS Software GmbH <support@gams.com>
#
# This program and the accompanying materials are made available
# under the terms of the Eclipse Public License 2.0 which is
# available at  http://www.eclipse.org/legal/epl-2.0.
#
# This Source Code may also be made available under the following
# Secondary Licenses when the conditions for such availability set
# forth in the Eclipse Public License, v. 2.0 are satisfied:
# GNU General Public License, version 2 or later
#
# SPDX-License-Identifier: EPL-2.0 OR GPL-2.0-or-later
#
rgdx <- function(gdxName, requestList = NULL, squeeze=TRUE, useDomInfo=TRUE,
                 followAlias=TRUE)
{
  if (is.null(requestList) && (gdxName == '?')) {
    invisible(.External(rgdxExt, gdxName=gdxName, requestList=NULL,
                        squeeze=squeeze, useDomInfo=useDomInfo,
                        followAlias=followAlias))
  }
  else {
    .External(rgdxExt, gdxName=gdxName, requestList=requestList,
              squeeze=squeeze, useDomInfo=useDomInfo,
              followAlias=followAlias)
  }
}

wgdx <- function(gdxName, ..., squeeze='y')
{
  invisible(.External(wgdxExt, gdxName=gdxName, ..., squeeze=squeeze))
}

gams <- function(gmsAndArgs)
{
  .External(gamsExt, gmsAndArgs)
}

gdxInfo <- function(gdxName = NULL, dump=TRUE, returnList=FALSE, returnDF=FALSE)
{
  d <- as.logical(dump)
  if (is.na(d)) {
    stop ("gdxInfo: argument dump=", print(dump), " not a good logical value")
  }
  rl <- as.logical(returnList)
  if (is.na(rl)) {
    stop ("gdxInfo: argument returnList=", print(returnList), " not a good logical value")
  }
  rdf <- as.logical(returnDF)
  if (is.na(rdf)) {
    stop ("gdxInfo: argument returnDF=", print(returnDF), " not a good logical value")
  }
#  print (paste('gdxInfo: dump=',d,'returnList=',rl,'returnDF=',rdf))
  if (! (rl || rdf)) {
    invisible(.External(gdxInfoExt, gdxName=gdxName, dump=d, returnList=rl,
                        returnDF=rdf))
  }
  else {
    .External(gdxInfoExt, gdxName=gdxName, dump=d, returnList=rl,
              returnDF=rdf)
  }
} # gdxInfo

igdx <- function(gamsSysDir = NULL, silent = FALSE, returnStr = FALSE)
{
  invisible(.External(igdxExt, gamsSysDir, silent=silent, returnStr=returnStr))
}

rgdx.param <- function(gdxName, symName, names=NULL, compress=FALSE,
                       ts=FALSE, squeeze=TRUE, useDomInfo=TRUE,
                       check.names=TRUE)
{
  sym <- rgdx(gdxName, list(name=symName,compress=compress,ts=ts),squeeze=squeeze,useDomInfo=useDomInfo)
  if (sym$type != "parameter") {
    stop ("Expected to read a parameter: symbol ", symName, " is a ", sym$type)
  }
  symDim <- sym$dim
  if (symDim < 1) {
    stop ("Symbol ", symName, " is a scalar: data frame output not possible")
  }

  fnames <- list()
  if (is.null(names)) {
    ## no names passed via args
    domainNames <- getOption('gdx.domainNames',default=T)
    if (domainNames) {
      domainNames <- ! ( ("NA"==sym$domInfo) ||
                         ("none"==sym$domInfo) ||
                         ("unknown"==sym$domInfo) )
    }
    if (domainNames) {
      fnames <- sym$domains
      if (check.names) {
        fnames <- patchNames(fnames,symDim)
      }
      fnames[[symDim+1]] <- sym$name
    }
    else {
      fnames <- defNames(symDim,T)
    }
  } else {
    # process the user-provided names
    if (is.vector(names)) {
      namlen <- length(names)
      d2 <- 1
      for (d in c(1:symDim)) {
        fnames[[d]] <- as.character(names[d2])
        d2 <- d2+1
        if (d2 > namlen) d2 <- 1
      }
      # consider 2 cases: names provided just for the index cols,
      # or for the data column too
      if (namlen <= symDim) {
        fnames[[symDim+1]] <- "value"
      }
      else {
        fnames[[symDim+1]] <- as.character(names[d2])
      }
    } else if (is.list(names)) {
      namlen <- length(names)
      d2 <- 1
      for (d in c(1:symDim)) {
        fnames[[d]] <- as.character(names[[d2]])
        d2 <- d2+1
        if (d2 > namlen) d2 <- 1
      }
      # consider 2 cases: names provided just for the index cols,
      # or for the data column too
      if (namlen <= symDim) {
        fnames[[symDim+1]] <- "value"
      }
      else {
        fnames[[symDim+1]] <- as.character(names[[d2]])
      }
    } else {
      for (d in c(1:symDim)) {
        fnames[[d]] <- paste(as.character(names),d,sep=".")
      }
      fnames[[symDim+1]] <- "value"
    }
  }
  if (check.names) {
    fnames <- make.names(fnames,unique=TRUE)
  }

  dflist <- list()
  if (0 == dim(sym$val)[1]) {           # empty symbol - no elements
    for (d in c(1:symDim)) {
      dflist[[d]] <- factor(numeric(0))
    }
  } else {
    for (d in c(1:symDim)) {
      nUels <- length(sym$uels[[d]])
      # first arg to factor must be integer, not numeric: different as.character results
      dflist[[d]] <- factor(as.integer(sym$val[,d]), seq(to=nUels), labels=sym$uels[[d]])
    }
  }
  dflist[[symDim+1]] <- sym$val[,symDim+1]
  names(dflist) <- fnames
  symDF <- data.frame(dflist, check.names=check.names)
  attr(symDF,"symName") <- sym$name
  attr(symDF,"domains") <- sym$domains
  ## for now, make domInfo conditional
  if (is.character(sym$domInfo)) {
    attr(symDF,"domInfo") <- sym$domInfo
  }
  if (ts) {
    attr(symDF,"ts") <- sym$ts
  }
  return(symDF)
} # rgdx.param

rgdx.scalar <- function(gdxName, symName, ts=FALSE)
{
  request <- list(name=symName,ts=ts)
  readsym <- rgdx(gdxName, request)
  if (readsym$type != "parameter") {
    stop ("Expected to read a scalar: symbol ", symName, " is a ", readsym$type)
  }
  dimsym <- readsym$dim
  if (dimsym > 0) {
    stop ("Parameter ", symName, " has dimension ", dimsym, ": scalar output not possible")
  }
  c <- 0
  if (1 == dim(readsym$val)[1]) {
    c <- readsym$val[1,1]
  }
  attr(c,"symName") <- readsym$name
  if (ts) {
    attr(c,"ts") <- readsym$ts
  }
  return(c)
} # rgdx.scalar

# replace * in domain names with .i, .i4, etc.
# good to use before make.names gets the *'s
patchNames <- function(dNames,n)