library(rLingo)

SaleTerrDsgn <- function(NDS, SALEST, WORKT, SUMDWGT, CUSTOMER, WORK, SALESV, LATI, LNGT)
{
    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,"SaleTerrDsgn.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 CUSTOMER is a set, so its pointer must be passed to LINGO first.
    pResult <- rLSsetCharPointerLng(pLINGO, CUSTOMER, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

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

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

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

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

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

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

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

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

    #@POINTER(10)
    WORKA = numeric(length(WORK))
    pResult <- rLSsetDouPointerLng(pLINGO, WORKA, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }
    
    #@POINTER(11)
    DISTA = numeric(length(WORK))
    pResult <- rLSsetDouPointerLng(pLINGO, DISTA, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }
    
    #@POINTER(12)
    SALESA = numeric(length(WORK))
    pResult <- rLSsetDouPointerLng(pLINGO, SALESA, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }
    
    #@POINTER(13)
    DIST = matrix(numeric(length(WORK)*length(WORK)),nrow=length(WORK),ncol=length(WORK))
    pResult <- rLSsetDouPointerLng(pLINGO, DIST, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }
    
    #@POINTER(14)
    Z = matrix(numeric(length(WORK)*length(WORK)),nrow=length(WORK),ncol=length(WORK))
    pResult <- rLSsetDouPointerLng(pLINGO, Z, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(15)
    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 SaleTerrDsgn.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! \n")
    }
    else if(dStatus == LS_STATUS_LOCAL_LNG)
    {
        cat("\nLocal optimum found! \n")
    }
    else
    {
        cat("\nSolution is non-optimal, status = ", dStatus, "\n")
        return(pResult)
    }
    
    cat("\nDistrict Design Analysis \n")
    cat(" Input data summary: \n")
    
    cat(sprintf("%10.0f= Number districts.\n",NDS ))
    
    SUMWORK = sum(WORK)
    cat(sprintf("%10.2f= Average work/district.       %10.2f = Max allowed.\n", SUMWORK/NDS, WORKT))
    
    SUMSALESV = sum(SALESV)
    cat(sprintf("%10.2f= Average sales value/district.%10.2f = Min allowed.\n", SUMSALESV/NDS, SALEST))
        
    cat(" Solution summary:\n")
    
    cat(" District    Centroid    Workload   Sales_potential  Distance_from_centroid\n")
    id = 0
    for(j in 1:length(WORK))
    {
        if(Z[j,j] > 0.5)
        {
            id = id + 1
            cat(sprintf("%6.0f   %12s%12.1f%14.2f%17.2f\n",id,strsplit(CUSTOMER,split=" ")[[1]][2*(j-1)+1],WORKA[j],SALESA[j],DISTA[j]))
        }
    }
    
    cat(" Assignment detail:\n")
    cat("       Centroid      Customer Assigned\n")
    for(j in 1:length(WORK))
    {
        if(Z[j,j] > 0.5)
        {
            for(i in 1:length(WORK))
            {
                if(Z[j,i] > 0)
                {
                    cat(sprintf("%15s%15s\n",strsplit(CUSTOMER,split=" ")[[1]][2*(j-1)+1],strsplit(CUSTOMER,split=" ")[[1]][2*(i-1)+1]))
                }
            }
        }
    }

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

#All inputs are initialized here

#Number of regions to construct
NDS = c(3)

#Sales minimum target for each region
SALEST = c(181)

#Work maximum target for each region
WORKT = c(25)

#"Epsilon" weight assigned to minimizing total 
#distance from centroids in objective, in addition 
#to main objective of minimizing maximum distance 
#in any region.
SUMDWGT = c(0.75)

#Customers
CUSTOMER = c("AMARILLO \n BEAUMONT \n BROWNSVILLE \n BRACKETTVIL \n CLARKSVILLE \n CORPUS_CHR \n EL_PASO \n GALVESTON \n KLONDIKE \n LUBBOCK \n MARFA \n PECOS \n TEXARKANA \n TEXHOMA \n TEXLINE \n WACO \n")

#Workload
WORK = c(7,3,6,1,3,6,9,5,4,5,3,5,5,1,1,3)

#Sales value potential
SALESV = c(46,31,42,13,17,39,64,39,54,44,46,43,33,17,12,21)

#Latitude
LATI = c(35.2,30.08,25.92,29.31,33.61,27.8,31.84,29.3,33.32,33.57,30.31,31.4,33.44,36.5,36.37,31.47)

#Longitude
LNGT = c(-101.81,-94.14,-97.48,-100.41,-95.05,-97.39,-106.43,-94.79,-95.75,-101.87,-104.02,-103.5,-94.07,-101.78,-103.01,-97.24)

#Run the function
SaleTerrDsgn(NDS, SALEST, WORKT, SUMDWGT, CUSTOMER, WORK, SALESV, LATI, LNGT)