.packageName <- "lpSolve"
lp <- function(direction = "min", objective.in, const.mat, const.dir, const.rhs,
	transpose.constraints = TRUE, int.vec)
{
	if(direction == "min")
		direction <- 0
	else direction <- 1
	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
	}
	objective <- c(0, objective.in)
	solution <- numeric(length(objective.in))
	status <- objval <- 0
	x.count <- length(objective.in)
	#
	# "objective" and "constraints" get extra 0's on the front.
	#
	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
	if(transpose.constraints)
		const.mat <- t(const.mat)
	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")
	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
	big.const.mat <- rbind(const.mat, const.dir.num, const.rhs)
	constraints <- c(0, c(big.const.mat))
	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")
	}
	#
	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),
		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.)
	lps.out <- .C("lpslink",
		direction = direction,
		varcount = varcount,
		objective = objective,
		constcount = constcount,
		constvec = constvec,
		intcount = intcount,
		intvec = intvec,
		objval = objval,
		solution = solution,
		status = status, PACKAGE="lpSolve")
	lps.out$solution = matrix(lps.out$solution, nr, nc)
	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)
{
	#
	# 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
	#
	# 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.)
	lps.out <- .C("lpslink",
		direction = direction,
		varcount = varcount,
		objective = objective,
		constcount = constcount,
		constvec = constvec,
		intcount = intcount,
		intvec = intvec,
		objval = objval,
		solution = solution,
		status = status, PACKAGE="lpSolve")
	lps.out$solution = matrix(lps.out$solution, 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)
}
