.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 direction <- 1
	#
	# 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 == "<="] <- 0
	const.dir.num[const.dir == "=" | const.dir == "=="] <- 1
	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")
	if(any(names(version) == "language"))
		class(lp.out) <- "lp"
	else oldClass(lp.out) <- "lp"
	return(lp.out)
}
lp.assign <- function(cost.mat)
{
	#
	# 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: matrix or data.frame of costs
	#
	# 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("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")
	}
	#
	# 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. The direction is 0, for minimization.
	#
	nr <- nrow(cost.mat)
	nc <- ncol(cost.mat)
	if(nr != nc)
		stop("Cost matrix must be square.")
	direction <- as.integer(0)
	varcount <- as.integer(nr * nc)
	objective <- as.double(c(0, c(t(cost.mat))))
	#
	# Set up the row and column constraints. Each
	#
	constcount <- as.integer(nr + nc)
	row.constraints <- array(0, c(nr, nc, nr))
	for(i in 1:nr)
		row.constraints[i,  , i] <- rep(1, nc)
	row.constraints <- matrix(c(row.constraints), nrow = nr)
	row.constraints <- cbind(row.constraints, rep(1, nr), rep(1, nr))
	#
	col.constraints <- array(0, c(nr, nc, nc))
	for(i in 1:nc)
		col.constraints[, i, i] <- rep(1, nr)
	col.constraints <- matrix(c(apply(col.constraints, c(1, 2), t)), nrow = nc, byrow
		 = TRUE)
	col.constraints <- cbind(col.constraints, rep(1, nc), rep(1, nc))
	all.constraints <- rbind(row.constraints, col.constraints)
	all.constraints <- t(all.constraints)
	constvec <- as.double(c(0, c(all.constraints)))
	intcount <- as.integer(varcount)
	intvec <- as.integer(1:varcount)
	#
	# Prepare objective value, solution, and status
	#
	objval <- as.double(0.)
	solution <- as.double(numeric(nc * nr))
	status <- as.double(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)
	}
	lps.out <- .C("lpslink",
		direction = direction,
		varcount = varcount,
		objective = objective,
		constcount = constcount,
		constvec = constvec,
		intcount = intcount,
		intvec = intvec,
		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")
	#
	# Make stuff that should be matices into matrices
	#
	lps.out$solution = matrix(lps.out$solution, nr, nc, byrow=TRUE)
	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
}
lp.transport <- function(cost.mat, 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.
	#
	# Arguments: cost.mat: matrix or data.frame of costs
	#           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, 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")
	}
	#
	# 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 and column 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"))
	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"))
	#
	# The direction is 0, for minimization.
	#
	direction <- as.integer(0)
	varcount <- as.integer(nr * nc)
	objective <- as.double(c(0, c(t(cost.mat))))
	#
	# Set up the row and column constraints. Each
	#
	constcount <- as.integer(nr + nc)
	row.constraints <- array(0, c(nr, nc, nr))
	for(i in 1:nr)
		row.constraints[i,  , i] <- rep(1, nc)
	row.constraints <- matrix(c(row.constraints), nrow = nr)
	num.signs <- rep(-1, nr)
	num.signs[row.signs == "<" | row.signs == "<="] <- 0
	num.signs[row.signs == "=" | row.signs == "=="] <- 1
	num.signs[row.signs == ">" | row.signs == ">="] <- 2
	if(any(num.signs == -1))
		stop(paste("Unknown row sign in position ", which(num.signs == -1)[1]))
	row.constraints <- cbind(row.constraints, num.signs, row.rhs)
	#
	col.constraints <- array(0, c(nr, nc, nc))
	for(i in 1:nc)
		col.constraints[, i, i] <- rep(1, nr)
	col.constraints <- matrix(c(apply(col.constraints, c(1, 2), t)), nrow = nc, byrow
		 = TRUE)
	num.signs <- rep(-1, nc)
	num.signs[col.signs == "<" | col.signs == "<="] <- 0
	num.signs[col.signs == "=" | col.signs == "=="] <- 1
	num.signs[col.signs == ">" | col.signs == ">="] <- 2
	if(any(num.signs == -1))
		stop(paste("Unknown column sign in position ", which(num.signs == -1)[
			1]))
	col.constraints <- cbind(col.constraints, num.signs, col.rhs)
	all.constraints <- rbind(row.constraints, col.constraints)
	all.constraints <- t(all.constraints)
	constvec <- as.double(c(0, c(all.constraints)))
	intcount <- as.integer(varcount)
	intvec <- as.integer(1:varcount)
	#
	# Prepare objective value, solution, and status
	#
	objval <- as.double(0.)
	solution <- as.double(numeric(nc * nr))
	status <- as.double(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)
	}
	lps.out <- .C("lpslink",
		direction = direction,
		varcount = varcount,
		objective = objective,
		constcount = constcount,
		constvec = constvec,
		intcount = intcount,
		intvec = intvec,
		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")
	#
	# Make stuff that should be matices into matrices
	#
	lps.out$solution = matrix(lps.out$solution, nr, nc, byrow = TRUE)
	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)
}
