library(rLingo)

PORTCardCor <- function(STOCK, CARD, TARG, RET, SD, CORR)
{
    pResult <- list(ErrorCode = LSERR_NO_ERROR_LNG)

    #Create Lingo enviroment object
    pLINGO <- rLScreateEnvLng();
    if(is.null(pLINGO))
    {
        cat("\ncannot create LINGO environment!\n")
        return(pResult)
    }

    #Open LINGO's log file
    pResult <- rLSopenLogFileLng(pLINGO,"PORTCardCor.log")
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #Pass memory transfer pointers to LINGO
    #Define pnPointersNow
    pnPointersNow = integer(1)

    #@POINTER(1)
    #Note that STOCK is a set, so its pointer must be passed to LINGO first.
    pResult <- rLSsetCharPointerLng(pLINGO, STOCK, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(2)
    pResult <- rLSsetDouPointerLng(pLINGO, CARD, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(3)
    pResult <- rLSsetDouPointerLng(pLINGO, TARG, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(4)
    pResult <- rLSsetDouPointerLng(pLINGO, RET, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(5)
    pResult <- rLSsetDouPointerLng(pLINGO, SD, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(6)
    pResult <- rLSsetDouPointerLng(pLINGO, CORR, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(7)
    AMT = numeric(length(RET))
    pResult <- rLSsetDouPointerLng(pLINGO, AMT, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(8)
    Z = numeric(length(RET))
    pResult <- rLSsetDouPointerLng(pLINGO, Z, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(9)
    PVAR = numeric(1)
    pResult <- rLSsetDouPointerLng(pLINGO, PVAR, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(10)
    dStatus = c(-1.0)
    pResult <- rLSsetDouPointerLng(pLINGO, dStatus, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #Here is the script we want LINGO to run
    cScript = "SET ECHOIN 1 \n TAKE PORTCardCor.lng \n GO \n QUIT \n"

    #Run the script
    pResult <- rLSexecuteScriptLng(pLINGO, cScript)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #Close the log file
    pResult <- rLScloseLogFileLng(pLINGO)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #Check solver status
    if(dStatus == LS_STATUS_GLOBAL_LNG)
    {
        cat("\nGlobal optimum found!")
    }
    else if(dStatus == LS_STATUS_LOCAL_LNG)
    {
        cat("\nLocal optimum found!")
    }
    else
    {
        cat("\nSolution is non-optimal, status = ", dStatus, "\n")
        return(pResult)
    }

    #Check solution
    cat("\nMin portfolio variance is", PVAR,".\n")
    for(i in 1:length(Z))
    {
         if(Z[i] > 0.9)
         {
              cat(AMT[i]*100, "percent of budget for ")
              cat(strsplit(STOCK,split=" ")[[1]][2*(i-1)+1], " \n")
         }
    }

    #Delete Lingo enviroment object
    pResult <- rLSdeleteEnvLng(pLINGO)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    return(pResult)
}

#All inputs are initialized here
#The stocks we are considering
STOCK = c("Alcoa \n Ford \n Deere \n Dupont \n PandG \n Chevron \n 3M \n USsteel \n Mcrsft \n")

#Limit on stocks in protfolio
CARD = c(4)

#Target return, 1+r, per year
TARG = c(1.07)

#Expected yearly growth factor (1+r) for each stock
RET = c(0.9853,1.2487,1.1279,1.0995,1.0531,1.0868,1.0992,1.0722,1.1089)

#Estimated yearly standard deviation in growth factor
SD = c(0.4134,0.5698,0.2883,0.2935,0.1550,0.2266,0.1946,0.6275,0.2194)

#Correlation matrix of the growth factors/returns, upper diagonal only
CORR = c(1.0000,0.5388,0.6670,0.6312,0.2909,0.5687,0.6028,0.6506,0.4155,
                1.0000,0.6204,0.5321,0.1150,0.3330,0.3775,0.4368,0.2620,
                       1.0000,0.6837,0.3213,0.4626,0.5921,0.6108,0.3577,
                              1.0000,0.3715,0.4817,0.6796,0.5356,0.4646,
                                     1.0000,0.3688,0.5061,0.2056,0.4199,
                                            1.0000,0.5976,0.4257,0.4010,
                                                   1.0000,0.4421,0.4723,
                                                          1.0000,0.3526,
                                                                 1.0000) 

#Run the function
PORTCardCor(STOCK, CARD, TARG, RET, SD, CORR)