.packageName <- "lpSolve"
lp <- function(direction = "min", objective.in, const.mat, const.dir, const.rhs,
	transpose.constraints = TRUE, int.vec, presolve = 0, compute.sens = 0)
{
	#
	# lp: solve a general linear program
	#
	# Arguments:
	#     direction: Character: direction of optimization: "min" (default) or "max."
	#  objective.in: Numeric vector (or one-column data frame) of coefficients
#                of objective function
	#     const.mat: Matrix of numeric constraint coefficients, one row  per
#                constraint, one column per variable (unless
#                transpose.constraints =  FALSE; see below).
	#     const.dir: Vector of character strings giving the direction of the
#                constraints: each value should be one of "<," "<=," "=," "==,"
#                ">," or ">=."
	#     const.rhs: Vector of numeric values for the right-hand sides of  the
#                constraints.
	# transpose.constraints: By default each constraint occupies a row  of
#                const.mat, and that matrix needs to be transposed before
#                being passed  to the optimizing code.  For very large
#                constraint matrices it may be wiser  to construct the
#                constraints in a matrix column-by-column. In that case set
#                transpose.constraints to FALSE.
	#       int.vec: Numeric vector giving the indices of variables that are
#                required to be integer. The length of this vector will
#                therefore be the  number of integer variables.
	#	 presolve: Numeric: Should presolve be done (in lp_solve)? Default: 0 (no).
	#                A non-zero value means "yes." Currently mostly ignored.
	#  compute.sens: Numeric: compute sensitivities? Default 0 (no). Any non-zero
	#                value means "yes."
	#
	# Set up the direction.
	#
	if(direction == "min")
		direction <- 0
	else if (direction == "max")
                direction <- 1
             else stop ("Direction must be 'max' or 'min'")
	#
	# Convert one-column data frame objective to vector. Add leading 0 to obejctive.
	#
	if(is.data.frame(objective.in)) {
		if(ncol(objective.in) > 1)
			stop("Objective vector has more than one column")
		objective.in <- unlist(objective.in)
		names(objective.in) <- NULL
	}
	#
	# Set up solution, status, x.count (= number of variables)
	#
	objective <- c(0, objective.in)
	solution <- numeric(length(objective.in))
	status <- objval <- 0
	x.count <- length(objective.in)
	#
	# Convert "constraints" to a matrix if necessary; set NAs to 0.
	#
	if(is.data.frame(const.mat)) {
		cm <- as.numeric(unlist(const.mat))
		names(cm) <- NULL
		const.mat <- matrix(cm, nrow = nrow(const.mat))
	}
	const.mat[is.na(const.mat)] <- 0
	#
	# Transpose if necessary.
	#
	if(transpose.constraints)
		const.mat <- t(const.mat)
	#
	# Set up constraint signs...
	#
	const.dir.num <- rep(-1, length(const.dir))
	const.dir.num[const.dir == "<" | const.dir == "<="] <- 1
	const.dir.num[const.dir == "=" | const.dir == "=="] <- 3
	const.dir.num[const.dir == ">" | const.dir == ">="] <- 2
	if(any(const.dir.num == -1))
		stop("Unknown constraint direction found\n")
	#
	# ...constraint count, and right-hand sides.
	#
	const.count <- ncol(const.mat)
	if(is.data.frame(const.rhs))
		const.rhs <- as.matrix(const.rhs)
	const.rhs <- c(const.rhs)
	names(const.rhs) <- NULL
	#
	# Set up big matrix of constraint info; add a 0 on the front.
	#
	big.const.mat <- rbind(const.mat, const.dir.num, const.rhs)
	constraints <- c(0, c(big.const.mat))
	#
	# Set up int.vec.
	#
	if(missing(int.vec)) {
		int.count <- 0
		int.vec <- 0
	}
	else {
		int.count <- length(int.vec)
	}
	#
	# Check for the lpslink function, dyn.open if needed. (It should have been loaded
	# by the library() function, though.)
	#
	if(!is.loaded(symbol.C("lpslink"))) {
		base <- "d:/sam/students/lpsolve/lp_solve_4.0/lpsolve.dll"
		if(any(names(version) == "language")) {
			options(show.error.messages = FALSE)
			load.ret <- try(dyn.load(base))
			options(show.error.messages = TRUE)
			if(inherits(load.ret, "try-error"))
				stop("Sorry, error loading the lpsolve.dll")
		}
		else load.ret <- try(dyn.open(base))
		if(inherits(load.ret, "Error"))
			stop("Sorry, error loading the lpsolve.dll")
		if(!is.loaded(symbol.C("lpslink")))
			stop("Sorry, lpsolve.dll not loaded")
	}
	#
	# Set up sensitivity stuff.
	#
	sens.coef.from <- sens.coef.to <- 0
	duals <- duals.from <- duals.to <- 0
	if(compute.sens != 0) {
		sens.coef.from <- sens.coef.to <- numeric(x.count)
		duals <- duals.from <- duals.to <- numeric(x.count + const.count)
	}
	#
	lp.out <- .C("lpslink",
		direction = as.integer(direction),
		x.count = as.integer(x.count),
		objective = as.double(objective),
		const.count = as.integer(const.count),
		constraints = as.double(constraints),
		int.count = as.integer(int.count),
		int.vec = as.integer(int.vec),
		objval = as.double(objval),
		solution = as.double(solution),
		presolve = as.integer(presolve),
		compute.sens = as.integer(compute.sens),
		sens.coef.from = as.double(sens.coef.from),
		sens.coef.to = as.double(sens.coef.to),
		duals = as.double(duals),
		duals.from = as.double(duals.from),
		duals.to = as.double(duals.to),
		status = as.integer(status), PACKAGE="lpSolve")
        lp.out$objective <- objective.in
        lp.out$constraints <- big.const.mat
	if(any(names(version) == "language"))
		class(lp.out) <- "lp"
	else oldClass(lp.out) <- "lp"
	return(lp.out)
}
lp.assign <- function (cost.mat, direction="min", presolve = 0, compute.sens = 0)
{
#
# lp.assign: use lpsolve.dll to solve an assignment problem. This
# is a linear program with an ixj matrix of decision variables,
# and i+j constraints: that the rows and columns all add up to one.
#
# Arguments:
#  cost.mat: matrix or data.frame of costs
#  direction: "min" (default) or "max"
#  presolve: numeric. Presolve? Default 0. Currently ignored.
#  compute.sens: numeric. Compute sensitivities? Default 0 (no).
#                Any non-zero number means "yes" and, in that
#                case, presolving is attempted.
#
# Return value: list from lpsolve, including objective and
# assignments.
#
# Check for the lpslink function, dyn.open if needed. (It should
# have been loaded by the library() function, though.)
#
    if (!is.loaded(symbol.C("lp_transbig"))) {
        stop("Sorry, error loading the lpsolve.dll")
    }
#
# Check that the cost matrix is in fact a matrix; convert
# from data.frame if needed.
#
    if (!is.matrix(cost.mat))
        stop("Matrix of costs required.")
    if (is.data.frame(cost.mat))
        cost.mat <- as.matrix(cost.mat)
#
# Set up the stuff.
#
    nr <- nrow(cost.mat)
    nc <- ncol(cost.mat)
    rnum.signs <- rep (3, nr)
    row.rhs <- rep (1, nr)
    cnum.signs <- rep (3, nc)
    col.rhs <- rep (1, nc)
    if (direction == "min")
        direction <- as.integer(0)
    else
	if (direction == "max")
            direction <- as.integer (1)
        else
            stop ("Direction must be 'min' or 'max'")
    varcount <- as.integer(nr * nc)
    objective <- as.double(c(0, c(t(cost.mat))))
#
# Set up the row and column constraints. Each is of the
# "=1" type, represented by 3 (for "equals") 1.
#
    constcount <- as.integer(nr + nc)
    intcount <- as.integer(varcount) # number of integers
    intvec <- as.integer(1:varcount) # indicators of integers
#
# Prepare objective value, solution, and status
#
    objval <- as.double(0)
    solution <- as.double(numeric(nc * nr))
    status <- as.integer(0)
#
# Set up sensitivity stuff
#
    sens.coef.from <- sens.coef.to <- 0
    duals <- duals.from <- duals.to <- 0
    if (compute.sens) {
        sens.coef.from <- sens.coef.to <- numeric(x.count)
        duals <- duals.from <- duals.to <- numeric(x.count +
            const.count)
    }
    ## costs <- as.double (c(0, c(cost.mat)))
    lps.out <- .C("lp_transbig",
        direction = direction,
        rcount = as.integer (nr),
        ccount = as.integer (nc),
        costs = objective,
        rsigns = as.integer (rnum.signs),
        rrhs = as.double (row.rhs),
	csigns = as.integer (cnum.signs),
        crhs = as.double (col.rhs),
	objval = objval,
        solution = solution,
        presolve = as.integer(presolve),
        compute.sens = as.integer(compute.sens),
        sens.coef.from = as.double(sens.coef.from),
        sens.coef.to = as.double(sens.coef.to),
        duals = as.double(duals),
        duals.from = as.double(duals.from),
        duals.to = as.double(duals.to),
        status = status, PACKAGE="lpSolve")
#
# Reset solution back into matrix form.
#
    lps.out$solution = matrix(lps.out$solution, nr, nc, byrow = FALSE)
    if (length(duals) > 0) {
        lps.out$sens.coef.from <- matrix(lps.out$sens.coef.from,
            nr, nc, byrow = TRUE)
        lps.out$sens.coef.to <- matrix(lps.out$sens.coef.to,
            nr, nc, byrow = TRUE)
        lps.out$duals <- matrix(lps.out$duals, nr, nc, byrow = TRUE)
        lps.out$duals.from <- matrix(lps.out$duals.from, nr,
            nc, byrow = TRUE)
        lps.out$duals.to <- matrix(lps.out$duals.to, nr, nc,
            byrow = TRUE)
    }
#
# Reset the costs, to which we had to add a 0
#
    lps.out$costs <- cost.mat
    if(any(names(version) == "language"))
        class(lps.out) <- "lp"
    else oldClass(lps.out) <- "lp"
    lps.out
}
lp.transport <- function (cost.mat, direction = "min", row.signs, row.rhs, col.signs,
    col.rhs, presolve = 0, compute.sens = 0)
{
#
# lp.transport: use lpsolve.dll to solve a transportation problem.
# This is a linear program with an ixj matrix of decision variables,
# and constraints on the row and column sums (and no others)
#
# Arguments: cost.mat: matrix or data.frame of costs
#                 dir: direction ("min" or "max")
#           row.signs: signs for row constraints
#             row.rhs: values for row constraints
#           col.signs: signs for column constraints
#             col.rhs: values for column constraints
#            presolve: Numeric: should we presolve? Default 0 (no); non-0
#                      values means "yes." Currently mostly ignored.
#        compute.sens: Numeric: compute sensitivities? Default 0 (no);
#                      non-zero value means "yes."
#
# Return value: list from lpsolve, including objective and optimal values.
#
# Check for the lpslink function. (It should have been loaded
# by the library() function, though.)
#
    if (!is.loaded(symbol.C("lp_transbig"))) {
            stop("Sorry, error loading the lpsolve.dll")
    }
#
# Check that the cost matrix is in fact a matrix; convert
# from data.frame if needed.
#
    if (!is.matrix(cost.mat))
        stop("Matrix of costs required.")
    if (is.data.frame(cost.mat))
        cost.mat <- as.matrix(cost.mat)
#
# Set up the stuff.
#
    nr <- nrow(cost.mat)
    nc <- ncol(cost.mat)
	#
	# Ensure that row stuff is of the correct size.
	#
    if (is.matrix(row.signs))
        row.signs <- as.vector(row.signs)
    if (length(row.signs) != nr)
        stop(paste("Error: We have", length(row.signs), "signs, but",
            nr, "rows"))
    if (is.matrix(row.rhs))
        row.rhs <- as.vector(row.rhs)
    if (length(row.rhs) != nr)
        stop(paste("Error: We have", length(row.rhs), "rhs's, but",
            nr, "rows"))
	#
	# Ensure that col stuff is of the correct size.
	#
    if (is.matrix(col.signs))
        col.signs <- as.vector(col.signs)
    if (length(col.signs) != nc)
        stop(paste("Error: We have", length(col.signs), "signs, but",
            nc, "columns"))
    if (is.matrix(col.rhs))
        col.rhs <- as.vector(col.rhs)
    if (length(col.rhs) != nc)
        stop(paste("Error: We have", length(col.rhs), "rhs's, but",
            nc, "rows"))
    if (direction == "min")
        direction <- as.integer(0)
    else
        if (direction == "max")
            direction <- as.integer(1)
        else
            stop ("Direction should be 'min' or 'max'")
    varcount <- as.integer(nr * nc)              # no of vars
    objective <- as.double(c(0, c(t(cost.mat))))
    constcount <- as.integer(nr + nc)       # no of constraints
    rnum.signs <- rep(-1, nr)               # sign holder
#
# Set the signs: <, >, = turn into 1,2,3 respectively. We also
# allow those followed by another "=". Anything else is an error.
#
    rnum.signs[row.signs == "<" | row.signs == "<="] <- 1
    rnum.signs[row.signs == "=" | row.signs == "=="] <- 3
    rnum.signs[row.signs == ">" | row.signs == ">="] <- 2
    if (any(rnum.signs == -1))
        stop(paste("Unknown row sign in position ", which(rnum.signs ==
            -1)[1]))
#
# Column signs.
#
    cnum.signs <- rep(-1, nc)
    cnum.signs[col.signs == "<" | col.signs == "<="] <- 1
    cnum.signs[col.signs == "=" | col.signs == "=="] <- 3
    cnum.signs[col.signs == ">" | col.signs == ">="] <- 2
    if (any(cnum.signs == -1))
        stop(paste("Unknown column sign in position ", which(cnum.signs ==
            -1)[1]))
#
# Set up integer indicator: all variables are integers here.
#
    intcount <- as.integer(varcount)
    intvec <- as.integer(1:varcount)
#
# A few more things, plus dual action.
#
    objval <- as.double(0)
    solution <- as.double(numeric(nc * nr))
    status <- as.integer(0)
    sens.coef.from <- sens.coef.to <- 0
    duals <- duals.from <- duals.to <- 0
    if (compute.sens) {
        sens.coef.from <- sens.coef.to <- numeric(x.count)
        duals <- duals.from <- duals.to <- numeric(x.count +
            const.count)
    }
#
# Stick a zero on the front of costs, and off we go.
#
    costs <- as.double (c(0, c(cost.mat)))
    lps.out <- .C("lp_transbig",
	direction = direction,
	rcount = as.integer (nr),
        ccount = as.integer (nc),
	costs = costs,
	rsigns = as.integer (rnum.signs),
	rrhs = as.double (row.rhs),
	csigns = as.integer (cnum.signs),
	crhs = as.double (col.rhs),
	objval = objval,
        solution = solution,
	presolve = as.integer(presolve),
        compute.sens = as.integer(compute.sens),
	sens.coef.from = as.double(sens.coef.from),
        sens.coef.to = as.double(sens.coef.to),
	duals = as.double(duals),
        duals.from = as.double(duals.from),
	duals.to = as.double(duals.to),
        status = status, PACKAGE="lpSolve")
#
# Set solution back into a matrix.
#
    lps.out$solution = matrix(lps.out$solution, nr, nc, byrow = FALSE)
    if (length(duals) > 0) {
        lps.out$sens.coef.from <- matrix(lps.out$sens.coef.from,
            nr, nc, byrow = TRUE)
        lps.out$sens.coef.to <- matrix(lps.out$sens.coef.to,
            nr, nc, byrow = TRUE)
        lps.out$duals <- matrix(lps.out$duals, nr, nc, byrow = TRUE)
        lps.out$duals.from <- matrix(lps.out$duals.from, nr,
            nc, byrow = TRUE)
        lps.out$duals.to <- matrix(lps.out$duals.to, nr, nc,
            byrow = TRUE)
    }
    if(any(names(version) == "language"))
        class(lps.out) <- "lp"
    else oldClass(lps.out) <- "lp"
    lps.out
}
print.lp <- function(x, ...)
{
	if(x$status == 0)
		cat("Success: the objective function is", x$objval, "\n")
	else if(x$status == 2)
		cat("Error: no feasible solution found")
	else cat("Error: status", x$status, "\n")
}
# .First.lib <- function(libname, pkgname) {
# library.dynam ("lpSolve", pkgname, libname)
# }
