library(rLingo)

samsizr <- function(AQL,LTFD,PRDRISK,CONRISK,MINSMP,MAXSMP)
{
    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,"samsizr.log")
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #pass memory transfer pointers to LINGO
    #define pnPointersNow
    pnPointersNow = integer(1)

    #@POINTER(1)
    AQL_1 = c(AQL)
    pResult <- rLSsetDouPointerLng(pLINGO, AQL_1, pnPointersNow)
    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

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

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

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

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

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

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

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

    #@POINTER(9)
    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 samsizr.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 solution
    cat("\nGiven:\n")
    cat(' ', AQL_1, " = AQL = Fraction defective allowed in acceptable/good lot.\n")
    cat(' ', LTFD_1, " = LTFD = Fraction defective in unacceptable/bad lot.\n")
    cat(' ', PRDRISK_1, " = Producer risk = Prob(rejecting a good lot).\n")
    cat(' ', CONRISK_1, " = Consumer risk = Prob(accepting a bad lot).\n")

    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\n")
        return(pResult)
    }


    if(pResult$ErrorCode != LSERR_NO_ERROR_LNG)
    {
        return(pResult)
    }

    #@POINTER(2)
    LTFD_1
    cat("\nThe Optimal(Minimum) sample size is",N,".\nAccept the lot if",C,"or less defectives in sample.\n\n")

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

    return(pResult)
}

samsizr(0.03,0.08,0.09,0.05,125.,400.)