"Cfrag.list" <-
function (x, file=NULL, item.num=c(3,10,5), indent=c("\t", "\t\t"),
	declaration.only=FALSE, long=FALSE, append=FALSE) 
{
        fun.copyright <- "Placed in the public domain 2009 by Burns Statistics Ltd."
	fun.version <- "Cfrag.list 003"

	subfun.bp <- function(z, inum, indent2) {
		zlen <- length(z)
		start <- seq(1, zlen, by=inum)
		end <- c(start[-1] - 1, zlen)
		cm1 <- paste("paste(z[", start, ":", end, "], collapse=', ')", 
			sep="")
		cm2 <- paste("paste(c(", paste(cm1, collapse=", "), "))")
		subans <- eval(parse(text=cm2))
		paste(indent2, subans, rep(c(",", ""), c(length(start)-1, 1)), 
			sep="")
	}

	# start of main function

	decl <- unlist(lapply(x, storage.mode))
	prefix <- rep("", length(decl))
	pdm <- match(decl, c("double", "integer", "character"), nomatch=NA)
	if(any(is.na(pdm))) 
		stop("at least one storage mode that can not be handled")
	decl[pdm == 2] <- if(long) "long" else "int"
	decl[pdm == 3] <- "char"
	prefix[pdm == 3] <- "*"

	dec.out <- paste(decl, " ", prefix, names(x), "[]", sep="")
	if(declaration.only) {
		dec.out <- paste(indent[1], dec.out, ";", sep="")
		if(length(file) && nchar(file)) {
			cat(dec.out, sep="\n", file=file, append=append)
			return(file[1])
		} else {
			return(dec.out)
		}
	}

	item.num <- rep(item.num, length=3)
	indent <- rep(indent, length=2)

	ans <- NULL
	for(i in 1:length(x)) {
		switch(decl[i], 
			double= {
				t.inum <- item.num[1]
			}, 
			long=,
			int={
				t.inum <- item.num[2]
			},
			char={
				t.inum <- item.num[3]
				x[[i]] <- paste('"', x[[i]], '"', sep="")
			})
		t.sa <- subfun.bp(x[[i]], t.inum, indent[2])
		ans <- c(ans, paste(indent[1], dec.out[i], " = {", sep=""), 
			t.sa, paste(indent[1], "};", sep=""))
	}

	if(length(file) && nchar(file)) {
		cat(ans, sep="\n", file=file, append=append)
		return(file[1])
	} else {
		return(ans)
	}
}

"build.constraints" <-
function (x, bounds=NULL) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "build.constraints 003"

	if(!is.data.frame(x)) x <- as.matrix(x)

	dnx <- dimnames(x)
	ccnam <- dnx[[2]]
	defnam <- paste("Constr", 1:ncol(x))
	if(!length(ccnam)) {
		ccnam <- defnam
	} else {
		znam <- nchar(ccnam) == 0 | ccnam == " " | duplicated(ccnam)
		if(any(znam)) ccnam[znam] <- defnam[znam]
	}
	if(length(dnx)) {
		dimnames(x)[[2]] <- ccnam
	} else {
		dimnames(x) <- list(NULL, ccnam)
	}

	bnam <- constraint.bnames(x, values=FALSE)
	bounds.out <- array(NA, c(length(bnam), 2), list(bnam, 
		c("lower", "upper")))
	bounds.out[, 1] <- -Inf
	bounds.out[, 2] <- Inf
	if(length(bounds)) {
		bi <- intersect(dimnames(bounds)[[1]], bnam)
		if(length(bi)) {
			bounds.out[bi, ] <- bounds[bi, ]
		}
	}
	list(lin.constraints = x, bounds = bounds.out)
}

"constraint.bnames" <-
function (x, values.out=FALSE) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "constraint.bnames 003"

	if(!is.data.frame(x) && !is.matrix(x))
		stop("'x' must be a data frame or a matrix")
	ccnam <- dimnames(x)[[2]]
	if(!length(ccnam) || any(nchar(ccnam) == 0))
		stop("'x' needs proper column names")

	bnam <- values <- columns <- NULL
	nc <- ncol(x)
	nlevs <- rep(0, nc)
	if(is.numeric(x)) {
		bnam <- ccnam
		columns <- 1:nc
		if(values.out) values <- x
	} else {
		if(values.out) values <- array(NA, c(nrow(x), nc))
		for(i in 1:nc) {
			t.x <- x[, i]
			if(is.character(t.x) || is.logical(t.x)) {
				t.x <- as.factor(t.x)
			}
			if(is.factor(t.x)) {
				levs <- levels(t.x)
				bnam <- c(bnam, paste(ccnam[i], ":", levs))
				columns <- c(columns, rep(i, length(levs)))
				nlevs[i] <- length(levs)
				if(values.out) {
					values[,i] <- as.numeric(t.x) - 0.5
				}
			} else if(!is.numeric(t.x)) {
				stop(paste(ccnam[i], "has bad mode of",
					mode(t.x)))
			} else {
				# numeric
				bnam <- c(bnam, ccnam[i])
				columns <- c(columns, i)
				if(values.out) values[,i] <- t.x
			}
		}
	}
	if(any(nlevs > .9 * nrow(x) && nrow(x) > 9)) {
		suspect <- nlevs > .9 * nrow(x)
		warning(paste("categorical constraints with suspiciously",
			"large number of levels, did you pass in a matrix",
			"when a data frame was meant? Suspicious constraints:",
			paste(ccnam[suspect], collapse=", ")))
	}
	if(values.out) {
		if(any(is.na(values))) stop("missing values in constraints")
		list(values=as.vector(values), levels=nlevs, bnam=bnam, 
			columns=columns)
	} else bnam
}

"deport.portfolBurSt" <-
function (x, filename=deparse(substitute(x)), what="all", multiplier=1, 
	to="csv", blank="", ...) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "deport.portfolBurSt 005"

	subfun.mult <- function(z, one.mult, multiplier) {
		if(one.mult) {
			ans <- z * multiplier
		} else {
			znam <- names(z)
			inam <- intersect(znam, names(multiplier))
			if(length(inam) < length(unique(znam)))
				stop("'multiplier' does not contain all required assets")
			ans <- z * multiplier[znam]
		}
		ans
	}

	#
	# start of main function
	#

	if(length(filename) != 1) stop("'filename' should be a single string")

	if(length(to) != 1) stop("the 'to' argument should have length 1")
	to.menu <- c("csv", "txt")
	to.num <- pmatch(to, to.menu, nomatch=0)
	if(to.num == 0) stop("unknown or ambiguous value for 'to' argument")
	to <- to.menu[to.num]

	if(length(what) != 1) stop("the 'what' argument should have length 1")
	what.menu <- c("trade", "optimal", "new.portfolio", "existing", "all")
	what.num <- pmatch(what, what.menu, nomatch=0)
	if(what.num == 0) stop("unknown or ambiguous value for 'what' argument")
	what <- what.menu[what.num]

	if(!is.numeric(multiplier)) stop("'multiplier' must be numeric")
	len.mult <- length(multiplier)
	if(len.mult > 1) {
		multiplier <- drop(multiplier)
		if(!length(names(multiplier)))
			stop("'multiplier' must have names when longer than one")
	} else if(len.mult < 1) 
		stop("'multplier' must have length at least one")
	one.mult <- len.mult == 1

	switch(what,
		trade={
			the.trade <- subfun.mult(x$trade, one.mult, multiplier)
			out <- cbind(names(the.trade), as.character(the.trade))
			},
		optimal=,
		new.portfolio={
			the.port <- subfun.mult(x$new.portfolio, one.mult,
				multiplier)
			out <- cbind(names(the.port), as.character(the.port))
			},
		existing={
			the.port <- subfun.mult(x$existing, one.mult,
				multiplier)
			out <- cbind(names(the.port), as.character(the.port))
			},
		all={
			univnam <- unique(c(names(x$existing), names(x$trade),
				names(x$new.portfolio)))
			out <- array(blank, c(length(univnam), 4))
			outlab <- c("assets", "existing", "trade", "optimal")
			out[,1] <- univnam
			the.port <- subfun.mult(x$existing, one.mult,
				multiplier)
			out[match(names(the.port), univnam), 2] <- the.port
			the.trade <- subfun.mult(x$trade, one.mult, multiplier)
			out[match(names(the.trade), univnam), 3] <- the.trade
			the.port <- subfun.mult(x$new.portfolio, one.mult,
				multiplier)
			out[match(names(the.port), univnam), 4] <- the.port
			out <- rbind(outlab, out)
			}
	)

	fnchar <- nchar(filename)
	fex <- substring(filename, fnchar-2, fnchar)
	switch(to,
		csv={
			if(fex != "csv") {
				filename <- paste(filename, "csv", sep=".")
				if(fex == "txt") {
				   warning(paste("file extension is", fex,
					"but 'to' is 'csv', you may not",
					"get what you expect"))
				}
			}
			outp <- apply(out, 1, paste, collapse=",")
			cat(outp, file=filename, sep="\n")
		},
		txt={
			if(fex != "txt") {
				filename <- paste(filename, "txt", sep=".")
				if(fex == "csv") {
				   warning(paste("file extension is", fex,
					"but 'to' is 'txt', you may not",
					"get what you expect"))
				}
			}
			outp <- apply(out, 1, paste, collapse="\t")
			cat(outp, file=filename, sep="\n")
		}
	)
	filename
}

"deport" <-
function(x, ...) UseMethod("deport")
"deport.randportBurSt" <-
function (x, filename=deparse(substitute(x)), what="horizontal.portfolio", 
	multiplier=1, names.assets=NULL, to="csv", blank="", append=FALSE, 
	subset=NULL, ...) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "deport.randportBurSt 005"

	if(length(filename) != 1) stop("'filename' should be a single string")

	if(length(to) != 1) stop("the 'to' argument should have length 1")
	to.menu <- c("csv", "txt")
	to.num <- pmatch(to, to.menu, nomatch=0)
	if(to.num == 0) stop("unknown or ambiguous value for 'to' argument")
	to <- to.menu[to.num]

	if(length(what) != 1) stop("the 'what' argument should have length 1")
	what.menu <- c("horizontal.portfolio", "vertical.portfolio")
	what.num <- pmatch(what, what.menu, nomatch=0)
	if(what.num == 0) stop("unknown or ambiguous value for 'what' argument")
	what <- what.menu[what.num]

	if(length(subset)) {
		x <- x[subset]
	}
	fullnams <- unlist(lapply(x, names))
	anams <- unique(fullnams)

	if(!length(names.assets)) {
		names.assets <- sort(anams)
	} else {
		if(!is.character(names.assets)) 
			stop("names.assets not a vector of character strings")
		if(nam.gone <- length(setdiff(anams, names.assets))) {
			stop(paste("names.assets is missing", nam.gone,
				"asset(s) in the random portfolios"))
		}
	}

	if(!is.numeric(multiplier)) stop("'multiplier' must be numeric")
	len.mult <- length(multiplier)
	if(len.mult < 1) 
		stop("'multplier' must have length at least one")
	one.mult <- len.mult == 1
	if(!one.mult) {
		multiplier <- drop(multiplier)
		if(!length(names(multiplier)))
			stop("'multiplier' must have names when longer than one")
		if(mult.gone <- length(setdiff(names.assets,
				names(multiplier)))) {
			stop(paste("'multiplier' is missing", mult.gone,
				"asset(s)"))
		}
	}

	if(append && what != "horizontal.portfolio") {
		stop("can only append with horizontal portfolios")
	}

	xlen <- length(x)
	nassets <- length(names.assets)
	out <- array(0, c(xlen, length(names.assets)), list(NULL,
		names.assets))
	rowvec <- rep(1:xlen, unlist(lapply(x, length)))
	colvec <- match(fullnams, names.assets)
	out[cbind(rowvec, colvec)] <- unlist(x)

	if(one.mult) {
		out <- multiplier * out
	} else {
		out <- out * rep(multiplier[names.assets], rep(xlen, nassets))
	}

	out[out == 0] <- blank
	out <- rbind(names.assets, out)
	dimnames(out) <- NULL

	switch(what,
		horizontal.portfolio={
			# nothing to do
			},
		vertical.portfolio={
			out <- t(out)
			}
	)

	fnchar <- nchar(filename)
	fex <- substring(filename, fnchar-2, fnchar)
	switch(to,
		csv={
			if(fex != "csv") {
				filename <- paste(filename, "csv", sep=".")
				if(fex == "txt") {
				   warning(paste("file extension is", fex,
					"but 'to' is 'csv', you may",
					"not get what you expect"))
				}
			}
			outp <- apply(out, 1, paste, collapse=",")
			cat(outp, file=filename, sep="\n", append=append)
		},
		txt={
			if(fex != "txt") {
				filename <- paste(filename, "txt", sep=".")
				if(fex == "csv") {
				   warning(paste("file extension is", fex,
					"but 'to' is 'txt', you may",
					"not get what you expect"))
				}
			}
			outp <- apply(out, 1, paste, collapse="\t")
			cat(outp, file=filename, sep="\n", append=append)
		}
	)
	filename
}

"trade.optimizer.control" <-
function (iterations.max = 20, fail.iter = 0, funeval.max = .Machine$integer.max, 
    trace = 0, exit.obj = -1e6, doubleconst = NA, runs.init = 3, 
    runs.final = 2, runs.min = 1, stringency = 0, nonconverge.mult = 2, 
    feasible = 0, miniter = 0, force.risk.aver = FALSE, enforce.max.weight = TRUE, 
    lockcon = FALSE, save.iterhistory = FALSE, throw.error = FALSE, 
    gen.fail = NA, init.fail = 0, safe.mode=TRUE, ...) 
{
    fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
    fun.version <- "trade.optimizer.control 013"
    big <- 1e+100
    if (funeval.max == Inf) funeval.max <- .Machine$integer.max
	if(!is.na(doubleconst)) {
		warning("'doubleconst' no longer used -- now always FALSE")
		doubleconst <- FALSE
	} else {
		doubleconst <- FALSE
	}

    icon <- c(npar = NA, icon01 = 20, icon02 = 2000, icon03 = 1000, 
        icon04 = 3, icon05 = 20, icon06 = 20, icon07 = 2, funeval.max = funeval.max, 
        popgiven = NA, icon10 = 100, trace = trace, icon12 = 0, 
        icon13 = 2, icon14 = 2, icon15 = 200, icon16 = 20, icon17 = 3000, 
        icon18 = 1, icon19 = 5000, icon20 = 2, icon21 = 12, icon22 = 0, 
        icon23 = 3, iterations.max = iterations.max, icon25 = 2, 
        icon26 = 700, icon27 = 0, icon28 = 2, icon29 = 3000, 
        icon30 = 30, icon31 = 1001, icon32 = 2, fail.iter = fail.iter, 
        icon34 = 0, icon35 = 7, icon36 = 25, icon37 = 500, icon38 = 1, 
        icon39 = 65, icon40 = -1, icon41 = 0, runs.init = runs.init, 
        runs.final = runs.final, stringency = stringency, icon45 = 1, 
        runs.min = runs.min, nonconverge.mult = nonconverge.mult, 
        feasible = feasible, icon49 = 0, icon50 = 1, init.fail = 0, 
        lockcon = lockcon, icon53 = 10, miniter = miniter, icon55 = 70, 
        icon56 = 25, icon57 = 77, icon58 = 30, icon59 = 2, icon60 = 5, 
        icon61 = 0, icon62 = 9, icon63 = 1, icon64 = 6, icon65 = 8000, 
        icon66 = 3, icon67 = 1, icon68 = 3, icon69 = 100, icon70 = 20, 
        icon71 = 20, icon72 = 7, icon73 = 400, icon74 = 3, icon75 = 12, 
        icon76 = 10, icon77 = 9000, icon78 = 400, icon79 = 1500, 
        icon80 = 300, icon81 = 8, icon82 = 4, icon83 = 30, icon84 = 2, 
        icon85 = 20, icon86 = 6, icon87 = 20, icon88 = 5000, 
        icon89 = 1600, icon90 = 1000, icon91 = 600, icon92 = 6000, 
        icon93 = 2200, icon94 = 1500, icon95 = 400, icon96 = 5000, 
        icon97 = 800, icon98 = 2000, icon99 = 700, icon100 = 6000, 
        icon101 = 1000, icon102 = 1600, icon103 = 1050, icon104 = 25, 
        icon105 = 10700, icon106 = 6000, icon107 = 1000, icon108 = 1800, 
        icon109 = 420, icon110 = 6, icon111 = 10, icon112 = 50, 
        icon113 = 100, icon114 = 3, icon115 = 3, icon116 = 1, 
        icon117 = 3, icon118 = 0, icon119 = 25, icon120 = 12, 
        icon121 = 2, icon122 = 7, icon123 = 40, icon124 = 5, 
        icon125 = 1, icon126 = 500, icon127 = 20, icon128 = 100, 
        icon129 = 7, icon130 = 9, icon131 = 25, icon132 = 26, 
        icon133 = 40, icon134 = 20, icon135 = 4, icon136 = 1, 
        icon137 = 130, icon138 = 2000, icon139 = 100, icon140 = 140, 
        icon141 = 220, icon142 = 2500, icon143 = 0, icon144 = 6000, 
        icon145 = 700, icon146 = 25, icon147 = 4, icon148 = 10, 
        icon149 = 3, icon150 = 3, icon151 = 1000, icon152 = 2000, 
        icon153 = 200, icon154 = 200, icon155 = 5, icon156 = 5, 
        icon157 = 1, icon158 = 0, icon159 = 500, icon160 = 50, 
        icon161 = 1000, icon162 = 1000, icon163 = 20, icon164 = 100, 
        icon165 = 1, icon166 = 3, icon167 = 3, icon168 = 1000, 
        icon169 = 2000, icon170 = 200, icon171 = 200, icon172 = 20, 
        icon173 = 20, icon174 = 20, icon175 = 2000, icon176 = 1000, 
        icon177 = 150, icon178 = 200, icon179 = 3, icon180 = 3, 
        icon181 = 40, icon182 = 33, icon183 = 20, icon184 = 0, 
        icon185 = 10, icon186 = 35, icon187 = 2, icon188 = 3, 
        icon189 = 4, icon190 = 500, icon191 = 20, icon192 = 60, 
        icon193 = 700, icon194 = 3000, icon195 = 4000, icon196 = 100, 
        icon197 = 2000, icon198 = 11000, icon199 = 4000, icon200 = 3300, 
        icon201 = 4000, icon202 = 10000, icon203 = 4000, icon204 = 4500, 
        icon205 = 4000, icon206 = 1500, icon207 = 5000, icon208 = 2000, 
        icon209 = 1000, icon210 = 600, icon211 = 1000, icon212 = 1200, 
        icon213 = 25, icon214 = 27, icon215 = 4, icon216 = 3000, 
        icon217 = 200, icon218 = 1, icon219 = 1, icon220 = 3000, 
        icon221 = 120, icon222 = 3, icon223 = 5, icon224 = 5000, 
        icon225 = 1800, icon226 = 1000, icon227 = 4600, icon228 = 3, 
        icon229 = 3, icon230 = 1, icon231 = 16, icon232 = 300, 
        icon233 = 400, icon234 = 65, icon235 = 4, icon236 = 6, 
        icon237 = 1, icon238 = 2000, icon239 = 2500, icon240 = 3500, 
        icon241 = 1600, icon242 = 3000, icon243 = 3200, icon244 = 950, 
        icon245 = 50, icon246 = 4, icon247 = 2000, icon248 = 9, 
        icon249 = 4, icon250 = 450, icon251 = 200, icon252 = 7, 
        icon253 = 6, icon254 = 0, icon255 = 0, icon256 = 0, icon257 = 0, 
        icon258 = 4, icon259 = 2, icon260 = 13, icon261 = 5, 
        icon262 = 5, icon263 = 0, icon264 = 0, icon265 = 0, icon266 = 0, 
        icon267 = 0, icon268 = 0, icon269 = 0, icon270 = 0, icon271 = 3, 
        icon272 = 2, icon273 = 0, icon274 = 0, icon275 = 230, 
        icon276 = 200, icon277 = 200, icon278 = 260, icon279 = 300, 
        icon280 = 1200, icon281 = 100, icon282 = 300, icon283 = 1, 
        icon284 = 5, icon285 = 800, icon286 = 500, icon287 = 250, 
        icon288 = 200, icon289 = 10, icon290 = 12, icon291 = 1, 
        icon292 = 5000, icon293 = 0, icon294 = 0, icon295 = 0, 
        icon296 = 8, icon297 = 0, icon298 = 6, icon299 = 2, icon300 = 50, 
        icon301 = 0, icon302 = 0, icon303 = 0, icon304 = 20, 
        icon305 = 20, icon306 = 10, icon307 = 20, icon308 = 20, 
        icon309 = 10, icon310 = 1, icon311 = 1, icon312 = 0, 
        icon313 = 20, icon314 = 10000, icon315 = 10000, icon316 = 40, 
        icon317 = 80000, icon318 = 5000, icon319 = 20, icon320 = 150000, 
        icon321 = 15000, icon322 = 30, icon323 = 70000, icon324 = 15000, 
        icon325 = 30, icon326 = 4, icon327 = 1, icon328 = 1, 
        icon329 = 2, icon330 = 30, icon331 = 4, icon332 = 2, 
        icon333 = 0, icon334 = 5, icon335 = 12, icon336 = 25, 
        icon337 = 1, icon338 = 50, icon339 = 7, icon340 = 2000, 
        icon341 = 850, icon342 = 600, icon343 = 800, icon344 = 30, 
        icon345 = 520, icon346 = 400, icon347 = 6, icon348 = 5, 
        icon349 = 30, icon350 = 50, icon351 = 80, icon352 = 5, 
        icon353 = 1, icon354 = 370, icon355 = 200, icon356 = 12, 
        icon357 = 18, icon358 = 20, icon359 = 3, icon360 = 3400, 
        icon361 = 5, icon362 = 2600, icon363 = 8, icon364 = 2000, 
        icon365 = 40, icon366 = 1900, icon367 = 7000, icon368 = 0, 
        icon369 = 50, icon370 = 1, icon371 = 2, icon372 = 1000, 
        icon373 = 1000, icon374 = 2, icon375 = 5, icon376 = 3, 
        icon377 = 20, icon378 = 1, icon379 = 0)
    dcon <- c(big = big, dcon01 = 0, dcon02 = 7.7, dcon03 = 0.06, 
        dcon04 = 0.6, dcon05 = 1e-05, dcon06 = 0.001, dcon07 = 0.09, 
        exit.obj = exit.obj, dcon09 = 0, dcon10 = 1, dcon11 = 0, 
        dcon12 = 0.009, dcon13 = 0.054, eps = .Machine$double.eps, 
        dcon15 = 0.4, dcon16 = 0.2, dcon17 = 0.5, dcon18 = 0.12, 
        dcon19 = 0.15, dcon20 = 0.3, dcon21 = 0.5, dcon22 = 45000, 
        dcon23 = 1e+17, dcon24 = 0.1, dcon25 = 0.35, dcon26 = 0.8, 
        dcon27 = 1.2, dcon28 = 3e-05, dcon29 = 0.01, dcon30 = 2.2, 
        dcon31 = 0.25, dcon32 = 1, dcon33 = 1.4, dcon34 = 0.76, 
        dcon35 = 0.75, dcon36 = 8, dcon37 = 1.6, dcon38 = 2.8, 
        dcon39 = 6, dcon40 = 0.75, dcon41 = 1300, dcon42 = 0.13, 
        dcon43 = 0.74, dcon44 = 2, dcon45 = 0.4, dcon46 = 0.3, 
        dcon47 = 0.5, dcon48 = 0.5, dcon49 = 0.6, dcon50 = 0.65, 
        dcon51 = 1.5, dcon52 = 2.4, dcon53 = 0.8, dcon54 = 440, 
        dcon55 = 0.43, dcon56 = 6, dcon57 = 0.5, dcon58 = 1, 
        dcon59 = 0.55, dcon60 = 3, dcon61 = 0.5, dcon62 = 1, 
        dcon63 = 5, dcon64 = 0.45, dcon65 = 0.62, dcon66 = 0.15, 
        dcon67 = 0.75, dcon68 = 0.5, dcon69 = 0.8, dcon70 = 0.2, 
        dcon71 = 0.5, dcon72 = 0.2, dcon73 = 1.3, dcon74 = 8, 
        dcon75 = 0.2, dcon76 = 0.4, dcon77 = 0.8, dcon78 = 8, 
        dcon79 = 5e-04, dcon80 = 5e-05, dcon81 = 0.4, dcon82 = 4e-05, 
        dcon83 = 0.1, dcon84 = 1e-05, dcon85 = 0.2, dcon86 = 6, 
        dcon87 = 6, dcon88 = 0.004, dcon89 = 5e-05, dcon90 = 10, 
        dcon91 = 0.005, dcon92 = 0.1, dcon93 = 1.7, dcon94 = 0.09, 
        dcon95 = 1.5, dcon96 = 8, dcon97 = 0.45, dcon98 = 4, 
        dcon99 = 0.2, dcon100 = 0.4, dcon101 = 0.1, dcon102 = 0.7, 
        dcon103 = 1.2, dcon104 = 1.5, dcon105 = 1.7, dcon106 = 0.6, 
        dcon107 = 0.4, dcon108 = 0.2, dcon109 = 1.5, dcon110 = 0.4, 
        dcon111 = 1.1, dcon112 = 0.3, dcon113 = 0.7, dcon114 = 0.77, 
        dcon115 = 4, dcon116 = 1, dcon117 = 0.9, dcon118 = 1.1, 
        dcon119 = 1.1, dcon120 = 0.7, dcon121 = 2.6, dcon122 = 0.12, 
        dcon123 = 0.55, dcon124 = 5.7, dcon125 = 0.5, dcon126 = 2.4, 
        dcon127 = 0.5, dcon128 = 0.6, dcon129 = 0.5, dcon130 = 0.57, 
        dcon131 = 0.2, dcon132 = 0.65, dcon133 = 0.25, dcon134 = 0.34, 
        dcon135 = 0.35, dcon136 = 0.55, dcon137 = 0.2, dcon138 = 0.8, 
        dcon139 = 0.2, dcon140 = 15, dcon141 = 2, dcon142 = 0.6, 
        dcon143 = 13, dcon144 = 14, dcon145 = 13, dcon146 = 0.6, 
        dcon147 = 0.9, dcon148 = 2, dcon149 = 18, dcon150 = 60, 
        dcon151 = 4.5, dcon152 = 60, dcon153 = 2, dcon154 = 60, 
        dcon155 = 7e-05, dcon156 = 3, dcon157 = 0.04, dcon158 = 1800000, 
        dcon159 = 12.5, dcon160 = 9.7, dcon161 = 11, dcon162 = 0.6, 
        dcon163 = 2, dcon164 = 2e-04, dcon165 = 0.05, dcon166 = 0.05, 
        dcon167 = 1, dcon168 = 2, dcon169 = 0.9, dcon170 = 10, 
        dcon171 = 2.5, dcon172 = 10.5, dcon173 = 0.2, dcon174 = 0.2, 
        dcon175 = 0.1, dcon176 = 57, dcon177 = 0.6, dcon178 = 0.7, 
        dcon179 = 0.5, dcon180 = 2, dcon181 = 0.5, dcon182 = 1.5, 
        dcon183 = 0.12, dcon184 = 0.2, dcon185 = 0.6, dcon186 = 0.6, 
        dcon187 = 0.8, dcon188 = 1.2, dcon189 = 0.25, dcon190 = 2.8, 
        dcon191 = 5.7, dcon192 = 0.99, dcon193 = 0.9, dcon194 = 0.9, 
        dcon195 = 0.01, dcon196 = 1e-10, dcon197 = 1.6, dcon198 = 5e-04, 
        dcon199 = 0.6, dcon200 = 5, dcon201 = 1, dcon202 = 1.5, 
        dcon203 = 5, dcon204 = 0.5, dcon205 = 2500, dcon206 = 3e-05, 
        dcon207 = 0.35, dcon208 = 5.8, dcon209 = 0.5, dcon210 = 3e-05, 
        dcon211 = 0.2, dcon212 = 3.5, dcon213 = 0.25, dcon214 = 0.25, 
        dcon215 = 0.55, dcon216 = 0.4, dcon217 = 0.6, dcon218 = 0.005, 
        dcon219 = 0.2, dcon220 = 0.3, dcon221 = 0.27, dcon222 = 0.7, 
        dcon223 = 1.1, dcon224 = 14, dcon225 = 28, dcon226 = 0.02, 
        dcon227 = 0.3, dcon228 = 0.5, dcon229 = 0.05, dcon230 = 0.05, 
        dcon231 = 0.2, dcon232 = 0.75, dcon233 = 0.34, dcon234 = 0.3, 
        dcon235 = 0.5, dcon236 = 0.6, dcon237 = 0.5, dcon238 = 0.3, 
        dcon239 = 0.2, dcon240 = 0.2, dcon241 = 0.3, dcon242 = 0.8, 
        dcon243 = 0.6, dcon244 = 0.1, dcon245 = 0.9, dcon246 = 0.8, 
        dcon247 = 0.38, dcon248 = 0.5, dcon249 = 0.6, dcon250 = 0.6, 
        dcon251 = 0.1, dcon252 = 0.35, dcon253 = 0.3, dcon254 = 0.9, 
        dcon255 = 0.3, dcon256 = 0.5, dcon257 = 0.15, dcon258 = 0.2, 
        dcon259 = 0.25, dcon260 = 0.65, dcon261 = 0.55, dcon262 = 0.3, 
        dcon263 = 0.4, dcon264 = 0.4, dcon265 = 0.1, dcon266 = 0.8, 
        dcon267 = 0.5, dcon268 = 0.25, dcon269 = 0.8, dcon270 = 0.2, 
        dcon271 = 0.7, dcon272 = 0.75, dcon273 = 0.4, dcon274 = 0.5, 
        dcon275 = 0.1, dcon276 = 0.1, dcon277 = 0.1, dcon278 = 0.6, 
        dcon279 = 0.4, dcon280 = 0.3, dcon281 = 0.2, dcon282 = 0.5, 
        dcon283 = 0.4, dcon284 = 0.5, dcon285 = 0.6, dcon286 = 0.1, 
        dcon287 = 0.1, dcon288 = 0.5, dcon289 = 0.1)
    aux <- c(adjust = 1, sharetol = 1e-05, single.search = 5000, 
        doubleconst = doubleconst, force.risk.aver = force.risk.aver, 
        enforce.max.weight = enforce.max.weight, 
	save.iterhistory = save.iterhistory, throw.error = TRUE, 
	safe.mode=safe.mode)
    dots <- list(...)
    if (length(dots)) {
        dotnam <- names(dots)
        fchar <- substring(dotnam, 1, 1)
        extraneous <- c("objective.limit", "objfail.max")
        bad <- setdiff(dotnam, c(names(icon), names(dcon), names(aux), 
            extraneous))
        if (length(bad)) {
            stop(paste("unrecognized argument(s)", paste(bad, 
                collapse = ", ")))
        }
        dlen <- unlist(lapply(dots, length))
        if (any(dlen != 1)) {
            stop(paste("need single value for control parameters:", 
                paste(dotnam[dlen != 1], collapse = ", ")))
        }
        nami <- dotnam[fchar == "i"]
        if (length(nami)) {
            ima <- match(nami, names(icon), nomatch = NA)
            if (any(is.na(ima))) {
                stop(paste("unknown control parameter(s):", paste(nami[is.na(ima)], 
                  collapse = ", ")))
            }
            icon[nami] <- unlist(dots[nami])
        }
        namd <- dotnam[fchar == "d"]
        if (length(namd)) {
            dma <- match(namd, names(dcon), nomatch = NA)
            if (any(is.na(dma))) {
                stop(paste("unknown control parameter(s):", paste(namd[is.na(dma)], 
                  collapse = ", ")))
            }
            dcon[namd] <- unlist(dots[namd])
        }
    }
    if (length(icon) != 380) 
        stop("an integer parameter did not have length one")
    if (length(dcon) != 290) 
        stop("a double precision parameter did not have length one")
    if (length(aux) != 9) 
        stop("an auxiliary parameter did not have length one")
    if (any(icon > .Machine$integer.max, na.rm = TRUE)) {
        toobig <- names(icon[!is.na(icon) & icon > .Machine$integer.max])
        warning(paste(length(toobig), "item(s) overflow integer maximum, reducing:", 
            paste(toobig, collapse = ", ")))
        icon[toobig] <- .Machine$integer.max
    }
    if (any(dcon > big)) {
        dtoobig <- names(dcon[dcon > big])
        dcon[dtoobig] <- big
    }
    if (any(dcon < -big)) {
        dtooneg <- names(dcon[dcon < -big])
        dcon[dtooneg] <- -big
    }
    list(icontrol = icon, dcontrol = dcon, aux = aux)
}

"head.randportBurSt" <-
function (x, n=6, ...) 
{
	fun.copyright <- "Copyright 2009 Burns Statistics Ltd.  All rights reserved."
	fun.version <- "head.randportBurSt 001"
	xat <- attributes(x)
	ans <- head(unclass(x), n=n)
	xat$funevals <- NA
	attributes(ans) <- xat
	ans
}

"trade.optimizer" <-
function (prices, variance=NULL, expected.return=NULL, penalty.constraint=1000,
	..., seed=.standard.seed.BurSt, control=trade.optimizer.control, 
	identity=NULL, dumpfile="")
{
	fun.copyright <- "Copyright 2003-2012 Burns Statistics Ltd.  All rights reserved."
	fun.metaversion <- "trade.optimizer 029"
	fun.selfversion <- "029"
	fun.version <- paste(fun.metaversion, fun.selfversion, sep=".")

	startstamp <- date()
	Mc <- match.call()
	preobj <- trade.optimizer.pre(prices=prices, variance=variance,
		expected.return=expected.return, 
		penalty.constraint=penalty.constraint, ..., seed=seed, 
		control=control, dumpfile=dumpfile, Mc=Mc)
	sizecontrol <- preobj$sizecontrol
	nret <- sizecontrol["nalphas"]
	nvar <- sizecontrol["nvariances"]
	nalcomben <- sizecontrol["nalcomben"]
	nvarcomben <- sizecontrol["nvarcomben"]
	atable <- preobj$alphatable
	vtable <- preobj$vartable
	dist.utility <- preobj$dist.utility
	do.warn <- preobj$dowarn
	vartype <- preobj$vartype

	nsize <- sizecontrol["nsize"]
	ndval <- sizecontrol["ndval"]
	sizes <- sizecontrol[1:nsize]
	icontrol <- sizecontrol[(nsize+1):length(sizecontrol)]
	dcontrol <- preobj$dvalcontrol[(ndval+1):length(preobj$dvalcontrol)]
	penalty.constraint <- preobj$penaltyconstraint
	assetnam <- preobj$assetnam
	ntrade <- sizes["ntrade"]
	nassets <- sizes["nassets"]
	distnum <- sizes["distnum"]
	norig <- sizes["norig"]
	nconsmain <- sizes["nconsmain"]
	turnover.type <- sizes["turnover.constraint"]
	long.only <- sizes["long.only"]
	auxcontrol <- preobj$auxcontrol
	sharetol <- auxcontrol["sharetol"]
	dist.bounds <- preobj$distpack$dist.bounds
	dist.center <- preobj$distpack$dist.center
	utility <- preobj$utility
	risk.aversion <- preobj$risk.aversion
	utable <- preobj$utable
	bench.constraint <- preobj$bench.constraint
	positions <- preobj$positions
	tol.positions <- preobj$tol.positions

	utility.menu <- c("mean-variance", "information ratio",
		"exocost information ratio", "minimum variance",
		"maximum return", "mean-volatility", "distance")

	if(!length(risk.aversion)) risk.aversion <- 1

	if(!length(utility)) {
		if(!is.logical(dist.utility)) {
			stop(paste("'dist.utility' must be a logical vector",
				"-- given has mode", mode(dist.utility),
				"and length", length(dist.utility)))
		}
		if(any(dist.utility) && length(dist.center)) {
			utility <- "distance"
		} else {
			utility <- "information ratio"
		}
	}
	utility.num <- pmatch(utility, utility.menu, nomatch=0)
	utility <- utility.menu[utility.num]
	if(any(utility.num == 0)) {
		stop(paste("unknown or ambiguous value for 'utility'",
			"valid choices are:", paste(paste('"', 
			utility.menu, '"', sep=""), collapse=", ")))
	}
	if(length(utility) != 1) {
		stop(paste("'utility' must be a single string",
			"-- given has length", length(utility),
			"-- you can create custom utilities by giving a",
			"'utable' argument"))
	}
	if(utility.num == 4) {
		if(nvar == 0) {
			stop("minimum variance utility but NULL variance")
		}
	} else if(utility.num == 2 || utility.num == 3) {
		if(nret == 0) {
			if(nvar == 0) {
			    if(length(dist.center)) {
				stop(paste("neither 'variance' nor",
					"'expected.return' given",
					"to the optimizer -- if you meant",
					"to have a 'distance' utility, you",
					"need to specify the 'utility'",
					"argument"))
			    } else {
				stop(paste("neither 'variance' nor",
					"'expected.return' nor distance given",
					"to the optimizer"))
			    }
			}
			utility.num <- 4
			if(do.warn["utility.switch"] && !length(utable)){
				warning(paste("switching utility from '",
					utility, "' to 'minimum variance'",
					" ('do.warn' suppression is ",
					"'utility.switch')", sep=""))
			}
			utility <- "minimum variance"
		}
		if(nvar == 0) {
			utility.num <- 5
			if(do.warn["utility.switch"] && !length(utable)){
				warning(paste("switching utility from '",
					utility, "' to 'maximum return'",
					" ('do.warn' suppression is ",
					"'utility.switch')", sep=""))
			}
			utility <- "maximum return"
		}
	} else if(utility.num == 1 || utility.num == 6) {
		if(!is.numeric(risk.aversion)) {
			stop(paste("'risk.aversion' must be numeric,",
				"-- given is", mode(risk.aversion),
				"and length", length(risk.aversion)))
		}
		if(any(is.na(risk.aversion))) {
			stop(paste(sum(is.na(risk.aversion)), 
				"missing value(s) in 'risk.aversion'"))
		}
		if(any(risk.aversion == -Inf)) {
			stop(paste("negative Inf not allowed",
				"in 'risk.aversion'"))
		}
		if(all(risk.aversion == Inf)) {
			if(do.warn["utility.switch"] && !length(utable)){
				warning(paste("switching utility from '",
					utility, "' to 'minimum variance'",
					" ('do.warn' suppression is ",
					"'utility.switch')", sep=""))
			}
			utility <- "minimum variance"
			utility.num <- 4
		} else if(any(risk.aversion == Inf) && !length(utable)) {
			stop(paste("mix of infinite and finite risk aversions",
				"-- you need to specify the 'utable' argument",
				"to achieve this effect"))
		}
		if(nret == 0) {
			if(nvar == 0) {
			    if(length(dist.center)) {
				stop(paste("neither 'variance' nor",
					"'expected.return' given",
					"to the optimizer -- if you meant",
					"to have a 'distance' utility, you",
					"need to specify the 'utility'",
					"argument"))
			    } else {
				stop(paste("neither 'variance' nor",
					"'expected.return' nor distance given",
					"to the optimizer"))
			    }
			}
			if(do.warn["utility.switch"] && !length(utable)){
				warning(paste("switching utility from '",
					utility, "' to 'minimum variance'",
					" ('do.warn' suppression is ",
					"'utility.switch')", sep=""))
			}
			utility <- "minimum variance"
			utility.num <- 4
		} else if(nvar == 0) {
			if(do.warn["utility.switch"] && !length(utable)){
				warning(paste("switching utility from '",
					utility, "' to 'maximum return'",
					" ('do.warn' suppression is ",
					"'utility.switch')", sep=""))
			}
			utility <- "maximum return"
			utility.num <- 5
		} else if(!length(utable) && length(risk.aversion) == 1) {
			utility <- paste(utility, ", risk aversion: ",
				risk.aversion, sep="")
		}
	} else if(utility.num == 5) {
		if(nret == 0) {
			stop("maximum return utility but no expected returns")
		}
	} else if(utility.num == 7) {
		if(length(dist.center) == 0) {
			stop("distance utility but no distance given")
		}
		if(!is.logical(dist.utility)) {
			stop(paste("'dist.utility' must be a logical vector",
				"-- given has mode", mode(dist.utility),
				"and length", length(dist.utility)))
		}
		if(!any(dist.utility)) {
			dist.utility <- TRUE
			if((is.list(dist.center) && length(dist.center) > 1)
					|| is.matrix(dist.bounds)) {
				warning(paste("coercing 'dist.utility' to",
					"TRUE"))
			}
		}
	}
	# don't make trouble when risk.aversion not used
	if(any(!is.finite(risk.aversion))) risk.aversion <- 1

	if(utility == "information ratio") {
		if(sizes["cost.type"]) {
			utility <- "information ratio (with costs)"
		} else {
			utility <- "information ratio (no costs)"
		}
	}

	if(sizes["distnum"]) {
		if(sizes["distconnum"] && !is.matrix(dist.bounds)) {
			if(utility == "distance") {
				sizecontrol["distconnum"] <- distconnum <- 0
				dist.utility[] <- TRUE
			} else {
				stop(paste(distconnum,
					"distance constraint(s)",
					"but 'dist.bounds' has zero length"))
			}
		}
	} else if(utility == "distance") {
		stop("distance utility but 'dist.center' is NULL")
	}

	# second go at utility


	if(length(utable)) {
		if(length(bench.constraint) && safe.mode) {
			stop(paste("'bench.constraint' may not be given",
				"if 'utable' is"))
		}
		utable <- as.matrix(utable)
		if(nrow(utable) != 6 || !is.numeric(utable)) 
			stop("'utable' must be a numeric matrix with 6 rows")
		if(any(is.na(utable))) 
			stop("missing value(s) in 'utable'")
		ut.d <- utable[3,]
		ut.du <- sort(unique(ut.d[ut.d >= 0]))
		ut.dul <- length(ut.du)
		if(ut.dul == 0) {
			stop(paste("improper destinations (3rd row)",
				"in 'utable' -- need at least one zero"))
		}
		if((ut.du[1] != 0 || (ut.dul > 1 && any(diff(ut.du) > 1)))) {
			stop(paste("improper destinations (3rd row)",
				"in 'utable' -- need destinations to be",
				"zero through n with no integers skipped",
				"-- given is:", paste(ut.du, collapse=", ")))
		}
		sizecontrol["ndest"] <- ndest <- max(ut.d) + 1
		ut.o <- utable[4,]
		if(any(ut.o < 0 | ut.o > 6)) {
			stop(paste("improper utility (4th row) in 'utable'",
				"-- allowable values are: 0 through 6"))
		}
		if(nret == 0 && any(ut.o %in% c(0,1,2,4,5))) {
			stop(paste("improper utility (4th row) in 'utable'",
				"-- 'expected.return' not given so only",
				"codes 3 and 6 allowed"))
		}
		if(nvar == 0 && any(ut.o %in% c(0,1,2,3,5))) {
			stop(paste("improper utility (4th row) in 'utable'",
				"-- 'variance' not given so only",
				"codes 4 and 6 allowed"))
		}
		if(distnum == 0 && any(ut.o == 6)) {
			stop(paste("improper utility (4th row) in 'utable'",
				"-- no distances given but code 6 used"))
		}
		ut.usea <- ut.o != 3 & ut.o != 6
		ut.usev <- ut.o != 4 & ut.o != 6
		if(any(utable[1,ut.usea] > nalcomben - 1) || any(utable[1,
				ut.usea] < 0)) {
			stop(paste("improper 1st row in 'utable'",
				"-- columns using 'expected.return' in",
				"the utility must be",
				"non-negative and here should not exceed", 
				nalcomben - 1))
		}
		if(any(utable[1,ut.o == 6] > distnum - 1) || any(utable[1,ut.o
				== 6] < 0)) {
			stop(paste("improper 1st row in 'utable'",
				"-- columns using distances in",
				"the utility must be",
				"non-negative and here",
				"should not exceed", distnum - 1))
		}
		if(any(utable[2,ut.usev] > nvarcomben - 1) || any(utable[
				2,ut.usev] < 0)) {
			stop(paste("improper 2nd row in 'utable'",
				"-- columns using 'variance' in",
				"the utility must be",
				"non-negative and here should not exceed", 
				nvarcomben - 1))
		}
		if(auxcontrol["force.risk.aver"]) {
			if(length(risk.aversion) != 1 && length(risk.aversion)
					!= ncol(utable)) {
				stop(paste("'risk.aversion' expected to be",
					"numeric of length one or", 
					ncol(utable), "-- given has mode",
					mode(risk.aversion), "and length",
					length(risk.aversion)))
			}
			if(any(is.na(risk.aversion))) {
				stop(paste(sum(is.na(risk.aversion)),
					"missing value(s) in 'risk.aversion'"))
			}
			if(any(risk.aversion == -Inf)) {
				stop(paste("negative Inf not allowed",
					"in 'risk.aversion'"))
			}
			utable[5,] <- risk.aversion
		}
		if(any(utable[5,] == Inf)) {
			utable[4, utable[5,] == Inf] <- 3
			utable[5, utable[4,] == 3] <- 0
		}
		utable[1, utable[4,] == 3] <- -1
		utable[2, utable[4,] == 4] <- -1
		if(any(ut.d >= 0) && any(utable[6, ut.d >= 0] < 0))
			if(do.warn["neg.dest.wt"]) {
				warning(paste(sum(utable[6,ut.d>=0] < 0),
					"negative weight(s)-in-destination",
					"in 'utable' ('do.warn' suppression",
					"is 'neg.dest.wt')"))
			}
		sizecontrol["nutil"] <- nutil <- ncol(utable)
		utouniq <- unique(utable[4, utable[3,] >= 0])
		if(length(utouniq) == 1) {
			utility <- utility.menu[utouniq + 1]
			risk.aversion <- utable[5,]
			if(length(unique(risk.aversion)) == 1 &&
					(utouniq == 0 || utouniq == 5)) {
				utility <- paste(utility, ", risk aversion: ",
					risk.aversion[1], sep="")
			}
		} else {
			utility <- "custom utility table"
		}
	} else {
		if(utility != "distance") {
			ut.a <- rep(1:nalcomben, nvarcomben)
			ut.v <- rep(1:nvarcomben, rep(nalcomben, nvarcomben))
			ut.ab <- rep(atable[2,], nvarcomben)
			ut.vb <- rep(vtable[2,], rep(nalcomben, nvarcomben))
			if(atable[1,1] >= 0 && vtable[1,1] >= 0) {
				ut.a <- ut.a[ut.ab == ut.vb]
				ut.v <- ut.v[ut.ab == ut.vb]
			}
			ut.n <- length(ut.a)
			ut.o <- rep(utility.num, length=ut.n)
			ut.a[ut.o == 4] <- 0
			if(length(bench.constraint)) {
				ut.d <- rep(0, ut.n)
				ut.m <- match(ut.v, preobj$vtdmatch,
					nomatch=0) > 0
				ut.d[ut.m] <- 1:sum(ut.m)
				sizecontrol["ndest"] <- ndest <- sum(ut.m)
			} else {
				ut.d <- 1:ut.n
				sizecontrol["ndest"] <- ndest <- ut.n
			}
			sizecontrol["nutil"] <- nutil <- length(ut.a)
			ut.v[ut.o == 5] <- 0
			utiltab.int <- rbind(ut.a, ut.v, ut.d, ut.o) - 1
			if(length(risk.aversion) > nutil) {
				warning(paste("length of 'risk.aversion' is",
					length(risk.aversion), 
					"expecting length",
					nutil, if(nutil > 1) "or length one"))
			}
			utiltab.doub <- rbind(rep(risk.aversion, length=nutil),
				rep(1, nutil))
		} else {
			# distance utility
			distunum <- sum(dist.utility)
			if(distunum <= 0) {
				stop(paste("distance utility but all values",
					"in 'dist.utility' are FALSE"))
			}
			sizecontrol[c("nutil", "ndest")] <- nutil <- ndest <- 
				distunum
			distuw <- which(dist.utility) - 1
			utiltab.int <- rbind(distuw, 0, 0:(distunum -1), 6)
			utiltab.doub <- rbind(rep(0, distunum), rep(1, 
				distunum))
		}
		utable <- rbind(utiltab.int, utiltab.doub)
	}
	ut.r <- utable[5,]
	ut.o <- utable[4,]
	ut.r[ut.o == 3] <- 1
	ut.o[ut.o == 3] <- 0
	ut.o[ut.o == 4] <- 0
	utable[4,] <- ut.o
	utable[5,] <- ut.r
	if(any(dist.utility) && !any(ut.o == 6)) {
		warning(paste(sum(dist.utility), "values in 'dist.utility'",
			"are TRUE but no distance utilities used",
			"(in 'utable')"))
	}
	if(any(ut.o < 0) || any(ut.o > 6) || any(ut.o == 3 | ut.o == 4)) {
		stop(paste("'opt.utility' row of 'utable' has one or more",
			"illegal values, valid values are 0, 1, 2, 5, 6",
			"-- the row is:", paste(ut.o, collapse=", ")))

	}

	if(any(ut.o == 0 | ut.o == 5)) {
		if(any(ut.r[ut.o == 0 | ut.o == 5] < 0) && 
				do.warn["neg.risk.aversion"]) {
			warning(paste("negative risk aversion(s) in 'utable'",
				"('do.warn' suppression is",
				"'neg.risk.aversion')"))
		}
		if(do.warn["penalty.size"] && any(ut.r[ut.o == 0] > 1e9)) {
			warning(paste("risk aversion large relative to",
				"constraint penalty -- optimizer may not",
				"do well meeting constraints ('do.warn'",
				"suppression is 'penalty.size')"))
		}
	}
	utiltab.int <- utable[1:4,]
	utiltab.doub <- utable[5:6,]

	if(nvar == 0 && utility != "distance" && do.warn["novariance.optim"]) {
		warning(paste("performing optimization with no variance",
			"('do.warn' suppression is 'novariance.optim')"))
	}

	# do the actual stuff

	if(ntrade < 6) ntradeplus <- 6 else ntradeplus <- ntrade
	if(icontrol["nonconverge.mult"] > 1) {
		histlen <- 2 + icontrol["nonconverge.mult"] * 
			icontrol["iterations.max"]
	} else {
		histlen <- 2 + icontrol["iterations.max"]
	}
	nalcomben <- sizes[23 + 1]
        nvarcomben <- sizes[24 + 1]
        ndest <- sizecontrol[4 + 1] # note not 'sizes'

	out <- .C("portgen_BurSt", as.integer(preobj$existid), 
		as.double(preobj$existing),
		as.double(preobj$prices), as.integer(preobj$tradeuniv),
		as.double(preobj$lowup), as.double(preobj$variance),
		as.integer(preobj$vartype), as.integer(preobj$varoffset),
		as.integer(preobj$nvarfactors), as.double(preobj$expecret),
		as.integer(preobj$benchid), cost=as.double(preobj$cost), 
		cost.par=as.double(preobj$costpar), 
		trade.id=integer(ntradeplus), 
		trade.sh=double(ntradeplus), 
		threshold=as.double(preobj$threshold),
		avu=double(nalcomben + nvarcomben + ndest), 
		constrainvec=as.double(preobj$constrainvec), 
		constrainlevels=as.integer(preobj$constrainlevels), 
		lowconstrain=as.double(preobj$lowconstrain),
		highconstrain=as.double(preobj$highconstrain), 
		penalty.constraint=as.double(preobj$penaltyconstraint),
		constraint.violation=double(length(preobj$penaltyconstraint)),
		constraintype=as.integer(preobj$constraintype),
		linstyle=as.integer(preobj$linstyle), 
		lindirection=as.integer(preobj$lindirection),
		linrfmap=as.integer(preobj$linrfmap),
		dest.wt=as.double(preobj$destwt),
		as.integer(sizecontrol), 
		as.integer(preobj$startid), as.double(preobj$startsol),
		as.integer(preobj$forcedid), as.double(preobj$forcedtrade),
		as.double(preobj$rfracvec), as.integer(preobj$rfstynum),
		as.integer(preobj$rfracactive),
		as.double(preobj$benchweights), as.integer(preobj$benchwtid),
		as.integer(preobj$rfvarid), as.integer(preobj$rftab),
		riskfraction=double(nassets * sizes["totriskfrac"]),
		as.double(preobj$distcenter), as.double(preobj$distbounds), 
		as.integer(preobj$diststynum), as.integer(preobj$distusenum),
		as.double(preobj$distcoef), as.integer(preobj$distcoefloc),
		as.double(preobj$distscale), distval=double(distnum),
		utiltab.int=as.integer(utiltab.int), 
		atable=as.integer(atable),
		vtable=as.integer(vtable),
		utiltab.doub=as.double(utiltab.doub),
		as.double(preobj$dvalcontrol), 
		seed = as.integer(preobj$seed),
		ioutput=integer(48), doutput=double(6), 
		version=character(1), 
		ezlicense=preobj$ezlicense, iterhistory=double(histlen))[
		c("trade.sh", "avu", "trade.id", "constraint.violation", 
		"distval", "riskfraction", "ioutput", "doutput", "version", 
		"iterhistory")]

	results <- out$doutput[c(1,3,4,5)]
	names(results) <- c("objective", "negutil", "cost", "penalty")
	optim.mumbo.jumbo <- out$ioutput[c(10, 13, 11, 12, 7,1,2,8,46:48, 14)]
	names(optim.mumbo.jumbo) <- c("iterations done", "successes",
		"consec fails", "max consec fail", "fun evals", 
		"eval requests", "nonstarters", "flag", "runs", 
		"total iterations", "total successes", "init ntrade")
	if(abs(optim.mumbo.jumbo["flag"]) >= 1000) {
		errnum <- optim.mumbo.jumbo["flag"]
		errmsg <- paste( switch(as.character( errnum),
			"1001" = "too many failures in random.portfolio",
			"1008" = "number traded is too small",
			"1010" = "funeval.max <= 1 and no starting solution",
			"1020" = "memory allocation failed",
			"1023" = "bad constraint type",
			"1025" = "bad variance type",
			"1027" = "bad optimization type",
			"1031" = "more than 'ntrade' traded (can retry with new seed)",
			"1075" = "need only full variance matrices (for corport, etc.)",
			"1099" = "illegal final trade (can retry with new seed)",
				"unspecified error"), 
			" (error ", errnum, ")",
			" fun.evals ", out$ioutput[1],
			" please email a report to support@portfolioprobe.com",
			sep="")
		stop(errmsg)
	}
	if(optim.mumbo.jumbo["flag"] == -2 && do.warn["exit.obj"] &&
			dcontrol["exit.obj"] < -1e5) {
		warning(paste("early exit due to objective value;",
			"you can change the exit value with control",
			"argument 'exit.obj'  ('do.warn' suppression is",
			"'exit.obj')"))
	}
	if(optim.mumbo.jumbo["max consec fail"] > icontrol["fail.iter"] ||
			icontrol["npar"] == 1) {
		converged <- TRUE
	} else {
		converged <- FALSE
		if(icontrol["funeval.max"] > 1 && do.warn["converged"]) {
			warning(paste("convergence not achieved in",
				optim.mumbo.jumbo["iterations done"],
				"iterations (based on",
				icontrol["fail.iter"], 
				"consecutive failures to improve)",
				"('do.warn' suppression is 'converged')"))
		}
	}
	if(!is.finite(results["objective"])) {
		stop(paste("numerical error during optimization --",
			"the variance may not be right(?)"))
	}
	if(dcontrol["exit.obj"] < -1e10 && results["objective"] <= 
			dcontrol["exit.obj"]) {
		warning(paste("computations exited because the objective",
			"is less than 'exit.obj'", dcontrol["exit.obj"], 
			"-- run-away result resumed (if not, then you may",
			"want to rescale the problem"))
	}
	constraint.violation <- out$constraint.violation
	names(constraint.violation) <- names(penalty.constraint)
	if(any(is.na(constraint.violation))) {
		# in theory never happens, but best to check
		if(nchar(dumpfile)) {
			writedump.BurSt(Mc, dumpfile)
		}
		stop(paste("missing value(s) in 'constraint.violation'",
			"(internal error) --",
			"please email a report to support@portfolioprobe.com"))
	}
        if(results["penalty"] > 0) {
		violated <- .unpack.violcode(out$ioutput[9])
		abs.obj <- abs(results["objective"])
		if(do.warn["nonzero.penalty"] && (abs.obj < 1e-6 || 
				results["penalty"]/abs.obj > 1e-6 ||
				results["penalty"] > .01 * 
				mean(penalty.constraint))) {
                	warning(paste("non-zero penalty of", results["penalty"],
                       		" constraints not met are:",
				paste(violated, collapse=", "),
                        	"\nAre there inconsistent constraints?",
				if(any(preobj$max.weight < 1))
				"('max.weight' is sometimes the root cause)",
				if(icontrol["feasible"] > 0 && icontrol[
						"feasible"] < icontrol[
						"iterations.max"])
				"setting 'feasible' to 0 may find a better solution",
				"('do.warn' suppression is 'nonzero.penalty')"
				))
		}
        } else {
		violated <- NULL
	}
	dimnames(utable) <- list(c("alpha.spot", "variance.spot", 
		"destination", "opt.utility", "risk.aversion", 
		"wt.in.destination"), NULL)
	nalcomben <- sizecontrol["nalcomben"]
	nvarcomben <- sizecontrol["nvarcomben"]

	if(nret) {
		alpha.values <- out$avu[1:nalcomben]
		xrnam <- dimnames(expected.return)[[2]]
		if(length(xrnam) || any(nchar(attr(atable, "benchmarks"))) ||
				nret > 1) {
			if(!length(xrnam) && nret > 1) {
				xrnam <- paste("A", 0:(nret-1), sep="")
			}
			if(any(nchar(attr(atable, "benchmarks")))) {
				if(length(xrnam)) {
					nav <- paste(xrnam[atable[1,] + 1],
						attr(atable, "benchmarks"), 
						sep=" -- ")
				} else {
					nav <- attr(atable, "benchmarks")
				}
			} else {
				if(length(xrnam)) {
					nav <- xrnam[atable[1,] + 1]
				} else {
					nav <- NULL
				}
			}
			names(alpha.values) <- nav
		}
	} else {
		alpha.values <- NA
	}
	if(nvar) {
		var.values <- out$avu[nalcomben + 1:nvarcomben]
		if(length(dim(variance)) == 3) {
			varslnam <- dimnames(variance)[[3]]
		} else {
			varslnam <- NULL
		}
		if(length(varslnam) || any(nchar(attr(vtable, "benchmarks"))) ||
				nvar > 1) {
			if(!length(varslnam) && nvar > 1) {
				varslnam <- paste("V", 0:(nvar-1), sep="")
			}
			if(any(nchar(attr(vtable, "benchmarks")))) {
				if(length(varslnam)) {
					nvv <- paste(varslnam[vtable[1,] + 1],
						attr(vtable, "benchmarks"), 
						sep=" -- ")
				} else {
					nvv <- attr(vtable, "benchmarks") 
				}
			} else {
				if(length(varslnam)) {
					nvv <- varslnam[vtable[1,] + 1]
				} else {
					nvv <- NULL
				}
			}
			names(var.values) <- nvv
		}
		if(substring(utility, 1, 17) == "information ratio" && 
				sum(vartype) == 0 && do.warn["var.eps"]) {
			if(nvar == 1) {
				vmean <- mean(diag(as.matrix(variance)))
				if(any(var.values < vmean * 1e-6)) {
				    if(length(var.values) == 1) {
					warning(paste("the portfolio variance",
						"seems excessively small using",
						"a naive test (do.warn",
						"suppression is 'var.eps')"))
				    } else {
					warning(paste("at least one portfolio",
						"variance",
						"seems excessively small using",
						"a naive test (do.warn",
						"suppression is 'var.eps')"))
				    }
				}
			} else {
				vmean <- rep(0, nvar)
				for(i in 1:nvar) {
					vmean[i] <- mean(diag(variance[,,i]))
				}
				if(any(var.values < vmean[vtable[1,]+1] * 
						1e-6)) {
					warning(paste("at least one portfolio",
						"variance",
						"seems excessively small using",
						"a naive test (do.warn",
						"suppression is 'var.eps')"))
				}
			}
		}
	} else {
		var.values <- NA
	}
	utility.values <- out$avu[-1:-(nalcomben+nvarcomben)]
	util.loc <- unique(utable["destination",]) + 1
	utility.values <- utility.values[ util.loc[util.loc > 0] ]

	if(ntrade < ntradeplus) {
		out$trade.id <- out$trade.id[1:ntrade]
		out$trade.sh <- out$trade.sh[1:ntrade]
	}
	outord <- order(out$trade.id)
	trade <- out$trade.sh[outord]
	names(trade) <- assetnam[out$trade.id[outord] + 1]
	if(any(is.na(trade))) {
		# in theory never happens, but best to check
		if(nchar(dumpfile)) {
			writedump.BurSt(Mc, dumpfile)
		}
		stop(paste("missing values in 'trade' (internal error)",
			"please email a report to support@portfolioprobe.com"))
	}
	trade <- trade[abs(trade) > sharetol]
	if(any(duplicated(names(trade)))) {
		# in theory never happens, but best to check
		if(nchar(dumpfile)) {
			writedump.BurSt(Mc, dumpfile)
		}
		stop(paste("duplicates in 'trade' (internal error)",
			"please email a report to support@portfolioprobe.com"))
	}
	if(norig) {
		existnam <- names(preobj$existing)
		posnam <- unique(c(existnam, names(trade)))
		position <- rep(0, length(posnam))
		names(position) <- posnam
		position[existnam] <- preobj$existing
		if(length(trade)) {
			position[names(trade)] <- position[names(trade)] + 
				trade
		}
		position <- position[abs(position) > sharetol]
	} else {
		position <- trade
		existing <- NULL
	}
	if(long.only && any(position < -1e-10)) {
		if(icontrol["funeval.max"] > 1) {
			if(nchar(dumpfile)) {
				writedump.BurSt(Mc, dumpfile)
			}
			stop(paste("short position in long-only portfolio",
				"(internal error) --",
				"please email a report to",
				"support@portfolioprobe.com"))
		} else {
			stop(paste("short position in long-only portfolio:",
				"probably bad 'start.sol'"))
		}
	}
	if(!norig && sizes["startgiven"] && icontrol["funeval.max"] > 1 && 
			do.warn["start.noexist"]) {
		warning(paste("'start.sol' (suggested trade) but not",
			"'existing' (current portfolio), did you mean to",
			"use 'existing'? ('do.warn' suppression is",
			"'start.noexist')"))
	}
	if(icontrol["stringency"]) {
		if(out$ioutput[3] == -32) {
			totconverge <- TRUE 
		} else {
			totconverge <- FALSE
		}
		converged <- c(total=totconverge, individual=converged)
	} else {
		optim.mumbo.jumbo["init ntrade"] <- length(trade)
	}
	version <- c(C.code=out$version, S.code=fun.version)
	prices.small <- preobj$prices[unique(c(names(preobj$prices.small), 
		names(trade)))]
	if(sum(preobj$existing) == 0) preobj$existing <- NULL
	ans <- list(new.portfolio=position, trade=trade, results=results, 
		converged=converged, objective.utility=utility, 
		universe.size=preobj$universe.size, utable=utable, 
		atable=atable, 
		vtable=vtable, alpha.values=alpha.values,
		var.values=var.values, utility.values=utility.values,
		constraint.violations=constraint.violation,
		penalty.constraint=penalty.constraint,
		value.limits = preobj$value.limits, prices=prices.small, 
		optim.mumbo.jumbo=optim.mumbo.jumbo, 
		existing = preobj$existing, violated = violated, seed = seed, 
		version=version, sizes=sizecontrol[1:nsize], identity=identity)
	if(optim.mumbo.jumbo["fun evals"] == 0) {
		stop(paste("no evaluations done, problem seems to be seen",
			"as ridiculous"))
	}
	if(distnum) {
		ans$dist.value <- out$distval
		if(length(unique(preobj$distpack$dist.style)) == 1) {
			ans$dist.style <- preobj$distpack$dist.style[1]
		} else {
			ans$dist.style <- preobj$distpack$dist.style
		}
		if(length(unique(preobj$distpack$dist.trade)) == 1) {
			ans$dist.trade <- preobj$distpack$dist.trade[1]
		} else {
			ans$dist.trade <- preobj$distpack$dist.trade
		}
		if(length(unique(preobj$distpack$dist.utility)) == 1) {
			ans$dist.utility <- preobj$distpack$dist.utility[1]
		} else {
			ans$dist.utility <- preobj$distpack$dist.utility
		}
		ans$dist.center <- dist.center
		if(sizecontrol["distconnum"]) {
			dimnames(dist.bounds) <- list(paste("dist", 
				1:nrow(dist.bounds)), c("lower", "upper"))
			# distbounds[distbounds < -big * .99] <- -Inf
			# distbounds[distbounds > big * 1.01] <- Inf
			ans$dist.bounds <- dist.bounds
		}
		ans$dist.prices <- preobj$distpack$dist.prices
	}
	if(length(preobj$benchmarks)) {
		ans$benchmarks <- preobj$benchmarks
	}
	if(sizes["n.forced.trades"]) {
		ans$forced.explicit <- preobj$forced.trade
		if(length(preobj$position.force)) {
			ans$positions.forced <- preobj$position.force
		}
		ans$all.forced <- preobj$forcedtrade
	}
	if(length(positions)) {
		ans$positions <- positions
		if(!length(dimnames(ans$positions)[[1]]) && nrow(ans$positions)
				== nassets) {
			dimnames(ans$positions) <- list(assetnam, NULL)
		}
		ans$tol.positions <- tol.positions
	}
	if(sizes["totriskfrac"]) {
		ans$risk.fraction <- matrix(out$riskfraction, nrow=nassets)
		rfloc <- matrix(preobj$rftab, nrow=6)[4,]
		if(length(names(var.values))) {
			rfnam <- paste(names(var.values)[rfloc + 1], 
				preobj$rf.style, sep=" :: ")
		} else {
			rfnam <- preobj$rf.style
		}
		dimnames(ans$risk.fraction) <- list(assetnam, rfnam)
		attr(ans$risk.fraction, "rfloc") <- rfloc
		attr(ans$risk.fraction, "rf.style") <- preobj$rf.style
	}
	if(icontrol["funeval.max"] <= 1 && turnover.type >= 0 && ntrade > 0) {
		real.start <- preobj$real.start
		if(length(real.start) != length(trade) || any(
				sort(names(trade)) != sort(names(real.start)))
				|| any(real.start[names(trade)] != trade)) {
			warning("trade is different than 'start.sol'")
		}
	}

	if(nconsmain) ans$lintable <- preobj$linpack$lintable

        if(results["penalty"] > 0) {
		if(any(violated == "linear")) {
			attr(ans$violated, "linear violations") <-
				names(constraint.violation[1:nconsmain])[
				constraint.violation[1:nconsmain] > 0]
		}
		if(any(violated == "risk fraction")) {
			rfviol <- NULL
			rfbounds <- array(preobj$rfracvec, c(nassets, 2,
				ncol(ans$risk.fraction)))
			for(i in 1:ncol(ans$risk.fraction)) {
				rfout <- rfbounds[,1,i] > ans$risk.fraction[,i] |
					rfbounds[,2,i] < ans$risk.fraction[,i]
				rfviol <- c(rfviol, assetnam[rfout])
			}
			attr(ans$violated, "risk fraction violations") <- 
				unique(rfviol)
		}
        } 

	class(ans) <- "portfolBurSt" # here to satisfy next function
	ans$con.realized <- constraints.realized(ans, 
		preobj$linpack$lin.constraints, 
		lin.bounds=preobj$linpack$lin.bounds, 
		lin.trade=preobj$linpack$lintable[, 'trade'],
		lin.abs=preobj$linpack$lintable[,'absolute'],
		lin.style=preobj$linpack$lintable[,'style'], 
		lin.direction=preobj$linpack$lintable[,'direction'],
		lin.riskfrac.col=preobj$linpack$lintable[,'riskfrac.col'],
		risk.fraction=ans$risk.fraction,
		dist.value=ans$dist.value, 
		dist.utility=ans$dist.utility,
		dist.bounds=dist.bounds)
	if(preobj$auxcontrol["save.iterhistory"]) {
		ans$iterhistory <- out$iterhistory[ 1:(optim.mumbo.jumbo[
			"iterations done"] + 2) ]
	}
	ans$checkinput <- preobj$checkinput
	ans$call <- match.call()
	ans$timestamp <- c(startstamp, date())
	ans
}

"print.portfolBurSt" <-
function (x, ...) 
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "print.portfolBurSt 009"

	y <- x
	class(y) <- NULL
	y$sizes <- NULL
	y$universe.size <- NULL
	y$utable <- NULL
	y$atable <- NULL
	y$vtable <- NULL
	y$benchmarks <- NULL
	y$prices <- NULL
	y$seed <- NULL
	y$version <- NULL
	y$penalty.constraint <- NULL
	y$constraint.violations <- NULL
	y$positions <- NULL
	y$tol.positions <- NULL
	y$value.limits <- NULL
	y$lin.trade <- NULL
	y$lin.abs <- NULL
	y$con.realized <- NULL
	y$lin.style <- NULL
	y$lin.direction <- NULL
	y$dist.value <- NULL
	y$dist.style <- NULL
	y$dist.trade <- NULL
	y$dist.utility <- NULL
	y$dist.center <- NULL
	y$dist.prices <- NULL
	y$dist.bounds <- NULL
	y$con.realized <- NULL
	y$optim.mumbo.jumbo <- NULL
	y$checkinput <- NULL
	y$identity <- NULL
	y$lintable <- NULL
	y$risk.fraction <- NULL

	print(y, ...)
	invisible(x)
}

"print.randportBurSt" <-
function (x, ...) 
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "print.randportBurSt 006"

	seed <- attr(x, "seed")
	y <- x
	attr(y, "seed") <- NULL
	attr(y, "version") <- NULL
	attr(y, "checkinput") <- NULL
	attr(y, "funevals") <- NULL
	attr(y, "identity") <- NULL
	print.default(y, ...)
	cat("seed attribute begins:", seed[1:4], "\n")
	if(length(attr(y, "violation")) && attr(y, "violation")) {
		cat("\nCaution: at least one constraint violation\n")
	}
	invisible(x)
}

"random.portfolio" <-
function (number.rand=1, prices, variance=NULL, expected.return=NULL, ..., 
	out.trade=FALSE, seed=NULL, control=random.portfolio.control,
	identity=NULL, dumpfile="")
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "random.portfolio 015"

	startstamp <- date()
	if(length(number.rand) != 1 || !is.numeric(number.rand)) {
		stop(paste("'number.rand' needs to be a single",
			"non-negative integer -- given has mode",
			mode(number.rand), "and length", length(number.rand)))
	}
	if(is.na(number.rand)) stop("missing value for 'number.rand'")
	number.rand <- round(number.rand)
	if(number.rand < 0) stop("'number.rand' needs to be non-negative")
	if(number.rand == 0) return(NULL)

	setup <- trade.optimizer.pre( prices=prices,
		variance=variance, expected.return=expected.return, 
		..., seed=seed, control=control, climit.only=TRUE)

	ntrade <- setup$sizecontrol[15 + 1]
	if(any(duplicated(setup$assetnam)))
		stop("duplicate asset names not allowed")
	if(ntrade < 1) stop("ntrade needs to be at least 1")

	nsize <- setup$sizecontrol["nsize"]
	ndval <- setup$sizecontrol["ndval"]

	if(setup$sizecontrol["startgiven"] && setup$dowarn["random.start"]) {
		warning(paste("'start.sol' (suggested trade) ignored in",
			"'random.portfolio', did you mean to use 'existing'",
			"(current portfolio)? ('do.warn' suppression is",
			"'random.start')"))
	}
	if(setup$sizecontrol[nsize + 9 + 1] > 0) {
		setup$sizecontrol[nsize + 9 + 1] <- 0
	}
	if(setup$sizecontrol[5 + 1] < 0) {
		stop("zero trade.value not allowed for random portfolios")
	}

	# setup$sizecontrol[4] <- setup$sizecontrol[4] + 1 # ndest
	setup$sizecontrol[4] <- 1 # ndest
	# utint <- setup$utiltabint
	# utint[seq(3, to=length(utint)-1, by=4)] <- -1
	# setup$utiltabint <- as.integer(c(utint, -1, -1, -1, 0))
	setup$utiltabint <- as.integer(c(-1, -1, 0, 0))
	# setup$utiltabdoub <- as.double(c(setup$utiltabdoub, 0, 0))
	setup$utiltabdoub <- as.double(c(0, 0))
	setup$dvalcontrol[7 + 1] <- 1.0 # set new_trade_ave_tol
	setup$dvalcontrol[ndval + 8 + 1] <- 0 # set exit
	setup$sizecontrol[nsize + 16 + 1] <- 2 # set test.gen
	setup$sizecontrol[37 + 1] <- 1 # ignore utility only variances

	nalcomben <- setup$sizecontrol[23 + 1]
	nvarcomben <- setup$sizecontrol[24 + 1]
	ndest <- setup$sizecontrol[4 + 1]
	nrandByTrade <- number.rand * ntrade

	out <- .C("randport_BurSt", number.rand=as.integer(number.rand),
        	as.integer(setup$existid), as.double(setup$existing),
                as.double(setup$prices), as.integer(setup$tradeuniv),
                as.double(setup$lowupp), as.double(setup$variance),
                as.integer(setup$vartype), as.integer(setup$varoffset),
                as.integer(setup$nvarfactors), as.double(setup$expecret),
                as.integer(setup$benchid), cost=as.double(setup$cost), 
		as.double(setup$costpar),
                rand.id=integer(nrandByTrade + 6), 
		rand.shares=double(nrandByTrade + 6),
		as.double(setup$threshold),
                double(nalcomben + nvarcomben + ndest),
                constrainvec=as.double(setup$constrainvec),
                constrainlevels=as.integer(setup$constrainlevels), 
                lowconstrain=as.double(setup$lowconstrain),
                highconstrain=as.double(setup$highconstrain),
                penalty.constraint=as.double(setup$penaltyconstraint),
		constraint.violation=double(length(setup$penaltyconstraint)),
                constraintype=as.integer(setup$constraintype),
		linstyle=as.integer(setup$linstyle), 
		lindirection=as.integer(setup$lindirection),
		linrfmap=as.integer(setup$linrfmap),
                dest.wt=as.double(setup$destwt),
                as.integer(setup$sizecontrol), 
                as.integer(setup$startid), as.double(setup$startsol),
		as.integer(setup$forcedid), as.double(setup$forcedtrade),
		as.double(setup$rfracvec), as.integer(setup$rfstynum),
		as.integer(setup$rfracactive),
		as.double(setup$benchweights), as.integer(setup$benchwtid),
		as.integer(setup$rfvarid), as.integer(setup$rftab),
		rf=double(setup$sizecontrol[1] * setup$sizecontrol[53 + 1]),
		as.double(setup$distcenter), as.double(setup$distbounds),
		as.integer(setup$diststynum), as.integer(setup$distusenum),
		as.double(setup$distcoef), as.integer(setup$distcoefloc),
		as.double(setup$distscale),
                distval=integer(setup$sizecontrol[43 + 1]),
		utiltab.int=as.integer(setup$utiltabint), 
                alpha.table=as.integer(setup$alphatable),
                var.table=as.integer(setup$vartable),
                utiltab.doub=as.double(setup$utiltabdoub),
                as.double(setup$dvalcontrol), seed = as.integer(setup$seed),
                ioutput=integer(48), doutput=double(6), 
                version=character(1), 
		ezlicense=as.character(setup$ezlicense),
		iterhistory=double(setup$sizecontrol[nsize + 24+1]))[
		c("number.rand", "rand.id", "rand.shares", "version", 
		"ioutput", "doutput", "iterhistory")]

	errnum <- out$ioutput[8]
        if(abs(errnum) >= 1000 && errnum != 1002) {
		if(!setup$auxcontrol['throw.error'] && errnum == 1001) {
			if(!setup$sizecontrol[nsize+49+1]) {
				if(setup$dowarn["randport.failure"]) {
				   warning(paste("no suitable portfolios",
					"found -- perhaps the problem is",
					"impossible? ('do.warn' suppression is",
					"'randport.failure')"))
			   	}
				ans <- vector("list", 0)
				if(setup$auxcontrol["save.iterhistory"]) {
					attr(ans, "iterhistory") <- 
						out$iterhistory
				}
				attr(ans, "call") <- match.call()
				attr(ans, "timestamp") <- date()
				attr(ans, "seed") <- setup$seed
				attr(ans, "version") <- c(C.code=out$version, 
					S.code=fun.version)
				attr(ans, "funevals") <- out$doutput[6]
				class(ans) <- "randportBurSt"
				return(ans)
			} else {
				warning(paste("returning portfolio that",
					"breaks at least one constraint"))
			}
		} else {
		   initfail <- setup$sizecontrol[nsize + 1 + 51]
                   errmsg <- paste(
                        switch(as.character(errnum),
                        "1001" = paste("failure in the first", 
				if(initfail > 1) paste(initfail, "tries,") else
				"try,", "-- impossible problem?  violated:",
				paste(.unpack.violcode(out$ioutput[9]),
					collapse=", ")), 
                        "1002" = "too many failures in random.portfolio",
                        "1008" = "number traded is too small",
                        "1010" = "funeval.max <= 1 and no starting solution",
                        "1020" = "memory allocation failed",
                        "1023" = "bad constraint type",
                        "1025" = "bad variance type",
                        "1027" = "bad optimization type",
                        "1031" = "more than 'ntrade' traded",
                        "1075" = "need only full variance matrices (for corport, etc.)",
				"unspecified error"),
			" (error ", errnum, ")",
                        sep="")
                   stop(errmsg)
		}
        }
	number.real <- out$number.rand
	if(errnum == 1001 && setup$sizecontrol[nsize + 49 + 1]) {
		number.real <- 1
	}
	if(number.real == 0) {
		stop("no portfolios generated")
	}

	rand.nam <- matrix(setup$assetnam[out$rand.id[1:nrandByTrade] + 1], 
		ncol=number.rand)
	rand.shares <- matrix(out$rand.shares[1:nrandByTrade], ncol=number.rand)
	ans <- vector("list", number.real)

	existing <- setup$existing
	names(existing) <- existnam <- setup$assetnam[setup$existid + 1]
	existing <- existing[existing != 0]
	if(length(existing) == 0) out.trade <- TRUE

	zerolen <- 0
	sharetol <- setup$dvalcontrol[2 + 1]
	for(i in 1:number.real) {
		t.rp <- rand.shares[, i]
		names(t.rp) <- rand.nam[, i]
		t.rp <- t.rp[abs(t.rp) > sharetol]
		if(any(duplicated(names(t.rp)))) {
                	# in theory never happens, but best to check
			if(nchar(dumpfile)) {
				Mc <- match.call()
				writedump.BurSt(Mc, dumpfile)
			}
                	stop(paste("duplicates in trade (bug in C code)",
				"please email a report to",
				"support@portfolioprobe.com"))
        	}
		if(!out.trade) {
			t.rpn <- names(t.rp)
			t.un <- unique(c(t.rpn, existnam))
			t.rpt <- t.rp
			t.rp <- rep(0, length(t.un))
			names(t.rp) <- t.un
			t.rp[existnam] <- existing
			t.rp[t.rpn] <- t.rp[t.rpn] + t.rpt
			t.rp <- t.rp[abs(t.rp) > sharetol]
		}
		if(any(is.na(t.rp))) {
                	# in theory never happens, but best to check
			if(nchar(dumpfile)) {
				Mc <- match.call()
				writedump.BurSt(Mc, dumpfile)
			}
                	stop(paste("missing values in result (bug in C code)",
				"please email a report to",
				"support@portfolioprobe.com"))
        	}
		if(length(t.rp) == 0) {
			zerolen <- zerolen + 1
		} else {
			ans[[i]] <- t.rp
		}
	}
	if(setup$dowarn["randport.failure"]) {
		if(zerolen) {
			warning(paste(zerolen, 
				if(out.trade) "trade(s)" else "portfolio(s)",
				"empty out of", number.rand))
		} else if(number.real < number.rand) {
			warning(paste("only", number.real, 
				"portfolios generated while",
				number.rand, "requested"))
		}
	}
	if(setup$auxcontrol["save.iterhistory"]) {
		attr(ans, "iterhistory") <- out$iterhistory
	}
	attr(ans, "call") <- match.call()
	attr(ans, "seed") <- setup$seed
	attr(ans, "version") <- c(C.code=out$version, 
		S.code=fun.version)
	attr(ans, "checkinput") <- setup$checkinput
	attr(ans, "identity") <- identity
	attr(ans, "funevals") <- out$doutput[6]
	if(errnum == 1001 && setup$sizecontrol[nsize + 49 + 1]) {
		attr(ans, "violation") <- TRUE
	}
	attr(ans, "timestamp") <- c(startstamp, date())
	class(ans) <- "randportBurSt"
	ans
}

"seed.BurSt" <-
function (n=NULL) 
{
        fun.copyright <- "Copyright 2003-2007  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "seed.BurSt 004"

	if(length(n)) set.seed(n)
	c(1, round(runif(624, -2147483647,  2147483647)))
}

"summary.portfolBurSt" <-
function (object, prices=object$prices, ...) 
{
        fun.copyright <- "Copyright 2003-2010  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "summary.portfolBurSt 008"

	if(length(prices)) {
		val.new <- valuation(object, prices, trade=FALSE)$total
		val.trad <- valuation(object, prices, trade=TRUE)$total
	} else {
		val.new <- val.trad <- NULL
	}

	new.nam <- names(object$new.portfolio)
	trad.nam <- names(object$trade)
	exist.nam <- names(object$existing)

	open <- setdiff(new.nam, exist.nam)
	close <- setdiff(exist.nam, new.nam)
	num.assets <- c(existing=length(exist.nam), trade=length(trad.nam),
		new=length(new.nam), open=length(open), close=length(close),
		object$universe.size)

	ans <- list(results=object$results, 
		objective.utility=object$objective.utility, 
		alpha.values=object$alpha.values, 
		var.values=object$var.values, number.of.assets=num.assets, 
		opening.positions=open, closing.positions=close)
	if(length(val.new)) {
		ans$value.limits <- object$value.limits
		ans$valuation.new.portfolio <- val.new
		ans$valuation.trade <- val.trad
		ans$valuation.trade.fraction.of.gross <- val.trad / val.new[1]
	}
	if(length(object$violated)) {
		ans$violated <- object$violated
	}
	if(length(object$con.realized)) {
		ans$constraints.realized <- object$con.realized
		if(length(ans$constraints.realized$linear)) {
			ans$lintable <- object$lintable
		}
		if(length(ans$constraints.realized$distance)) {
			ans$dist.style <- object$dist.style
			ans$dist.trade <- object$dist.trade
			ans$dist.utility <- object$dist.utility
		}
	}
	ans
}

"summary.randportBurSt" <-
function (object, ...) 
{
        fun.copyright <- "Copyright 2003-2005  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "summary.randportBurSt 002"

	list(port.size=table(unlist(lapply(object, length))),
		count.assets=rev(sort(rev(table(unlist(lapply(object, 
		names)))))))
}
"valuation.default" <-
function (x, prices, weight=TRUE, collapse=is.array(prices), 
	type="gross", cash=NULL, all.assets=FALSE, returns=NULL)
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "valuation.default 008"

	if(!length(prices)) stop("no prices")
	if(is.data.frame(prices)) prices <- as.matrix(prices)
	if(is.integer(prices)) mode(prices) <- "numeric"
	ldp <- length(dim(prices))
	if(ldp == 2 || ldp == 3) {
		pricenam <- dimnames(prices)[[2]]
	} else if(ldp == 1) {
		pricenam <- dimnames(prices)[[1]]
		prices <- as.vector(prices)
	} else if(ldp > 3) {
		stop(paste("'prices' is an array with", ldp, "dimensions",
			"-- expecting no more than 3 dimensions"))
	} else {
		pricenam <- names(prices)
	}
	if(!is.numeric(prices)) {
		stop(paste("'prices' is not numeric -- expecting",
			"a numeric vector, matrix or 3D array",
			" with names, given has mode",
			mode(prices), "length", length(prices),
			"and number of dimensions", ldp))
	}
	if(!length(pricenam)) stop("no asset names on 'prices'")
	if(any(duplicated(pricenam))) {
		stop(paste(sum(duplicated(pricenam)), "duplicated name(s)",
			"in 'prices'"))
	}

        if(length(returns)) {
                if(length(returns) != 1 || !is.character(returns)) {
                        stop(paste("bad value given for 'returns':",
                                "when given should be a single character",
                                "string -- given has mode", mode(returns),
                                "and length", length(returns)))
                } 
		if(ldp == 1) {
			stop(paste("'prices' needs to be a matrix or array",
				"when returns are requested"))
		}
		if(nrow(prices) == 1) {
			stop(paste("'prices' needs to have more than one",
				"time when returns are requested"))
		}
                returns.menu <- c("simple", "log", "arithmetic", "geometric")
                returns.num <- pmatch(returns, returns.menu, nomatch=0)
                if(returns.num == 0) {
                        stop(paste("unknown or ambiguous value for 'returns'",
                                "-- valid values are:", paste(returns.menu,
                                collapse=", ")))
                } 
                returns <- returns.menu[returns.num]
                collapse <- TRUE
                type <- "nav"
        }

	outnam <- setdiff(names(x), pricenam)
	if(length(outnam)) {
		lenout <- length(outnam)
		if(lenout == length(x)) {
			stop("no prices for any of the assets in 'x'")
		} else if(lenout < 6) {
			if(collapse || all.assets) {
				stop(paste("no price for asset(s):",
					paste(outnam, collapse=", ")))
			} else {
				warning(paste("no price for asset(s):",
					paste(outnam, collapse=", ")))
			}
		} else {
			if(collapse || all.assets) {
				stop(paste(lenout, "assets without prices,",
					"the first few are:",
					paste(outnam[1:5], collapse=", ")))
			} else {
				warning(paste(lenout, "assets without prices,",
					"the first few are:",
					paste(outnam[1:5], collapse=", ")))
			}
		}
	}
	if(all.assets && !collapse) {
		if(length(x) < length(pricenam)) {
			x.given <- x
			x <- rep(0, length(pricenam))
			names(x) <- pricenam
			x[names(x.given)] <- x.given
		}
	}

	if(collapse) {
        	type.menu <- c("gross", "net", "long", "short", "nav")
        	type.num <- pmatch(type, type.menu, nomatch=0)
        	if(type.num == 0) {
                	stop(paste("unknown or ambiguous value for 'type' (",
                        	type, ") -- allowable values are: ",
                        	paste(type.menu, collapse=", "), sep=""))
        	}
        	type <- type.menu[type.num]
		if(ldp < 2) prices <- rbind(prices)
		if(ldp == 3) {
			nrp <- dim(prices)[1]
			nsim <- dim(prices)[3]
			prices <- prices[, names(x), , drop=FALSE]
			ldate <- nrp < nsim
			ans <- array(NA, dim(prices)[-2], dimnames(prices)[-2])
			if(ldate) {
				fseq <- 1:nrp
			} else {
				fseq <- 1:nsim
			}
		} else {
			prices <- prices[, names(x), drop=FALSE]
		}
		switch(type,
		  gross={
			if(ldp == 3) {
				if(ldate) {
					for(i in fseq) {
						ans[i,] <- abs(x) %*% 
							prices[i,,]
					}
				} else {
					for(i in fseq) {
						ans[,i] <- prices[,,i] %*%
							abs(x)
					}
				}
			} else {
				ans <- drop(prices %*% abs(x))
			}
		  },
		  net={
			if(ldp == 3) {
				if(ldate) {
					for(i in fseq) {
						ans[i,] <- x %*% prices[i,,]
					}
				} else {
					for(i in fseq) {
						ans[,i] <- prices[,,i] %*% x
					}
				}
			} else {
				ans <- drop(prices %*% x)
			}
		  },
		  long={
			if(ldp == 3) {
				if(ldate) {
					for(i in fseq) {
						ans[i,] <- pmax(x, 0) %*% 
							prices[i,,]
					}
				} else {
					for(i in fseq) {
						ans[,i] <- prices[,,i] %*%
							pmax(x, 0)
					}
				}
			} else {
				ans <- drop(prices %*% pmax(x, 0))
			}
		  },
		  short={
			if(ldp == 3) {
				if(ldate) {
					for(i in fseq) {
						ans[i,] <- pmax(-x, 0) %*% 
							prices[i,,]
					}
				} else {
					for(i in fseq) {
						ans[,i] <- prices[,,i] %*%
							pmax(-x, 0)
					}
				}
			} else {
				ans <- drop(prices %*% pmax(-x, 0))
			}
		  },
		  nav={
			cashlen <- length(cash)
			cashmat <- ldp == 3 && is.matrix(cash) && nrow(cash) == 
				nrp && ncol(cash) == nsim
			if(cashlen == 0) {
				if(ldp == 3) {
					cash <- (abs(x) - x) %*% prices[1,,]
					cash <- matrix(cash, nrp, nsim, 
						byrow=TRUE)
				} else {
					cash <- drop(prices[1,,drop=FALSE] %*% 
						(abs(x) - x))
				}
			} else if(!cashmat && cashlen != 1 && cashlen != 
					nrow(prices)) {
				if(nrow(prices) == 1) {
					stop(paste("'cash' has length", cashlen,
					  "should have length 1"))
				} else {
					stop(paste("'cash' has length", cashlen,
					  "should have length 1 or",
					  nrow(prices)))
				}
			} else if(!is.numeric(cash)) {
				if(nrow(prices) == 1) {
					stop(paste("'cash' has mode", mode(cash),
					  "and length", cashlen, "if given",
					  "should be numeric with length 1"))
				} else {
					stop(paste("'cash' has mode", mode(cash),
					  "and length", cashlen, "if given",
					  "should be numeric with length 1 or",
					  nrow(prices)))
				}
			}
			if(ldp == 3) {
				if(ldate) {
					for(i in fseq) {
						ans[i,] <- x %*% prices[i,,]
					}
				} else {
					for(i in fseq) {
						ans[,i] <- prices[,,i] %*% x
					}
				}
				ans <- ans + cash
			} else {
				ans <- rowSums(prices %*% x) + cash
			}
		  }
		)
		if(length(returns)) {
			switch(returns,
			   simple=,
			   arithmetic={
				if(ldp==2) {
					ans <- ans[-1] / ans[-length(ans)] - 1
				} else {
					ans <- ans[-1,] / ans[-nrow(ans),] - 1
				}
			   },
			   log=,
			   geometric={
				ans <- diff(log(ans))
			   }
			)
		}
		attr(ans, "timestamp") <- date()
		attr(ans, "call") <- match.call()
	} else {
		if(ldp > 1) {
			stop(paste("'prices' is a matrix or array",
				"and 'collapse' is",
				"FALSE -- this combination is not allowed"))
		} else if(ldp == 1) {
			prices <- drop(prices)
		}
		individual <- x * prices[names(x)]
		long <- sum(individual[individual > 0])
		short <- -sum(individual[individual < 0])
		total <- c(gross=long+short, net=long-short, long=long, 
			short=short)
		ans <- list(individual=individual, total=total)
		if(weight) {
			ans$weight <- ans$individual / (long + short)
		}
		ans$timestamp <- date()
		ans$call <- match.call()
	}
	ans
}

"valuation.portfolBurSt" <-
function (x, prices=x$prices, trade=FALSE, weight=TRUE, 
	collapse=is.array(prices), type="gross", cash=NULL, all.assets=FALSE,
	returns=NULL)
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "valuation.portfolBurSt 007"

	if(!length(prices)) stop("no prices")

	if(is.data.frame(prices)) prices <- as.matrix(prices)
	storage.mode(prices) <- "numeric"

	if(length(returns)) {
		if(length(returns) != 1 || !is.character(returns)) {
			stop(paste("bad value given for 'returns':",
				"when given should be a single character",
				"string -- given has mode", mode(returns),
				"and length", length(returns)))
		}
		returns.menu <- c("simple", "log", "arithmetic", "geometric")
		returns.num <- pmatch(returns, returns.menu, nomatch=0)
		if(returns.num == 0) {
			stop(paste("unknown or ambiguous value for 'returns'",
				"-- valid values are:", paste(returns.menu,
				collapse=", ")))
		}
		returns <- returns.menu[returns.num]
		collapse <- TRUE
		type <- "nav"
	}

	if(trade) {
		assets <- x$trade
	} else {
		assets <- x$new.portfolio
	}

	if(collapse) {
		ans <- valuation.default(assets, prices, collapse=TRUE,
			type=type, cash=cash, all.assets=all.assets,
			returns=returns)
		attr(ans, "call") <- match.call()
	} else {
		if(is.matrix(prices)) {
			stop(paste("'prices' is a matrix and 'collapse' is",
				"FALSE -- this combination is not allowed"))
		}
		if(any(duplicated(names(prices)))) {
			stop(paste(sum(duplicated(names(prices))),
				"duplicated name(s) in 'prices'"))
		}
		if(all.assets) {
			assets.given <- assets
			assets <- rep(0, length(prices))
			names(assets) <- names(prices)
			assets[names(assets.given)] <- assets.given
		}
		individual <- assets * prices[names(assets)]
		long <- sum(individual[individual > 0])
		short <- -sum(individual[individual < 0])
		total <- c(gross=long+short, net=long-short, long=long, 
			short=short)
		ans <- list(individual=individual, total=total)
		if(weight) {
			ans$weight <- ans$individual / (long + short)
		}
		ans$timestamp <- date()
		ans$call <- match.call()
	}
	ans
}

"valuation" <-
function (x, ...) UseMethod("valuation")
"valuation.randportBurSt" <-
function (x, prices, weight=FALSE, collapse=is.array(prices), type="gross", 
	cash=NULL, all.assets=FALSE, returns=NULL)
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "valuation.randportBurSt 005"

	if(!length(prices)) stop("no prices")

	if(is.data.frame(prices)) prices <- as.matrix(prices)
	ldp <- length(dim(prices))
	if (ldp == 2 || ldp == 3) {
		pnams <- dimnames(prices)[[2]]
		nrp <- dim(prices)[1]
		if(ldp == 3) {
			nsim <- dim(prices)[3]
		}
	} else if(ldp == 1) {
		pnams <- dimnames(prices)[[1]]
	} else if(ldp > 3) {
		stop(paste("prices is an array of dimension", ldp,
			"-- expecting no more than 3 dimensions"))
	} else {
		pnams <- names(prices)
	}
	if(!is.numeric(prices)) {
		stop(paste("'prices' should be a numeric vector, matrix or",
			"3D array -- given has mode", mode(prices),
			"length", length(prices), "and number of dimensions",
			ldp))
	}
	if(is.integer(prices)) mode(prices) <- "numeric"
	if(!length(pnams)) {
		stop("no asset names on 'prices'")
	}
	if(any(duplicated(pnams))) {
		stop(paste(sum(duplicated(pnams)), "duplicate asset name(s)"))
	}

	allnam <- unique(unlist(lapply(x, names)))
	inam <- intersect(allnam, pnams)
	if(length(inam) < length(allnam)) {
		stop(paste(length(allnam) - length(inam), 
			"asset(s) not in prices"))
	}
	storage.mode(prices) <- "double"
	xseq <- seq(along = x)

        if(length(returns)) {
                if(length(returns) != 1 || !is.character(returns)) {
                        stop(paste("bad value given for 'returns':",
                                "when given should be a single character",
                                "string -- given has mode", mode(returns),
                                "and length", length(returns)))
                }
                if(ldp == 1) {
                        stop(paste("'prices' needs to be a matrix or array",
                                "when returns are requested"))
                }
                if(nrow(prices) == 1) {
                        stop(paste("'prices' needs to have more than one",
                                "time when returns are requested"))
                }
                returns.menu <- c("simple", "log", "arithmetic", "geometric")
                returns.num <- pmatch(returns, returns.menu, nomatch=0)
                if(returns.num == 0) {
                        stop(paste("unknown or ambiguous value for 'returns'",
                                "-- valid values are:", paste(returns.menu,
                                collapse=", ")))
                }
                returns <- returns.menu[returns.num]
                collapse <- TRUE
                type <- "nav"
        }

      if(collapse) {
	if(!is.character(type) || length(type) != 1) {
		stop(paste("'type' must be a single character string",
			"-- given has mode", mode(type), "and length",
			length(type)))
	}
	type.menu <- c("gross", "net", "long", "short", "nav")
	type.num <- pmatch(type, type.menu, nomatch=0)
	if(type.num == 0) {
		stop(paste("unknown or ambiguous value for 'type' (",
			type, ") -- allowable values are: ",
			paste(type.menu, collapse=", "), sep=""))
	}
	type <- type.menu[type.num]
	if(ldp == 2) {
		ans <- array(0, c(nrow(prices), length(x)), 
			list(dimnames(prices)[[1]], NULL))
	} else if(ldp == 3) {
		ans <- array(0, c(nrow(prices), length(x), nsim), 
			list(dimnames(prices)[[1]], NULL, dimnames(prices)[[3]]))
		sseq <- 1:nsim
	} else {
		ans <- numeric(length(x))
	}
	if(weight) {
		if(type != "gross" && type != "net") {
			stop(paste("when 'weight' is TRUE, 'type' must be",
				"either 'gross' or 'net' -- given value is",
				type))
		}
		gross <- type == "gross"
		if(ldp == 2) {
			for(i in xseq) {
				t.x <- x[[i]]
				t.x <- prices[, names(t.x), drop=FALSE] * 
					rep(t.x, each=nrp)
				if(gross) {
					ans[,i] <- rowSums(abs(t.x / 
						rowSums(abs(t.x))))
				} else {
					ans[,i] <- rowSums(t.x / 
						rowSums(abs(t.x)))
				}
			}
		} else if(ldp == 3) {
		   for(j in sseq) {
			for(i in xseq) {
				t.x <- x[[i]]
				t.x <- prices[, names(t.x), drop=FALSE] * 
					rep(t.x, each=nrp)
				if(gross) {
					ans[,i, j] <- rowSums(abs(t.x / 
						rowSums(abs(t.x))))
				} else {
					ans[,i, j] <- rowSums(t.x / 
						rowSums(abs(t.x)))
				}
			}
		   }
		} else {
			for(i in xseq) {
				t.x <- x[[i]]
				t.x <- t.x * prices[names(t.x)]
				if(gross) {
					ans[i] <- sum(abs(t.x / sum(abs(t.x))))
				} else {
					ans[i] <- sum(t.x / sum(abs(t.x)))
				}
			}
		}
	} else {
		if(ldp == 2) {
			switch(type,
			  gross = {
				for(i in xseq) {
					t.x <- x[[i]]
					if(!length(t.x)) {
						ans[,i] <- 0
						next
					}
					ans[,i] <- rowSums(abs(prices[, 
						names(t.x), drop=FALSE] * 
						rep(t.x, each=nrp)))
				}
			  }, 
			  net = {
				for(i in xseq) {
					t.x <- x[[i]]
					if(!length(t.x)) {
						ans[,i] <- 0
						next
					}
					ans[,i] <- rowSums(prices[, 
						names(t.x), drop=FALSE] * 
						rep(t.x, each=nrp))
				}
			  }, 
			  long = {
				for(i in xseq) {
					t.x <- x[[i]]
					t.x <- t.x[t.x > 0]
					if(!length(t.x)) {
						ans[,i] <- 0
						next
					}
					ans[,i] <- rowSums(prices[, 
						names(t.x), drop=FALSE] * 
						rep(t.x, each=nrp))
				}
			  }, 
			  short = {
				for(i in xseq) {
					t.x <- x[[i]]
					t.x <- -t.x[t.x < 0]
					if(!length(t.x)) {
						ans[,i] <- 0
						next
					}
					ans[,i] <- rowSums(prices[, 
						names(t.x), drop=FALSE] * 
						rep(t.x, each=nrp))
				}
			  },
			  nav = {
				if(is.numeric(cash)) {
					if(length(cash) != 1 && length(cash)
							!= nrp) {
						stop(paste("'cash' must be ",
						  "NULL, a single number, or",
						  " a numeric vector with ",
						  "length equal to the number",
						  " of rows in 'prices' (",
						  nrp, ") -- given has ",
						  "length ", length(cash),
						  sep=""))
					}
					cash.is.grossm <- FALSE
				} else if(is.null(cash)) {
					cash.is.grossm <- TRUE
				} else {
					stop(paste("'cash' must be NULL,",
						"a single number or a numeric",
						"vector with length equal to",
						"the number of rows in",
						"'prices' -- given has mode",
						mode(cash), "and length",
						length(cash)))
				}
				for(i in xseq) {
					t.x <- x[[i]]
					if(cash.is.grossm) {
						cash <- sum((abs(t.x) - t.x) *
							prices[1, names(t.x)])
					}
					if(!length(t.x)) {
						ans[,i] <- cash
						next
					}
					ans[,i] <- rowSums(prices[, 
						names(t.x), drop=FALSE] * 
						rep(t.x, each=nrp)) + cash
				}
			  }
			)
		} else if(ldp == 3) {
			switch(type,
			  gross = {
			    for(i in xseq) {
				t.x <- x[[i]]
				if(!length(t.x)) {
					ans[,i,] <- 0
					next
				}
			    	for(j in sseq) {
					ans[,i,j] <- rowSums(abs(prices[, 
						names(t.x), j, drop=FALSE] * 
						rep(t.x, each=nrp)))
				}
			     }
			  }, 
			  net = {
			    for(i in xseq) {
				t.x <- x[[i]]
				if(!length(t.x)) {
					ans[,i] <- 0
					next
				}
			    	for(j in sseq) {
					ans[,i,j] <- rowSums(prices[, 
						names(t.x), j, drop=FALSE] * 
						rep(t.x, each=nrp))
				}
			     }
			  }, 
			  long = {
			      for(i in xseq) {
				t.x <- x[[i]]
				t.x <- t.x[t.x > 0]
				if(!length(t.x)) {
					ans[,i] <- 0
					next
				}
			    	for(j in sseq) {
					ans[,i,j] <- rowSums(prices[, 
						names(t.x), j, drop=FALSE] * 
						rep(t.x, each=nrp))
				}
			     }
			  }, 
			  short = {
			      for(i in xseq) {
				t.x <- x[[i]]
				t.x <- -t.x[t.x < 0]
				if(!length(t.x)) {
					ans[,i] <- 0
					next
				}
			    	for(j in sseq) {
					ans[,i,j] <- rowSums(prices[, 
						names(t.x), j, drop=FALSE] * 
						rep(t.x, each=nrp))
				}
			     }
			  },
			  nav = {
				cashmat <- FALSE
				if(is.numeric(cash)) {
					if(length(cash) != 1 && length(cash)
						  != nrp && (is.matrix(cash) && 
						  any(dim(cash) != 
						  c(nrp, nsim)))) {
						stop(paste("'cash' must be ",
						  "NULL, a single number, or",
						  " a numeric vector with ",
						  "length equal to the number",
						  " of rows in 'prices' (",
						  nrp, ") -- given has ",
						  "length ", length(cash),
						  sep=""))
					}
					cash.is.grossm <- FALSE
					if(is.matrix(cash) && all(dim(cash) == 
							c(nrp, nsim))) {
						cashmat <- TRUE
					}
				} else if(is.null(cash)) {
					cash.is.grossm <- TRUE
				} else {
					stop(paste("'cash' must be NULL,",
						"a single number, a numeric",
						"vector with length equal to",
						"the number of rows in",
						"'prices' or a numeric matrix",
						"number of rows of prices by",
						"the number of slices -- given",
						"has mode", mode(cash), 
						"and length", length(cash)))
				}
				if(!cash.is.grossm && !cashmat) tcash <- cash
				for(i in xseq) {
					t.x <- x[[i]]
					if(!length(t.x)) {
						if(cashmat) {
							ans[,i,] <- cash
						} else if(cash.is.grossm) {
							ans[,i,] <- 0
						} else {
							ans[,i,] <- tcash
						}
						next
					}
			    		for(j in sseq) {
					   if(cash.is.grossm) {
						tcash <- sum((abs(t.x) - t.x) *
							prices[1, names(t.x),j])
					   } else if(cashmat) {
						tcash <- cash[,j]
					   }
					   ans[,i,j] <- rowSums(prices[, 
						names(t.x), j, drop=FALSE] * 
						rep(t.x, each=nrp)) + tcash
					}
				}
			  }
			)
		} else {
			# prices is a vector
			switch(type,
			  gross = {
				for(i in xseq) {
					t.x <- x[[i]]
					ans[i] <- sum(abs(t.x) * 
						prices[names(t.x)])
				}
			  },
			  net = {
				for(i in xseq) {
					t.x <- x[[i]]
					ans[i] <- sum(t.x * prices[names(t.x)])
				}
			  },
			  long = {
				for(i in xseq) {
					t.x <- x[[i]]
					t.x <- t.x[t.x > 0]
					ans[i] <- sum(t.x * prices[names(t.x)])
				}
			  }, 
			  short = {
				for(i in xseq) {
					t.x <- x[[i]]
					t.x <- -t.x[t.x < 0]
					ans[i] <- sum(t.x * prices[names(t.x)])
				}
			  },
			  nav = {
				if(is.numeric(cash)) {
					if(length(cash) != 1) {
						stop(paste("'cash' must be ",
						  "NULL, a single number, or",
						  " a numeric vector with ",
						  "length equal to the number",
						  " of rows in 'prices'",
						  " -- given has ",
						  "length ", length(cash),
						  sep=""))
					}
					cash.is.grossm <- FALSE
				} else if(is.null(cash)) {
					cash.is.grossm <- TRUE
				} else {
					stop(paste("'cash' must be NULL,",
						"a single number or a numeric",
						"vector with length equal to",
						"the number of rows in",
						"'prices' -- given has mode",
						mode(cash), "and length",
						length(cash)))
				}
				for(i in xseq) {
					t.x <- x[[i]]
					if(cash.is.grossm) {
						cash <- sum((abs(t.x) - t.x) *
							prices[names(t.x)])
					}
					ans[i] <- sum(t.x * 
						prices[names(t.x)]) + cash
				}
			  }
			)
		}
	}
	if(length(returns)) {
		switch(returns,
		   simple=,
		   arithmetic={
     			if(ldp==2) {
             			ans <- ans[-1,] / ans[-nrow(ans),] - 1
     			} else {
             			ans <- ans[-1,,,drop=FALSE] / 
					ans[-nrow(ans),,,drop=FALSE] - 1
     			}
		   },
		   log=,
	   	   geometric={
     			if(ldp==3) {
				x <- ans[-1,,, drop=FALSE]
				for(j in sseq) {
					x[,,j] <- diff(log(ans[,,j]))
				}
				ans <- x
     			} else {
				ans <- diff(log(ans))
     			}
		   }
		)
	}
	x <- ans
	ansat <- attributes(ans)
     } else {
	# not collapse
	if(ldp == 3) {
		stop("'collapse' must be TRUE when 'prices' is 3-dimensional")
	}
	if(weight) {
	   if(all.assets) {
		if(ldp == 2) {
			t.x <- prices[1,]
			for(i in xseq) {
				t.x[] <- 0
				t.x[names(x[[i]])] <- x[[i]]
				t.a <- prices[, names(t.x), drop=FALSE] * 
					rep(t.x, each=nrp)
				x[[i]] <- t.a / rowSums(abs(t.a))
			}
		} else {
			t.x <- prices
			for(i in xseq) {
				t.x[] <- 0
				t.x[names(x[[i]])] <- x[[i]]
				t.x <- t.x * prices[names(t.x)]
				x[[i]] <- t.x / sum(abs(t.x))
			}
		}
	    } else {
		# weight, not all.assets
		if(ldp == 2) {
			for(i in xseq) {
				t.x <- x[[i]]
				t.x <- prices[, names(t.x), drop=FALSE] * 
					rep(t.x, each=nrp)
				x[[i]] <- t.x / rowSums(abs(t.x))
			}
		} else {
			for(i in xseq) {
				t.x <- x[[i]]
				t.x <- t.x * prices[names(t.x)]
				x[[i]] <- t.x / sum(abs(t.x))
			}
		}
	    }
	} else {
		# not weight
	   if(all.assets) {
		if(ldp == 2) {
			t.x <- prices[1,]
			for(i in xseq) {
				t.x[] <- 0
				t.x[names(x[[i]])] <- x[[i]]
				x[[i]] <- prices * rep(t.x, each=nrp)
			}
		} else {
			t.x <- prices
			for(i in xseq) {
				t.x[] <- 0
				t.x[names(x[[i]])] <- x[[i]]
				x[[i]] <- t.x * prices
			}
		}
	    } else {
		# not weight, not all.assets
		if(ldp == 2) {
			for(i in xseq) {
				t.x <- x[[i]]
				x[[i]] <- prices[, names(t.x), drop=FALSE] *
					rep(t.x, each=nrp)
			}
		} else {
			for(i in xseq) {
				t.x <- x[[i]]
				x[[i]] <- t.x * prices[names(t.x)]
			}
		}
	    }
	}
	ansat <- NULL
      }

	attributes(x) <- c(ansat, list(timestamp=date(), call=match.call()))
	x
}

"tail.randportBurSt" <-
function (x, n=6, ...) 
{
	fun.copyright <- "Copyright 2009 Burns Statistics Ltd.  All rights reserved."
	fun.version <- "tail.randportBurSt 001"
	xat <- attributes(x)
	ans <- tail(unclass(x), n=n)
	xat$funevals <- NA
	attributes(ans) <- xat
	ans
}

"random.portfolio.control" <-
function (iterations.max = 20, miniter = 5, fail.iter = 5, gen.fail = 4, 
    init.fail = 4, throw.error = TRUE, lockcon = FALSE, enforce.max.weight = TRUE, 
    doubleconst = NA, force.risk.aver = FALSE, trace = FALSE, 
    save.iterhistory = FALSE, funeval.max = .Machine$integer.max, 
    runs.init = 1, runs.final = 0, stringency = 0, runs.min = 1, 
    nonconverge.mult = 1, feasible = 0, safe.mode = TRUE, ...) 
{
    fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
    fun.version <- "random.portfolio.control 013"
    big <- 1e+100
    if(funeval.max == Inf) funeval.max <- .Machine$integer.max
	if(!is.na(doubleconst)) {
		warning("'doubleconst' no longer used -- now always FALSE")
		doubleconst <- FALSE
	} else {
		doubleconst <- FALSE
	}

    icon <- c(npar = NA, icon01 = 10, icon02 = 1000, icon03 = 8000, 
        icon04 = 3, icon05 = 20, icon06 = 20, icon07 = 1, funeval.max = funeval.max, 
        popgiven = NA, gen.fail = gen.fail, trace = trace, icon12 = 0, 
        icon13 = 2, icon14 = 2, icon15 = 200, icon16 = 500, icon17 = 1000, 
        icon18 = 1, icon19 = 5000, icon20 = 2, icon21 = 10, icon22 = 0, 
        icon23 = 3, iterations.max = iterations.max, icon25 = 2, 
        icon26 = 700, icon27 = 0, icon28 = 2, icon29 = 1700, 
        icon30 = 4, icon31 = 1001, icon32 = 2, fail.iter = fail.iter, 
        icon34 = 0, icon35 = 5, icon36 = 1e+09, icon37 = 500, 
        icon38 = 1, icon39 = 6, icon40 = -1, icon41 = 0, runs.init = runs.init, 
        runs.final = runs.final, stringency = stringency, icon45 = 0, 
        runs.min = runs.min, nonconverge.mult = nonconverge.mult, 
        feasible = feasible, icon49 = 0, icon50 = 0, init.fail = init.fail, 
        lockcon = FALSE, icon53 = 10, miniter = miniter, icon55 = 12, 
        icon56 = 10, icon57 = 16, icon58 = 90, icon59 = 11, icon60 = 2, 
        icon61 = 0, icon62 = 9, icon63 = 1, icon64 = 2, icon65 = 20000, 
        icon66 = 0, icon67 = 30, icon68 = 1, icon69 = 20, icon70 = 14, 
        icon71 = 50, icon72 = 5, icon73 = 15, icon74 = 4, icon75 = 3, 
        icon76 = 3, icon77 = 6300, icon78 = 800, icon79 = 1300, 
        icon80 = 900, icon81 = 6, icon82 = 22, icon83 = 14, icon84 = 7, 
        icon85 = 0, icon86 = 4, icon87 = 18, icon88 = 680, icon89 = 80, 
        icon90 = 50, icon91 = 40, icon92 = 4500, icon93 = 2000, 
        icon94 = 500, icon95 = 400, icon96 = 5400, icon97 = 1500, 
        icon98 = 800, icon99 = 650, icon100 = 17000, icon101 = 3000, 
        icon102 = 800, icon103 = 600, icon104 = 8, icon105 = 600, 
        icon106 = 6500, icon107 = 2200, icon108 = 400, icon109 = 1500, 
        icon110 = 2, icon111 = 30, icon112 = 50, icon113 = 100, 
        icon114 = 3, icon115 = 3, icon116 = 10, icon117 = 32, 
        icon118 = 20, icon119 = 30, icon120 = 25, icon121 = 1, 
        icon122 = 1, icon123 = 20, icon124 = 4, icon125 = 3, 
        icon126 = 500, icon127 = 8, icon128 = 20, icon129 = 4, 
        icon130 = 1, icon131 = 26, icon132 = 1, icon133 = 65, 
        icon134 = 30, icon135 = 21, icon136 = 14, icon137 = 150, 
        icon138 = 2000, icon139 = 10, icon140 = 100, icon141 = 50, 
        icon142 = 2000, icon143 = 0, icon144 = 600, icon145 = 600, 
        icon146 = 19, icon147 = 34, icon148 = 10, icon149 = 2, 
        icon150 = 14, icon151 = 1000, icon152 = 7000, icon153 = 1500, 
        icon154 = 350, icon155 = 3, icon156 = 2, icon157 = 1, 
        icon158 = 14, icon159 = 100, icon160 = 200, icon161 = 350, 
        icon162 = 3000, icon163 = 40, icon164 = 670, icon165 = 1, 
        icon166 = 6, icon167 = 13, icon168 = 2000, icon169 = 2000, 
        icon170 = 500, icon171 = 400, icon172 = 500, icon173 = 250, 
        icon174 = 300, icon175 = 2000, icon176 = 1000, icon177 = 200, 
        icon178 = 200, icon179 = 3, icon180 = 3, icon181 = 14, 
        icon182 = 15, icon183 = 3, icon184 = 1, icon185 = 0, 
        icon186 = 10, icon187 = 20, icon188 = 5, icon189 = 3, 
        icon190 = 500, icon191 = 50, icon192 = 2000, icon193 = 1000, 
        icon194 = 2000, icon195 = 4000, icon196 = 150, icon197 = 100, 
        icon198 = 500, icon199 = 1000, icon200 = 2000, icon201 = 7000, 
        icon202 = 2000, icon203 = 1200, icon204 = 5500, icon205 = 2000, 
        icon206 = 2500, icon207 = 5000, icon208 = 2400, icon209 = 3000, 
        icon210 = 3500, icon211 = 1800, icon212 = 3300, icon213 = 8, 
        icon214 = 20, icon215 = 50, icon216 = 4000, icon217 = 500, 
        icon218 = 4, icon219 = 5, icon220 = 499, icon221 = 1000, 
        icon222 = 5, icon223 = 3, icon224 = 4000, icon225 = 2000, 
        icon226 = 2000, icon227 = 3000, icon228 = 10, icon229 = 5, 
        icon230 = 10, icon231 = 10, icon232 = 10, icon233 = 4, 
        icon234 = 0, icon235 = 0, icon236 = 3, icon237 = 4, icon238 = 2500, 
        icon239 = 2000, icon240 = 3200, icon241 = 2000, icon242 = 850, 
        icon243 = 3000, icon244 = 400, icon245 = 152, icon246 = 1, 
        icon247 = 35, icon248 = 4, icon249 = 5, icon250 = 200, 
        icon251 = 100, icon252 = 3, icon253 = 3, icon254 = 0, 
        icon255 = 0, icon256 = 0, icon257 = 0, icon258 = 13, 
        icon259 = 10, icon260 = 12, icon261 = 10, icon262 = 4, 
        icon263 = 10, icon264 = 0, icon265 = 0, icon266 = 0, 
        icon267 = 0, icon268 = 0, icon269 = 0, icon270 = 0, icon271 = 3, 
        icon272 = 3, icon273 = 3, icon274 = 9, icon275 = 300, 
        icon276 = 90, icon277 = 100, icon278 = 100, icon279 = 1000, 
        icon280 = 3000, icon281 = 100, icon282 = 200, icon283 = 3, 
        icon284 = 3, icon285 = 1000, icon286 = 2000, icon287 = 300, 
        icon288 = 200, icon289 = 4, icon290 = 3, icon291 = 1, 
        icon292 = 800, icon293 = 0, icon294 = 0, icon295 = 0, 
        icon296 = 8, icon297 = 2, icon298 = 8, icon299 = 7, icon300 = 120, 
        icon301 = 0, icon302 = 0, icon303 = 0, icon304 = 20, 
        icon305 = 230, icon306 = 11, icon307 = 9, icon308 = 15, 
        icon309 = 18, icon310 = 3, icon311 = 4, icon312 = 1, 
        icon313 = 12, icon314 = 70000, icon315 = 5000, icon316 = 10, 
        icon317 = 20000, icon318 = 5000, icon319 = 1, icon320 = 65000, 
        icon321 = 50, icon322 = 44, icon323 = 50000, icon324 = 700, 
        icon325 = 3, icon326 = 6, icon327 = 4, icon328 = 0, icon329 = 1, 
        icon330 = 35, icon331 = 6, icon332 = 3, icon333 = 2, 
        icon334 = 6, icon335 = 10, icon336 = 2, icon337 = 2, 
        icon338 = 100, icon339 = 15, icon340 = 600, icon341 = 50, 
        icon342 = 12, icon343 = 700, icon344 = 22, icon345 = 600, 
        icon346 = 300, icon347 = 3, icon348 = 20, icon349 = 25, 
        icon350 = 29, icon351 = 20, icon352 = 12, icon353 = 5, 
        icon354 = 75, icon355 = 170, icon356 = 14, icon357 = 20, 
        icon358 = 20, icon359 = 26, icon360 = 2700, icon361 = 5, 
        icon362 = 2700, icon363 = 16, icon364 = 2200, icon365 = 50, 
        icon366 = 1500, icon367 = 5000, icon368 = 0, icon369 = 10, 
        icon370 = 2, icon371 = 5, icon372 = 2500, icon373 = 2500, 
        icon374 = 2, icon375 = 5, icon376 = 3, icon377 = 20, 
        icon378 = 1, icon379 = 1)
    dcon <- c(big = big, dcon01 = 0, dcon02 = 8.5, dcon03 = 0.8, 
        dcon04 = 0.53, dcon05 = 1e-05, dcon06 = 0.009, dcon07 = 0.09, 
        dcon08 = 0, dcon09 = 0, dcon10 = 1, dcon11 = 0, dcon12 = 3e-04, 
        dcon13 = 0.015, eps = .Machine$double.eps, dcon15 = 0.37, 
        dcon16 = 0.2, dcon17 = 0.65, dcon18 = 0.5, dcon19 = 0.15, 
        dcon20 = 0.3, dcon21 = 0.5, dcon22 = 6.9, dcon23 = 1e+19, 
        dcon24 = 0.3, dcon25 = 0.1, dcon26 = 0.85, dcon27 = 1, 
        dcon28 = 3.5e-05, dcon29 = 0.25, dcon30 = 3.4, dcon31 = 0.35, 
        dcon32 = 0.08, dcon33 = 0.32, dcon34 = 0.69, dcon35 = 0.45, 
        dcon36 = 5.3, dcon37 = 1.5, dcon38 = 1, dcon39 = 1, dcon40 = 0.6, 
        dcon41 = 350, dcon42 = 0.2, dcon43 = 0.5, dcon44 = 2.7, 
        dcon45 = 0.7, dcon46 = 0.5, dcon47 = 0.55, dcon48 = 0.3, 
        dcon49 = 0.3, dcon50 = 0.65, dcon51 = 0.7, dcon52 = 1.8, 
        dcon53 = 0.61, dcon54 = 700, dcon55 = 0.2, dcon56 = 7, 
        dcon57 = 0.64, dcon58 = 1.3, dcon59 = 0.4, dcon60 = 2, 
        dcon61 = 1.73, dcon62 = 1.75, dcon63 = 1.3, dcon64 = 0.5, 
        dcon65 = 0.02, dcon66 = 0.02, dcon67 = 0.4, dcon68 = 1.3, 
        dcon69 = 1, dcon70 = 0.18, dcon71 = 0.6, dcon72 = 0.3, 
        dcon73 = 1.3, dcon74 = 3.2, dcon75 = 0.2, dcon76 = 0.47, 
        dcon77 = 0.3, dcon78 = 4, dcon79 = 0.04, dcon80 = 1e-05, 
        dcon81 = 0.5, dcon82 = 3e-05, dcon83 = 0.2, dcon84 = 2e-05, 
        dcon85 = 0.05, dcon86 = 6, dcon87 = 10, dcon88 = 0.35, 
        dcon89 = 4e-05, dcon90 = 5.3, dcon91 = 0.0065, dcon92 = 0.7, 
        dcon93 = 1.5, dcon94 = 0.07, dcon95 = 1.5, dcon96 = 10, 
        dcon97 = 0.3, dcon98 = 5.6, dcon99 = 0.35, dcon100 = 0.5, 
        dcon101 = 0.18, dcon102 = 0.5, dcon103 = 0.4, dcon104 = 1.2, 
        dcon105 = 0.1, dcon106 = 0.12, dcon107 = 0.3, dcon108 = 0.2, 
        dcon109 = 1.1, dcon110 = 0.1, dcon111 = 0.7, dcon112 = 0.91, 
        dcon113 = 0.3, dcon114 = 0.2, dcon115 = 1.6, dcon116 = 0.8, 
        dcon117 = 1.2, dcon118 = 0.45, dcon119 = 1, dcon120 = 0.35, 
        dcon121 = 1, dcon122 = 0.21, dcon123 = 0.6, dcon124 = 6, 
        dcon125 = 0.8, dcon126 = 0.5, dcon127 = 1.3, dcon128 = 0.5, 
        dcon129 = 0.5, dcon130 = 0.45, dcon131 = 0.7, dcon132 = 0.2, 
        dcon133 = 0.008, dcon134 = 0.37, dcon135 = 0.1, dcon136 = 0.4, 
        dcon137 = 0.05, dcon138 = 0.34, dcon139 = 0.05, dcon140 = 1, 
        dcon141 = 1.5, dcon142 = 0.38, dcon143 = 4.3, dcon144 = 2.7, 
        dcon145 = 12, dcon146 = 0.13, dcon147 = 0.85, dcon148 = 2.3, 
        dcon149 = 6, dcon150 = 50, dcon151 = 2.5, dcon152 = 120, 
        dcon153 = 6, dcon154 = 100, dcon155 = 1e-06, dcon156 = 2, 
        dcon157 = 2e-04, dcon158 = 6e5, dcon159 = 10, dcon160 = 3.5, 
        dcon161 = 10.5, dcon162 = 0.4, dcon163 = 6, dcon164 = 0.035, 
        dcon165 = 0.65, dcon166 = 0.07, dcon167 = 4, dcon168 = 2.5, 
        dcon169 = 16, dcon170 = 13, dcon171 = 15, dcon172 = 100, 
        dcon173 = 0.05, dcon174 = 0.2, dcon175 = 0.3, dcon176 = 1, 
        dcon177 = 0, dcon178 = 0.05, dcon179 = 0.2, dcon180 = 1, 
        dcon181 = 0.6, dcon182 = 5, dcon183 = 0.7, dcon184 = 0.2, 
        dcon185 = 0.7, dcon186 = 0.7, dcon187 = 0.4, dcon188 = 0.35, 
        dcon189 = 0.2, dcon190 = 0.6, dcon191 = 2, dcon192 = 0.87, 
        dcon193 = 0.88, dcon194 = 1, dcon195 = 0.15, dcon196 = 1.2e-05, 
        dcon197 = 1.6, dcon198 = 0.001, dcon199 = 0.5, dcon200 = 6, 
        dcon201 = 1.5, dcon202 = 2.2, dcon203 = 5.98, dcon204 = 0.42, 
        dcon205 = 740, dcon206 = 6e-05, dcon207 = 0.25, dcon208 = 3, 
        dcon209 = 0.34, dcon210 = 7e-05, dcon211 = 3e-04, dcon212 = 10, 
        dcon213 = 0.65, dcon214 = 0.12, dcon215 = 0.15, dcon216 = 0.9, 
        dcon217 = 0.1, dcon218 = 1e-10, dcon219 = 0.25, dcon220 = 0.15, 
        dcon221 = 0.15, dcon222 = 0.35, dcon223 = 1, dcon224 = 6, 
        dcon225 = 9, dcon226 = 0.04, dcon227 = 0.85, dcon228 = 0.5, 
        dcon229 = 0.6, dcon230 = 0.02, dcon231 = 0.01, dcon232 = 0.34, 
        dcon233 = 0.5, dcon234 = 0.25, dcon235 = 0.6, dcon236 = 0.2, 
        dcon237 = 0.7, dcon238 = 0.2, dcon239 = 0.6, dcon240 = 0.1, 
        dcon241 = 0.2, dcon242 = 0.2, dcon243 = 0.3, dcon244 = 0.14, 
        dcon245 = 0.3, dcon246 = 0.5, dcon247 = 0.3, dcon248 = 0.1, 
        dcon249 = 0.06, dcon250 = 0.25, dcon251 = 0.05, dcon252 = 0.3, 
        dcon253 = 0.28, dcon254 = 0.2, dcon255 = 0.4, dcon256 = 0.1, 
        dcon257 = 0.3, dcon258 = 0.6, dcon259 = 0.2, dcon260 = 0.8, 
        dcon261 = 0.75, dcon262 = 0.7, dcon263 = 0.12, dcon264 = 0.5, 
        dcon265 = 0.2, dcon266 = 0.3, dcon267 = 0.78, dcon268 = 0.84, 
        dcon269 = 0.3, dcon270 = 0.1, dcon271 = 0.3, dcon272 = 0.7, 
        dcon273 = 0.3, dcon274 = 0, dcon275 = 0, dcon276 = 0.04, 
        dcon277 = 0.01, dcon278 = 0.6, dcon279 = 0.1, dcon280 = 0.1, 
        dcon281 = 0.1, dcon282 = 0.1, dcon283 = 0.1, dcon284 = 0.5, 
        dcon285 = 0.1, dcon286 = 0.3, dcon287 = 0.25, dcon288 = 0.8, 
        dcon289 = 0.6)
    aux <- c(adjust = 1, sharetol = 1e-05, single.search = 500, 
        doubleconst = doubleconst, force.risk.aver = force.risk.aver, 
        enforce.max.weight = enforce.max.weight, 
	save.iterhistory = save.iterhistory, throw.error = throw.error,
	safe.mode=safe.mode)
    dots <- list(...)
    if (length(dots)) {
        dotnam <- names(dots)
        fchar <- substring(dotnam, 1, 1)
        bad <- setdiff(dotnam, c(names(icon), names(dcon), names(aux)))
        if (length(bad)) {
            stop(paste("unrecognized argument(s)", paste(bad, 
                collapse = ", ")))
        }
        dlen <- unlist(lapply(dots, length))
        if (any(dlen != 1)) {
            stop(paste("need single value for control parameters:", 
                paste(dotnam[dlen != 1], collapse = ", ")))
        }
        nami <- dotnam[fchar == "i"]
        if (length(nami)) {
            ima <- match(nami, names(icon), nomatch = NA)
            if (any(is.na(ima))) {
                stop(paste("unknown control parameter(s):", paste(nami[is.na(ima)], 
                  collapse = ", ")))
            }
            icon[nami] <- unlist(dots[nami])
        }
        namd <- dotnam[fchar == "d"]
        if (length(namd)) {
            dma <- match(namd, names(dcon), nomatch = NA)
            if (any(is.na(dma))) {
                stop(paste("unknown control parameter(s):", paste(namd[is.na(dma)], 
                  collapse = ", ")))
            }
            dcon[namd] <- unlist(dots[namd])
        }
    }
    if (length(icon) != 380) 
        stop("an integer parameter did not have length one")
    if (length(dcon) != 290) 
        stop("a double precision parameter did not have length one")
    if (length(aux) != 9) 
        stop("an auxiliary parameter did not have length one")
    if (any(icon > .Machine$integer.max, na.rm = TRUE)) {
        toobig <- names(icon[!is.na(icon) & icon > .Machine$integer.max])
        warning(paste(length(toobig), "item(s) overflow integer maximum, reducing:", 
            paste(toobig, collapse = ", ")))
        icon[toobig] <- .Machine$integer.max
    }
    if (any(dcon > big)) {
        dtoobig <- names(dcon[dcon > big])
        dcon[dtoobig] <- big
    }
    if (any(dcon < -big)) {
        dtooneg <- names(dcon[dcon < -big])
        dcon[dtooneg] <- -big
    }
    list(icontrol = icon, dcontrol = dcon, aux = aux)
}

"randport.eval" <-
function (x, keep=c("results", "alpha.values", "var.values", "utility.values"),
	subset=NULL, do.warn=FALSE, additional.args=NULL, 
	checkinput=TRUE, FUN=NULL, ..., debug=FALSE) 
{
	fun.copyright <- "Copyright 2005-2012  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "randport.eval 004"

	sfun.subex <- function(y, exist.vec) {
		com <- intersect(names(y), names(exist.vec))
		closed <- setdiff(names(exist.vec), names(y))
		y[com] <- y[com] - exist.vec[com]
		c(y, -exist.vec[closed])
	}
	#
	# start of main function
	#
	if(!inherits(x, "randportBurSt")) 
		stop("x must be a random portfolio object")
	if(!length(FUN) && length(list(...))) {
		stop(paste(length(list(...)), "argument(s) put into '...'",
			"which is only for extra arguments to 'FUN'",
			"-- you probably mean to give a list of",
			"additional arguments as the 'additional.args'",
			"argument"))
	}
	call.list <- as.list(attr(x, 'call'))[-1]
	call.list$number.rand <- NULL
	call.list$control <- NULL
	outtrade.loc <- pmatch(names(call.list), "out.trade", nomatch=0)
	if(any(outtrade.loc > 0)) {
		outtrade.loc <- seq(along=outtrade.loc)[outtrade.loc > 0]
		subtract.exist <- !call.list[[outtrade.loc]]
		call.list[[outtrade.loc]] <- NULL
	} else {
		subtract.exist <- TRUE
	}
	ntrade.loc <- pmatch(names(call.list), "ntrade", nomatch=0)
	if(any(ntrade.loc > 0)) {
		ntrade.loc <- seq(along=ntrade.loc)[ntrade.loc > 0]
		if(length(ntrade.loc) > 1) stop("bad call.list for 'ntrade'")
	} else {
		call.list <- c(call.list, list(ntrade=0))
		ntrade.loc <- length(call.list)
	}
	start.loc <- pmatch(names(call.list), "start.sol", nomatch=0)
	if(any(start.loc > 0)) {
		start.loc <- seq(along=start.loc)[start.loc > 0]
		if(length(start.loc) > 1) stop("bad call.list for 'start.sol'")
	} else {
		call.list <- c(call.list, list(start.sol=0))
		start.loc <- length(call.list)
	}
	funeval.loc <- pmatch(names(call.list), "funeval.max", nomatch=0)
	if(any(funeval.loc > 0)) {
		funeval.loc <- seq(along=funeval.loc)[funeval.loc > 0]
		if(length(funeval.loc) > 1) 
			stop("bad call.list for 'funeval.max'")
		call.list[[funeval.loc]] <- 0
	} else {
		call.list <- c(call.list, list(funeval.max=0))
	}

	variance.loc <- pmatch(names(call.list), "variance", nomatch=0)
	expret.loc <- pmatch(names(call.list), "expected.return", nomatch=0)
	prices.loc <- pmatch(names(call.list), "prices", nomatch=0)
	prices.loc <- seq(along=prices.loc)[prices.loc > 0]
	if(length(prices.loc) > 1) {
		stop("bad call.list for 'prices'")
	} else if(!length(prices.loc)) {
		znc <- nchar(names(call.list)) == 0
		if(!any(znc)) {
			stop(paste("confusion reigns: failed to",
				"find 'prices'"))
		}
		prices <- call.list[znc][[1]]
	} else {
		prices <- call.list[[prices.loc]]
	}
	if(!any(variance.loc > 0) && !any(expret.loc > 0)) {
		prices <- eval(prices)
		zeroret <- prices
		zeroret[] <- 0
		call.list[["expected.return"]] <- zeroret
	} else {
		expret.p <- expret.loc > 0
		if(!any(expret.p)) {
			prices <- eval(prices)
			zeroret <- prices
			zeroret[] <- 0
			call.list[["expected.return"]] <- zeroret
		} else {
			theret <- eval(call.list[expret.p][[1]])
			if(!length(theret)) {
				prices <- eval(prices)
				zeroret <- prices
				zeroret[] <- 0
				call.list[["expected.return"]] <- zeroret
			}
		}
	}
	
	if(length(do.warn)) {
		dowarn.loc <- pmatch(names(call.list), "do.warn", nomatch=0)
		if(any(dowarn.loc > 0)) {
			dowarn.loc <- seq(along=dowarn.loc)[dowarn.loc > 0]
			if(length(dowarn.loc) > 1) 
				stop("bad call.list for 'do.warn'")
			call.list[[dowarn.loc]] <- do.warn
		} else {
			call.list <- c(call.list, list(do.warn=do.warn))
		}
	}
	if(subtract.exist) {
		exist.loc <- pmatch(names(call.list), "existing", nomatch=0)
		if(any(exist.loc > 0)) {
			exist.loc <- seq(along=exist.loc)[exist.loc > 0]
			if(length(exist.loc) > 1) 
				stop("bad call.list for 'existing'")
			exist.vec <- eval(call.list[[exist.loc]])
			if(inherits(exist.vec, "portfolBurSt")) {
				exist.vec <- exist.vec$new.portfolio
			}
		} else {
			subtract.exist <- FALSE
		}
	}
	if(length(additional.args)) {
		aaloc <- match(names(additional.args), names(call.list),
			nomatch=NA)
		if(all(is.na(aaloc))) {
			call.list <- c(call.list, additional.args)
		} else if(all(!is.na(aaloc))) {
			call.list[aaloc] <- additional.args
		} else {
			call.list[ aaloc[!is.na(aaloc)] ] <- 
				additional.args[which(!is.na(aaloc))]
			call.list <- c(call.list, additional.args[
				which(is.na(aaloc)) ])
		}
	}

	index <- seq(along = x)
	if(length(subset)) {
		index <- index[subset]
	}
	if(length(FUN) && is.character(FUN)) {
		FUN <- get(FUN)
	}
	ans <- vector("list", length(index))
	orig.check <- NULL
	for(rpe.i in index) {
		tt <- x[[rpe.i]]
		if(subtract.exist) tt <- sfun.subex(tt, exist.vec)
		call.list[[start.loc]] <- tt
		call.list[[ntrade.loc]] <- length(tt)
		t.ans <- do.call("trade.optimizer", call.list)
		if(length(orig.check)) {
			tch <- pprobe.checkinput(t.ans$checkinput, orig.check,
				suppress.warning=TRUE)
			if(!tch) {
				pprobe.checkinput(t.ans$checkinput, orig.check)
				stop(paste("inputs are changing between",
					"iterations -- something bizarre",
					"is happening"))
			}
		} else {
			orig.check <- t.ans$checkinput
		}
		if(length(FUN)) {
			ans[[rpe.i]] <- FUN(t.ans, ...)
		} else if(length(keep)) {
			ans[[rpe.i]] <- t.ans[keep]
		} else {
			ans[[rpe.i]] <- t.ans
		}
		if(debug) {
			foo <- do.call("trade.optimizer", call.list)
			browser()
		}
	}
	if(checkinput && length(x)) {
		if(length(additional.args)) {
			cnam <- names(orig.check)
			checkex <- cnam[pmatch(names(additional.args), cnam)]
		} else {
			checkex <- NULL
		}
		if(is.null(attr(x, "checkinput")$expected.return)) {
			checkex <- unique(c(checkex, "expected.return"))
		}
		pprobe.checkinput(orig.check, attr(x, "checkinput"),
			exclude=checkex)
	}
	ans
}

"trade.distance" <-
function (x, y, prices=NULL, scale=TRUE, tol=1e-6) 
{
	fun.copyright <- "Copyright 2008-2010  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "trade.distance 004"

	if(!length(prices)) {
		if(is.list(x)) xprice <- x$price else xprice <- NULL
		if(is.list(y)) yprice <- y$price else yprice <- NULL
		if(!length(xprice) && !length(yprice)) {
			stop("no prices available")
		}
		assetnam <- unique(c(names(xprice), names(yprice)))
		prices <- rep(NA, length(assetnam))
		names(prices) <- assetnam
		if(length(yprice)) {
			prices[names(yprice)] <- yprice
		}
		if(length(xprice)) {
			prices[names(xprice)] <- xprice
		}
		comm <- intersect(names(xprice), names(yprice))
		if(length(comm) && any(xprice[comm] != yprice[comm])) {
			xyd <- abs(xprice[comm] - yprice[comm])
			if(any(xyd / (1 + xprice[comm]) > tol)) {
				warning("differences in 'x' and 'y' prices")
			}
		}
	}
	if(length(scale) != 1) stop("'scale' must have length 1")
	if(is.character(scale)) {
		scale.menu <- c("x", "y", "weight", "min", "max", "mean")
		scale.loc <- pmatch(scale, scale.menu, nomatch=NA)
		if(is.na(scale.loc)) {
			stop("unknown or ambiguous value of 'scale'")
		}
		scale <- scale.menu[scale.loc]
	}
	if(is.list(x)) {
		xshares <- x$new.portfolio
	} else {
		xshares <- x
	}
	if(is.list(y)) {
		yshares <- y$new.portfolio
	} else {
		yshares <- y
	}
	allnam <- unique(c(names(xshares), names(yshares)))
	diffval <- rep(0, length(allnam))
	names(diffval) <- allnam
	if(scale == "weight") {
		if(is.list(x) || abs(sum(abs(xshares)) - 1) > tol) {
			xval <- xshares * prices[names(xshares)]
			xval <- xval / sum(abs(xval))
		} else {
			xval <- xshares
		}
		if(is.list(y) || abs(sum(abs(yshares)) - 1) > tol) {
			yval <- yshares * prices[names(yshares)]
			yval <- yval / sum(abs(yval))
		} else {
			yval <- yshares
		}
		diffval[names(xval)] <- xval
		diffval[names(yval)] <- diffval[names(yval)] - yval
		ans <- sum(abs(diffval))
		return(ans)
	}
	xval <- xshares * prices[names(xshares)]
	yval <- yshares * prices[names(yshares)]
	diffval[names(xval)] <- xval
	diffval[names(yval)] <- diffval[names(yval)] - yval
	ans <- sum(abs(diffval))
	if(is.logical(scale)) {
		if(scale) {
			ans <- ans / sum(abs(xval))
		}
	} else {
		switch(scale,
			x = { ans <- ans / sum(abs(xval)) },
			y = { ans <- ans / sum(abs(yval)) },
			min = { ans <- ans / min(sum(abs(xval)), 
				sum(abs(yval))) },
			max = { ans <- ans / max(sum(abs(xval)), 
				sum(abs(yval))) },
			mean = { ans <- ans / mean(c(sum(abs(xval)), 
				sum(abs(yval)))) }
		)
	}
	ans
}

"pprobe.checkinput" <-
function (new, old, exclude=NULL, suppress.warning=FALSE) 
{
	fun.copyright <- "Copyright 2009  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "pprobe.checkinput 001"

	if(is.null(old)) {
		if(!suppress.warning) {
			warning(paste("the original is an apparently",
				"obsolete object"))
		}
		return( TRUE )
	}
	if(length(exclude)) {
		if(!is.character(exclude)) {
			stop("'exclude' only implemented to be character")
		}
		new <- new[match(names(new), exclude, nomatch=0)
			== 0] 
		old <- old[match(names(old), exclude, nomatch=0)==0]
	}
	if(length(old) != length(new)) {
		stop(paste("length of 'old' is different than length of 'new'",
			"-- this should never ever happen"))
	}
	if(any(sort(names(new)) != sort(names(old)))) {
		stop(paste("names of 'old' is different than names of 'new'",
			"-- this should never ever happen"))
	}
	ans <- rep(TRUE, length(new))
	names(ans) <- names(new)
	for(i in names(new)) {
		test <- all.equal(old[[i]], new[[i]])
		if(!is.logical(test) || length(test) != 1 || !test) {
			ans[i] <- FALSE
		}
	}
	if(!all(ans) && !suppress.warning) {
		warning(paste("checkinput difference for:",
			paste(names(ans)[!ans], collapse=", ")))
	}
	invisible(all(ans))
}

"random.portfolio.utility" <-
function (number.rand=1, objective.limit, prices, variance=NULL, 
	expected.return=NULL, gen.fail=4, objfail.max=1, seed=NULL, 
	penalty.constraint=1e6, ..., out.trade=FALSE, verbose=FALSE)
{
        fun.copyright <- "Copyright 2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "random.portfolio.utility 001"


	if(!is.numeric(number.rand) || length(number.rand) != 1) {
		stop(paste("'number.rand' must be a single number",
			"-- given has mode", mode(number.rand),
			"and length", length(number.rand)))
	}
	if(is.na(number.rand)) stop("'number.rand' is NA")
	if(number.rand < 0) stop("'number.rand' may not be negative")
	if(!is.numeric(objective.limit) || length(objective.limit) != 1) {
		stop(paste("'objective.limit' must be a single number",
			"-- given has mode", mode(objective.limit),
			"and length", length(objective.limit)))
	}
	if(is.na(objective.limit)) stop("'objective.limit' is NA")

	if(number.rand == 0) return(NULL)

	if(length(seed)) {
		warning(paste("input 'seed' is ignored -- if you",
			"want reproducible results, you need to use",
			"'set.seed' or assign '.Random.seed'"))
	}
	if(!is.numeric(gen.fail) || length(gen.fail) != 1) {
		stop(paste("'gen.fail' must be a single number",
			"-- given has mode", mode(gen.fail),
			"and length", length(gen.fail)))
	}
	if(!is.numeric(objfail.max) || length(objfail.max) != 1) {
		stop(paste("'objfail.max' must be a single number",
			"-- given has mode", mode(objfail.max),
			"and length", length(objfail.max)))
	}

	count <- 0
	penfail <- objfail <- 0
	ans <- vector("list", number.rand)
	orig <- trade.optimizer(prices=prices, variance=variance,
		expected.return=expected.return, exit.obj=objective.limit, 
		seed=seed.BurSt(), penalty.constraint=penalty.constraint,
		..., icon293=0, icon379=1)
	if(any(names(orig$call) == "start.sol")) {
		stop("'start.sol' not allowed")
	}
	if(verbose > 1) print(orig$results)
	if(orig$objective.utility == "minimum variance") {
		warning(paste("utility is 'minimum variance' -- it would",
			"be more efficient to use 'random.portfolio' with",
			"a variance constraint"))
	} else if(orig$objective.utility == "maximum return") {
		warning(paste("utility is 'maximum return' -- it would",
			"be more efficient to use 'random.portfolio' with",
			"an alpha constraint"))
	}
	if(orig$results["objective"] > objective.limit) {
	   if(objfail.max <= 1) {
		stop(paste("failed to achieve objective on first attempt",
			"-- achieved objective is", orig$results["objective"],
			"the difference from the limit is",
			orig$results["objective"] - objective.limit))
	   }
	   objfail <- 1
	} else if(orig$results["penalty"] <= 0) {
		if(out.trade) {
			ans[[1]] <- orig$trade
		} else {
			ans[[1]] <- orig$new.portfolio
		}
		count <- 1
	}

	max.fail <- gen.fail * number.rand
	for(rpu.i in 1:(max.fail + number.rand)) {
		t.ans <- trade.optimizer(prices=prices, variance=variance,
			expected.return=expected.return, 
			exit.obj=objective.limit, seed=seed.BurSt(), 
			penalty.constraint=penalty.constraint, ..., 
			icon293=0, icon379=1)
		ch <- pprobe.checkinput(t.ans$checkinput, orig$checkinput,
			suppress.warning=TRUE)
		if(verbose > 1) print(t.ans$results)
		if(!ch) {
			pprobe.checkinput(t.ans$checkinput, orig$checkinput)
			stop(paste("a change in inputs has been detected",
				"between iterations -- something bizarre",
				"is happening"))
		}
		if(t.ans$results["objective"] > objective.limit) {
			objfail <- objfail + 1
			if(objfail >= objfail.max) break
		} else if(t.ans$results["penalty"] <= 0) {
			count <- count + 1
			if(out.trade) {
				ans[[count]] <- t.ans$trade
			} else {
				ans[[count]] <- t.ans$new.portfolio
			}
		} else {
			penfail <- penfail + 1
		}
		if(verbose) {
			cat(count, "found ", number.rand, "requested ",
				penfail, "penalty fail ", objfail,
				"objective fail ", "try", rpu.i,  "\n")
		}
		if(count >= number.rand) break
	}

	if(count < number.rand) {
		warning(paste(number.rand, "portfolios requested but only",
			count, "generated -- there were:\n", penfail,
			"failure(s) of non-zero penalty but okay objective\n",
			objfail, "objective failure(s)\n"))
		length(ans) <- count
	}
	attr(ans, "call") <- match.call()
	attr(ans, "timestamp") <- date()
	attr(ans, "seed") <- orig$seed
	attr(ans, "version") <- c(C.code=orig$version, 
		S.code=fun.version)
	attr(ans, "checkinput") <- orig$checkinput
	attr(ans, "funevals") <- NA
	class(ans) <- "randportBurSt"
	ans
}

".standard.seed.BurSt" <-
c(1, 1703801500, -1007132623, -549223669, 312902813, 1753239107, 
-1281266349, 1711070667, 1909865735, 690621260, 554540596, -1882113636, 
-1262829584, -1389178169, 803257010, -497770740, 1158960073, 
-9881680, 934664376, 2112720589, -515244981, 1191618151, 1867044750, 
-1236338456, 651433865, -1608228616, -999779615, -489136248, 
-2089972604, -505139878, 1587810091, -685695838, -76965318, 427631964, 
-27739875, -1347685139, 1406057696, 723559131, 1263750578, -1683869304, 
960831197, -381073423, 1378453836, 631618723, 1215186960, 227789224, 
127644625, 1242775551, -2047276896, -97796126, 997779910, 827775732, 
-96122991, 1551382889, -265870900, -1096087348, -1843919451, 
-1720279742, -789107009, 80033551, 695806505, -400161299, 1773288591, 
-886466764, -175811367, -719859393, 647983722, -1039310013, -92147457, 
1143795620, -1785645905, 1611992837, -691176469, 1457885202, 
-658489400, -713931236, -101570629, 1684479025, 1564826110, -472491313, 
1191083331, 1978339233, -280635376, 912743595, -429520915, -750106796, 
1104180892, -1276927040, 906758746, -1624820826, -1093118508, 
-1531996024, -1118283146, -1894362424, 611123417, 1616063962, 
1197929417, 1276931683, -192094759, -386185927, 1335177525, 450685050, 
664534211, -630512916, -986725160, 2116061929, 573349205, -1231761679, 
-1591833643, -93982327, 1821385978, 424175124, 2045137561, 995541258, 
-615353227, -294318258, -1510919841, -2091315888, 925849204, 
-1704310729, -230706966, 601729407, 2112430787, -18925439, -67218281, 
-1402554491, 1094447622, -198017366, 47973856, -1256084173, -1165404402, 
411079894, 321573643, -1816494654, -1994838020, 613301969, 1840888264, 
421303746, 261566721, 111788223, 2083468121, 32821377, 785068820, 
436116209, -1121550488, -1038669436, 984877333, -203706728, -1395319904, 
1059561000, -1696565165, 1565708633, 492396404, 245498350, -735395815, 
-201298909, 1893963, -1370668541, 127262470, -1824176781, -954531001, 
-1233946168, -924317846, 1696916250, -230917528, 1202525944, 
1634746306, -373128679, -1873428310, -706575843, 960895624, -697436832, 
560124391, 1462928369, 1529573852, -466608335, -513274853, 1698425171, 
619831482, 1035424912, 452274859, 1731222338, -885922238, -1326027730, 
1659794162, 14342982, 1619449815, -1334903226, 1108544168, 964215402, 
1905783582, 204640533, 909432987, -477148963, -1714236869, 1835248495, 
-931009322, 389008755, -1673488458, 1462466566, -781840022, 1214837241, 
-998544646, -1208409299, 72141863, -992349651, -1369371606, 79783903, 
269650656, -1592759181, -1046393173, 936024883, 1981740586, -1717381986, 
1130532842, 1924000842, 1368525565, -823378170, 642438891, 1947146835, 
1948766892, -687284088, -1020165929, -1436864415, -763782381, 
43487431, 1820930718, 47071546, -834480536, -1947935657, -352804684, 
1520424874, -656139243, -1582943179, -539074812, 564445583, -472107385, 
814445409, 813524412, 235796381, -302260867, -203065784, -831319873, 
336527627, 1762527035, -1535003778, -364867671, -1241564446, 
-306014827, -1577584543, -171384460, 1902486082, 1125169167, 
1859333556, -125934894, 444907363, -64468831, -1680164076, -1083505001, 
-6380042, -546033331, 1866985218, 103019420, -785357655, -953628642, 
1234977076, 869569870, -1438695336, -1870640626, 1093952314, 
517157154, -1419156980, -1880276327, -1679206504, -508024401, 
-1420298806, -864780747, -1321949980, -1042946817, -1369098895, 
-97436875, 1162806744, -2028138865, 117298894, 1633457962, -545188666, 
-1941500745, -1552079861, -766685505, -1482486940, -1579567972, 
-1196981925, -1175185531, -1583053932, 2068299312, -742970386, 
29804913, 779289667, -1721555592, -1636801048, -1930846959, 1843631546, 
746088359, -1740072260, -31799419, -165133587, -535940919, 2109255086, 
-1390063099, 1346193969, -1853507579, -427565082, -1541273384, 
-1317224110, 1466094459, 944523388, -999816490, -21467772, -1790512174, 
-627562408, 2015236473, 535643366, 707029999, -805350793, -405060029, 
2130636086, 1525067107, 1947975527, 1341340157, 1211962958, -996955845, 
1125932245, 2088692370, -886457417, -432283704, 1340594686, -1816119751, 
-585417744, -246563476, -1474401573, 353068947, 2019331181, 2102385775, 
-1389627921, 180948795, -496911000, 756618837, -990875671, -132066197, 
-1409607912, -561826981, 968108274, -59489144, -1873454139, 1222116751, 
-350805903, 2065956942, -932506309, 1494142454, -1794268840, 
1659827694, -120556593, -1678898577, -716065604, 1449193129, 
-958422632, 373813086, 1446254085, -1841879441, 870928071, 853944885, 
-154780395, -270878818, 267047270, 1840321443, -1157637935, -1194800826, 
-342670129, -715022695, 1566836497, -1386438911, -28695842, -301878791, 
276011104, 670712038, 2055374048, -1150359107, -1113205717, 1274901272, 
1424519168, -1659971760, 1989909957, -1514736611, -1530610625, 
1826348664, 30217683, -1482403593, -651537725, 686426079, -808431496, 
-637487353, -1512491171, 682374135, -1352614202, 1951539237, 
1708746261, 1905664337, 960744461, -556812162, 1206961144, -2099596872, 
1891111518, 2120636778, -612437661, 1063584499, 1258034677, 884157700, 
-103830668, -22958636, -824408455, 837571220, 1386386690, -280385598, 
63276262, 700126775, -1532587840, -667921558, -404742332, -1781075667, 
1857882284, 1453348499, 1629653597, 1871370798, -1836267596, 
-520724238, 162628605, -1696296737, 1295738828, 1029253461, -1923505340, 
-76581100, 1806110372, -1969120403, -884798486, 3652815, 471368087, 
-1012542622, -330288957, -573104904, 1900545887, -1616094981, 
-1846695580, 1994226492, -246917205, -557175884, -1541098316, 
-1914737525, 677866396, 335702876, 2092086145, 445784970, -1868525870, 
-1451230442, -105665127, -2139182185, -251431066, -1026798960, 
1882972698, 926996895, -1447036851, -102271682, 817146403, -167953925, 
1954840355, 912852875, -441746263, -1641877468, -1116192107, 
1561781390, -274979261, -9156647, 824323075, 1118037031, -1480040478, 
1500906785, 1919067919, 379757531, 9667178, -1332385107, -2139594401, 
1621685428, -1571479837, -2049810833, 1886077790, -889278464, 
-1441706384, -433351223, -173622283, -283335348, 73056648, 1487114183, 
-1910554841, 232688706, 808635988, 678852024, 701551663, -119253192, 
2016608117, -420060417, 1501314853, 1102281483, 140021171, 1606960556, 
-141239503, -2112572197, 978251836, 930244728, -1342493513, 627354177, 
180299634, -707291951, 592313456, 1413907802, 897541643, -650471290, 
-1596319621, -480699230, 1839008566, 1307348407, 1111094325, 
1963873318, 2121343955, 457160591, -2021309682, -702461839, -954951246, 
-1644124002, -1961862638, -557015229, -700602329, -1401651609, 
523012253, -438758279, 1957112523, 658630843, -735540136, -1300744960, 
-1652092134, 2130155510, -518502517, 266236831, 999516275, 1592597722, 
309968905, -2100084083, 1745110758, 1162448495, -504638800, -1743559630, 
-1934223128, 1379381652, 1414437116, 664572641, -1576992534, 
-679421301, 993733365, 1749303311, 842659696, -1109908788, 618935834, 
-941670662, 1965533889, -1467178193, -350731360, -1065109810, 
-1742080534, 1407537102, 108686311, 720470574, -393944022, 1471412430, 
1019219224, -651871234, 1928174789, 629982324, -1995966792, 414242963, 
-363706414, -1817213383, 120469019, 1985706439, 896531693, 229676398, 
-1103992957, 1194183568, 652581383, 1418394497, 638021461, -86604604, 
-21199505, -515943291, -212663428, 1349700990, 1841584161, -1514057381, 
1072975881, 2042932760, 2039218102, -641558291, -455485332, 1936819835, 
-1689432602, 1867280481, -660728750, 141994221, 166620247, 922206572, 
-404626721, -1491263577, -686195065, 543978428, -1901069870, 
1510401011, -1234178841, 1152118235)
"constraints.realized" <-
function (portfol, lin.constraints=NULL, prices=portfol$prices,
	lin.bounds=portfol$con.realized$linear[, c("lower", "upper"),
	drop=FALSE], lin.trade=portfol$lintable[, "trade"],
	lin.abs=portfol$lintable[, "absolute"],
	lin.style=portfol$lintable[, "style"],
	lin.direction=portfol$lintable[, "direction"],
	lin.riskfrac.col=portfol$lintable[, "riskfrac.col"],
	risk.fraction=portfol$risk.fraction, exclude.inf=FALSE, 
	dist.value=portfol$dist.value, dist.utility=portfol$dist.utility, 
	dist.bounds=portfol$dist.bounds)
{
        fun.copyright <- "Copyright 2003-2011  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "constraints.realized 006"

	lindo <- portfol$sizes["nconsmain"] > 0 || length(lin.constraints)
	distdo <- portfol$sizes["distconnum"] > 0
	ans <- list(linear=NULL, distance=NULL)[c(lindo, distdo)]
	if(lindo) {
		ans$linear <- constraints.realized.lin(portfol, 
			lin.constraints, prices=prices,
			lin.bounds=lin.bounds, lin.trade=lin.trade,
			lin.abs=lin.abs, lin.style=lin.style,
			lin.direction=lin.direction, 
			lin.riskfrac.col=lin.riskfrac.col,
			risk.fraction=risk.fraction, exclude.inf=FALSE)
	}
	if(distdo) {
		ans$distance <- constraints.realized.dist(portfol, 
			dist.value=dist.value, dist.utility=dist.utility,
			dist.bounds=dist.bounds)
	}

	ans
}

"pprobe.verify" <-
function () 
{
        fun.copyright <- "Copyright 2003-2012  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "pprobe.verify 024"

	objnams <- c(".standard.seed.BurSt", ".tradeopt.alphaben",
		".tradeopt.precost", ".tradeopt.prelin", 
		".tradeopt.preriskfrac", ".tradeopt.rectify.start",
		".tradeopt.varben", ".unpack.violcode", "build.constraints", 
		"Cfrag.list", "constraint.bnames", "constraints.realized", 
		"constraints.realized.dist", "constraints.realized.lin",
		"deport", "deport.portfolBurSt", "deport.randportBurSt",
		"head.randportBurSt", "pprobe.checkinput",
		"print.portfolBurSt", "print.randportBurSt", 
		"random.portfolio", "random.portfolio.control", 
		"random.portfolio.utility", "randport.eval", "seed.BurSt", 
		"summary.portfolBurSt", "summary.randportBurSt", 
		"tail.randportBurSt", "trade.distance", "trade.optimizer", 
		"trade.optimizer.control", "trade.optimizer.pre",
		"update.randportBurSt", "valuation", "valuation.default", 
		"valuation.portfolBurSt", "valuation.randportBurSt")
	okay <- TRUE

	cat("Portfolio Probe version 1.04 beta2 (2012 January 11)\n")
	cat("Copyright 2003-2012 Burns Statistics Ltd.\n\n")

	obj.present <- logical(length(objnams))
	for(i in seq(along=objnams)) obj.present[i] <- exists(objnams[i])
	if(!all(obj.present)) {
		cat("Missing items:\n")
		print(objnams[!obj.present])
		cat("\n")
		okay <- FALSE
	}
	if(sum(obj.present)) {
		obj.mult <- rep(FALSE, length(objnams))
		for(i in seq(along=objnams)) {
			if(!obj.present[i]) next
			obj.mult[i] <- length(find(objnams[i])) > 1
		}
		if(any(obj.mult)) {
			cat("Masking (one way or the other) of:\n")
			print(objnams[obj.mult])
			cat("\n")
		}
	}

	nvec <- seq(5, 11, length=26)
	names(nvec) <- LETTERS
	varmat <- matrix(.1, 26, 26, dimnames=list(LETTERS, LETTERS))
	diag(varmat) <- seq(3, 5, length=26)

	rp <- random.portfolio(3, nvec, varmat, gross=1e4, long.only=TRUE,
		max.wei=.4, ntrade=7, trace=0, seed=1:625,
		do.warn=c(value=FALSE, utility.switch=FALSE))
	cat("random.portfolio version:", attr(rp, "version"), "\n")
	if(length(rp) != 3) {
		cat("Problem with random.portfolio\n")
		okay <- FALSE
	}
	po <- trade.optimizer(nvec, varmat, gross=1e4, long.only=TRUE,
		max.we=.4, ntrade=7, trace=0, seed=1:625, exit.obj = .547499,
		do.warn=c(value=FALSE, converged=FALSE, utility.switch=FALSE),
		iter=5)
	cat("trade.optimizer version:", po$version, "\n")
	if(po$var.values > .5475) {
		cat("Ineffective trade optimization\n")
		okay <- FALSE
	}
	if(!okay) stop("not all commands ran okay")
	invisible(okay)
}

"update.randportBurSt" <-
function (object, ..., evaluate = TRUE, checkinput = TRUE) 
{
	fun.copyright <- "Copyright 2010  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "update.randportBurSt 002"

	if(evaluate && checkinput) {
		ans <- update.default(list(call = attr(object, "call")), ..., 
			evaluate=TRUE)
		if(!length(ans) && !length(attr(ans, "checkinput"))) {
			return(ans)
		}
		dots <- list(...)
		if(length(dots)) {
			chma <- pmatch(names(list(...)), names(attr(object, 
				"checkinput")), nomatch=0)
		} else {
			chma <- TRUE
		}
		pprobe.checkinput(new=attr(ans, "checkinput"), 
			old=attr(object, "checkinput"),
			exclude=names(attr(object, "checkinput"))[chma])
		ans
	} else {
		update.default(list(call = attr(object, "call")), ..., 
			evaluate=evaluate)
	}
}

"constraints.realized.lin" <-
function (portfol, lin.constraints, prices=portfol$prices,
	lin.bounds=portfol$con.realized$linear[, c("lower", "upper"),
	drop=FALSE], lin.trade=portfol$lintable[, "trade"],
	lin.abs=portfol$lintable[, "absolute"], 
	lin.style=portfol$lintable[, "style"],
	lin.direction=portfol$lintable[, "direction"],
	lin.riskfrac.col=portfol$lintable[, "riskfrac.col"],
	risk.fraction=portfol$risk.fraction, exclude.inf=FALSE)
{
        fun.copyright <- "Copyright 2003-2011  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "constraints.realized.lin 006"

	if(!length(dim(lin.constraints))) {
		if(is.list(lin.constraints) && any(names(lin.constraints) ==
				"lin.constraints")) {
			warning(paste("assuming you meant to give ", 
				deparse(substitute(lin.constraints)), 
				"$lin.constraints as the value of ",
				"the 'lin.constraints' argument", sep=""))
			lin.constraints <- lin.constraints$lin.constraints
		} else {
			stop(paste("bad value for 'lin.constraints' argument",
				"-- should be a matrix or data frame, given",
				"has mode", mode(lin.constraints), 
				"and length", length(lin.constraints)))
		}
	}
	if(!length(dimnames(lin.constraints)[[1]]) || 
			!length(dimnames(lin.constraints)[[2]])) {
		stop(paste("'lin.constraints' argument must have dimnames",
			"for both rows and columns"))
	}

	if(!inherits(portfol, "portfolBurSt")) {
		stop(paste("argument 'portfol' expected to be the result",
			"of a call to 'portfolio.optimizer'"))
	}

	nc <- ncol(lin.constraints)

	if(!length(lin.trade)) {
		lin.trade <- rep(FALSE, nc)
	} else {
		if(length(lin.trade) != nc) {
			if(length(lin.trade) == 1) {
				lin.trade <- rep(lin.trade, nc) 
			} else {
				stop(paste("length of 'lin.trade' (",
				length(lin.trade), ") does not match ",
				"the number of columns in'lin.constraints' (",
				nc, ")", sep=""))
			}
		}
	}
	if(!is.logical(lin.trade)) {
		stop(paste("'lin.trade' must be logical -- given has mode",
			mode(lin.trade)))
	}
	if(any(is.na(lin.trade))) {
		stop("missing value(s) in 'lin.trade'")
	}

	if(!length(lin.abs)) {
		lin.abs <- rep(TRUE, nc)
	} else {
		if(length(lin.abs) != nc) {
			if(length(lin.abs) == 1) {
				lin.abs <- rep(lin.abs, nc)
			} else {
				stop(paste("length of 'lin.abs' (",
				length(lin.abs), ") does not match ",
				"the number of columns in'lin.constraints' (",
				nc, ")", sep=""))
			}
		}
	}
	if(!is.logical(lin.abs)) {
		stop(paste("'lin.abs' must be logical -- given has mode",
			mode(lin.abs)))
	}
	if(any(is.na(lin.abs))) {
		stop("missing value(s) in 'lin.abs'")
	}

	if(!length(lin.style)) {
		lin.style <- rep("value", nc)
	} else {
		lin.style <- as.character(lin.style) # probably factor
		if(length(lin.style) != nc) {
			if(length(lin.style) == 1) {
				lin.style <- rep(lin.style, nc)
			} else {
				stop(paste("length of 'lin.style' (",
				length(lin.style), ") does not match ",
				"the number of columns in'lin.constraints' (",
				nc, ")", sep=""))
			}
		}
	}
	lin.stylemenu <- c("value", "weight", "count", "varfraction", 
		"varvalue", "varmbfraction", "varmbvalue")
	lin.stylenum <- pmatch(lin.style, lin.stylemenu, nomatch=0,
		duplicates.ok=TRUE)
	if(any(lin.stylenum == 0)) {
		stop(paste("unknown or ambiguous choice",
			"for 'lin.style' -- allowable choices are:",
			paste(lin.stylemenu, collapse=", ")))
	}
	lin.style <- lin.stylemenu[lin.stylenum]

	if(!length(lin.direction)) {
		lin.direction <- rep(0, nc)
	} else {
		if(length(lin.direction) != nc) {
			if(length(lin.direction) == 1) {
				lin.direction <- rep(lin.direction, nc)
			} else {
				stop(paste("length of 'lin.direction' (",
				length(lin.direction), ") does not match ",
				"the number of columns in'lin.constraints' (",
				nc, ")", sep=""))
			}
		}
	}
	if(!is.numeric(lin.direction) || !all(lin.direction %in% -1:1)) {
		stop(paste("all values of 'lin.direction' must be numeric",
			"and one of: 0, 1 or -1"))
	}

	position <- portfol$new.portfolio
	if(any(lin.trade)) {
		trade <- portfol$trade
	} else {
		trade <- NULL
	}

	if(!any(substring(lin.style, 1, 3) == "var")) {
		use.nam <- unique(c(names(trade), names(position)))
	} else {
		use.nam <- names(prices)
	}
	nassets <- length(use.nam)
	imu.nam <- intersect(use.nam, dimnames(lin.constraints)[[1]])
	ipu.nam <- intersect(use.nam, names(prices))
	if(length(ipu.nam) < nassets) {
		if(length(imu.nam) < nassets) {
			ipmu.nam <- intersect(imu.nam, ipu.nam)
			nm <- nassets - length(ipmu.nam)
			errmsg <- paste(nm,
				"assets missing from 'lin.constraints'",
				"and/or 'prices'")
			if(nm == nassets) {
				errmsg <- paste("all assets missing from",
					"'lin.constraints' and/or 'prices'")
			} else if(nm < 6) {
				errmsg <- paste(errmsg, "-- missing assets:",
					paste(setdiff(use.nam, ipmu.nam),
					collapse=", "))
			} else {
				errmsg <- paste(errmsg, 
					"-- first few missing assets:",
					paste(setdiff(use.nam, ipmu.nam)[1:5],
					collapse=", "))
			}
			stop(errmsg)
		} else {
			nm <- nassets - length(ipu.nam)
			errmsg <- paste(nm,
				"assets missing from 'prices'")
			if(nm == nassets) {
				errmsg <- paste("all assets missing from",
					"'prices'")
			} else if(nm < 6) {
				errmsg <- paste(errmsg, "-- missing assets:",
					paste(setdiff(use.nam, ipu.nam),
					collapse=", "))
			} else {
				errmsg <- paste(errmsg, 
					"-- first few missing assets:",
					paste(setdiff(use.nam, ipu.nam)[1:5],
					collapse=", "))
			}
			stop(errmsg)
		}
	} else if(length(imu.nam) < nassets) {
		nm <- nassets - length(imu.nam)
		errmsg <- paste(nm, "assets missing from 'lin.constraints'")
		if(nm == nassets) {
			errmsg <- paste("all assets missing from",
				"'lin.constraints'")
		} else if(nm < 6) {
			errmsg <- paste(errmsg, "-- missing assets:",
				paste(setdiff(use.nam, imu.nam),
				collapse=", "))
		} else {
			errmsg <- paste(errmsg, 
				"-- first few missing assets:",
				paste(setdiff(use.nam,imu.nam)[1:5],
				collapse=", "))
		}
		stop(errmsg)
	}

	prices <- prices[use.nam]
	lin.constraints <- lin.constraints[use.nam, , drop=FALSE]
	if(!is.numeric(prices)) {
		stop(paste("'prices' must be numeric -- given has mode",
			mode(prices)))
	}
	if(any(is.na(prices))) {
		stop(paste(sum(is.na(prices)), "missing value(s) in 'prices'"))
	}
	if(any(prices < 0)) {
		stop(paste(sum(prices < 0), "negative value(s) in 'prices'"))
	}
	if(any(prices == 0)) {
		warning(paste(sum(prices == 0), "zero value(s) in 'prices'"))
	}
	mode(prices) <- "numeric"
	lin.constraints <- lin.constraints[use.nam, , drop=FALSE]

	if(length(position) < nassets) {
		sm.p <- position
		position <- rep(0, nassets)
		names(position) <- use.nam
		position[names(sm.p)] <- sm.p
	} else {
		position <- position[use.nam]
	}
	longposition <- shortposition <- position
	longposition[longposition < 0] <- 0
	shortposition[shortposition > 0] <- 0
	shortposition <- abs(shortposition)
	position <- position * prices
	grossval <- sum(abs(position))
	longposition <- longposition * prices
	shortposition <- shortposition * prices
	
	if(any(lin.trade)) {
		if(length(trade) < nassets) {
			sm.t <- trade
			trade <- rep(0, nassets)
			names(trade) <- use.nam
			trade[names(sm.t)] <- sm.t
		} else {
			trade <- trade[use.nam]
		}
	}
	longtrade <- shorttrade <- trade
	longtrade[longtrade < 0] <- 0
	shorttrade[shorttrade > 0] <- 0
	shorttrade <- abs(shorttrade)
	trade <- trade * prices
	longtrade <- longtrade * prices
	shorttrade <- shorttrade * prices

	if(!length(lin.bounds)) {
		lin.bounds <- build.constraints(lin.constraints)$bounds
	}
	
	bou.allinf <- is.infinite(lin.bounds[, 1]) & 
		is.infinite(lin.bounds[, 2])
	if(exclude.inf && !all(bou.allinf)) {
		lin.bounds <- lin.bounds[!bou.allinf, , drop=FALSE]
	}
	bou.nam <- dimnames(lin.bounds)[[1]]
	ccnam <- dimnames(lin.constraints)[[2]]
	ans <- array(NA, c(nrow(lin.bounds), 3), list(bou.nam,
		c("realized", "nearest", "violation")))
	ans[, "realized"] <- 0

	lin.styleabb <- lin.style
	lin.styleabb[substring(lin.style, 1, 3) == "var"] <- "var"
	styledir <- paste(lin.styleabb, lin.direction, sep='_')
	for(i in 1:nc) {
		t.c <- lin.constraints[, i]
		if(is.character(t.c) || is.logical(t.c)) t.c <- as.factor(t.c)
		if(is.factor(t.c)) {
			switch(styledir[i], 
			  "value_0"={
				if(lin.trade[i]) {
					if(lin.abs[i]) {
						t.s <- tapply(abs(trade), t.c, 
							sum)
					} else {
						t.s <- tapply(trade, t.c, sum)
					}
				} else {
					if(lin.abs[i]) {
						t.s <- tapply(abs(position), 
							t.c, sum)
					} else {
						t.s <- tapply(position, t.c, 
							sum)
					}
				}
			  },
			  "value_-1"={
				if(lin.trade[i]) {
					t.s <- tapply(shorttrade, t.c, sum)
				} else {
					t.s <- tapply(shortposition, t.c, sum)
				}
			  },
			  "value_1"={
				if(lin.trade[i]) {
					t.s <- tapply(longtrade, t.c, sum)
				} else {
					t.s <- tapply(longposition, t.c, sum)
				}
			  },
			  "weight_0"={
				if(lin.trade[i]) {
					if(lin.abs[i]) {
						t.s <- tapply(abs(trade), t.c, 
							sum)
					} else {
						t.s <- tapply(trade, t.c, sum)
					}
				} else {
					if(lin.abs[i]) {
						t.s <- tapply(abs(position), 
							t.c, sum)
					} else {
						t.s <- tapply(position, t.c, 
							sum)
					}
				}
				t.s <- t.s / grossval
			  },
			  "weight_-1"={
				if(lin.trade[i]) {
					t.s <- tapply(shorttrade, t.c, sum) /
						grossval
				} else {
					t.s <- tapply(shortposition, t.c, sum) /
						grossval
				}
			  },
			  "weight_1"={
				if(lin.trade[i]) {
					t.s <- tapply(longtrade, t.c, sum) /
						grossval
				} else {
					t.s <- tapply(longposition, t.c, sum) /
						grossval
				}
			  },
			  "count_0"={
				if(lin.trade[i]) {
					if(lin.abs[i]) {
						t.s <- tapply(sign(abs(trade)),
							t.c, sum)
					} else {
						t.s <- tapply(sign(trade),
							t.c, sum)
					}
				} else {
					if(lin.abs[i]) {
						t.s <- tapply(sign(abs(position)),
							t.c, sum)
					} else {
						t.s <- tapply(sign(position),
							t.c, sum)
					}
				}
			  },
			  "count_-1"={
				if(lin.trade[i]) {
					t.s <- tapply(sign(shorttrade),
							t.c, sum)
				} else {
					t.s <- tapply(sign(shortposition),
							t.c, sum)
				}
			  },
			  "count_1"={
				if(lin.trade[i]) {
					t.s <- tapply(sign(longtrade),
							t.c, sum)
				} else {
					t.s <- tapply(sign(longposition),
							t.c, sum)
				}
			  },
			  "var_0"={
				t.rf <- risk.fraction[use.nam, 
					lin.riskfrac.col[i] ]
				if(lin.abs[i]) {
					t.s <- tapply(t.rf, t.c, sum)
				} else {
					warning(paste("net (not absolute)",
					  "linear constraint with a variance",
					  "style -- subject to",
					  " misinterpretation"))
					t.s <- tapply(ifelse(position < 0,
						-t.rf, t.rf), t.c, sum)
				}
			  },
			  "var_1"={
				t.rf <- risk.fraction[use.nam, 
					lin.riskfrac.col[i] ]
				t.s <- tapply(t.rf[longposition > 0], 
					t.c[longposition > 0], sum)
			  },
			  "var_-1"={
				t.rf <- risk.fraction[use.nam, 
					lin.riskfrac.col[i] ]
				t.s <- tapply(t.rf[shortposition > 0], 
					t.c[shortposition > 0], sum)
			  }
			)
			names(t.s) <- paste(ccnam[i], ":", names(t.s))
		} else {
			# numeric column
			if(lin.style[i] == "count") {
				stop(paste("'lin.style' may not be 'count'",
					"for a numeric constraint column",
					"-- constraint named:", ccnam[i]))
			}
		   if(lin.styleabb[i] == "var") {
			t.rf <- risk.fraction[use.nam, lin.riskfrac.col[i] ]
			if(lin.direction[i] == 0) {
				if(lin.abs[i]) {
					t.s <- sum(t.rf * t.c)
				} else {
					warning(paste("net (not absolute)",
					  "linear constraint with a variance",
					  "style -- subject to",
					  " misinterpretation"))
					t.s <- sum(ifelse(position < 0,
						-t.rf, t.rf) * t.c)
				}
			} else if(lin.direction[i] == -1) {
				t.s <- sum(t.rf[shortposition > 0] * 
					t.c[shortposition > 0])
			} else {
				t.s <- sum(t.rf[longposition > 0] * 
					t.c[longposition > 0])
			}
			names(t.s) <- ccnam[i]
		   } else {
			# numeric weight constraint
			if(lin.direction[i] == 0) {
				if(lin.trade[i]) {
					if(lin.abs[i]) {
						t.s <- sum(abs(trade) * t.c)
					} else {
						t.s <- sum(trade * t.c)
					}
				} else {
					if(lin.abs[i]) {
						t.s <- sum(abs(position) * t.c)
					} else {
						t.s <- sum(position * t.c)
					}
				}
			} else if(lin.direction[i] == -1) {
				if(lin.trade[i]) {
					t.s <- sum(shorttrade * t.c)
				} else {
					t.s <- sum(shortposition * t.c)
				}
			} else {
				if(lin.trade[i]) {
					t.s <- sum(longtrade * t.c)
				} else {
					t.s <- sum(longposition * t.c)
				}
			}
			if(lin.style[i] == "weight") t.s <- t.s / grossval
			names(t.s) <- ccnam[i]
		   }
		}
	
		t.inam <- intersect(bou.nam, names(t.s))
		if(length(t.inam)) {
			ans[t.inam, "realized"] <- t.s[t.inam]
		}
	}
	low <- ans[, "realized"] < lin.bounds[, 1]
	low[is.na(low)] <- FALSE
	if(any(low)) {
		ans[low, "violation"] <- ans[low, "realized"] - lin.bounds[low, 1]
	}
	high <- ans[, "realized"] > lin.bounds[, 2]
	high[is.na(high)] <- FALSE
	if(any(high)) {
		ans[high, "violation"] <- ans[high, "realized"] - lin.bounds[high, 2]
	}
	okay <- !low & !high
	if(length(okay)) {
		l.ok <- ans[okay, "realized"] - lin.bounds[okay, 1]
		h.ok <- lin.bounds[okay, 2] - ans[okay, "realized"]
		ans[okay, "nearest"] <- ifelse(l.ok > h.ok, h.ok, -l.ok)
	}

	if(!length(dimnames(lin.bounds)[[2]])) {
		dimnames(lin.bounds)[[2]] <- c("lower", "upper")
	}
	ans <- cbind(lin.bounds, ans)
	ans
}

"constraints.realized.dist" <-
function (portfol, dist.value=portfol$dist.value, 
	dist.utility=portfol$dist.utility, dist.bounds=portfol$dist.bounds)
{
        fun.copyright <- "Copyright 2010  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "constraints.realized.dist 001"

	dist.bounds <- dist.bounds[!dist.utility, , drop=FALSE]
	if(!length(dist.bounds)) {
		warning("no distance constraints specified")
		return(NULL)
	}
	ans <- cbind(dist.bounds, array(NA, c(nrow(dist.bounds), 3),
		list(NULL, c("realized", "nearest", "violation"))))

	loc <- seq(along=dist.value)[!dist.utility]
	ans[, "realized"] <- real <- dist.value[loc]
	low <- ans[, "lower"]
	up <- ans[, "upper"]
	viol <- ifelse(real < low, low - real, ifelse(real > up,
		real - up, NA))
	ans[, "nearest"] <- ifelse(!is.na(viol), NA, 
		ifelse(real - low < up - real, low - real, up - real))
	ans[, "violation"] <- viol
	ans
}

".tradeopt.prelin" <-
function(lin.constraints, lin.bounds, lin.style, lin.trade, lin.direction, 
	lin.abs, lin.rfloc, big, nassets, assetnam, out.price, sizes, do.warn)
{
	fun.copyright <- "Copyright 2003-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.prelin 003"

	long.only <- sizes["long.only"]

	linsizenam <- c("nconsmain", "maxconlev", "nconsub")
	linsizes <- rep(0, length(linsizenam))
	names(linsizes) <- linsizenam

	if(!length(lin.constraints)) {
		## exit since no linear constraints

		if(!is.null(lin.constraints)) {
			stop(paste("bad value for 'lin.constraints'",
				"-- must be NULL if of zero length",
				"-- given has mode:", mode(lin.constraints)))
		}
		if(length(lin.bounds)) {
			warning(paste("'lin.bounds' given but not",
				"'lin.constraints' -- no linear constraints",
				"performed"))
		}
		return(list(constrain.levels=NULL, nconsmain=0, constrainvec=0,
			lin.stylenum=0, lin.direction=0, lin.rfloc=-1,
			linconstnames=NULL, low.constraint=NULL, 
			up.constraint=NULL, bounds.infinite=lin.bounds, 
			linsizes=linsizes))
	}

	## continue on since there are constraints
	if(any(is.na(lin.constraints))) {
		stop(paste(sum(is.na(lin.constraints)),
			"missing value(s) in 'lin.constraints'"))
	}
	if(!is.data.frame(lin.constraints)) {
		lin.constraints <- as.matrix(lin.constraints)
	}
	if(!length(dimnames(lin.constraints))) {
		dimnames(lin.constraints) <- list(NULL, 
			paste("Constr", 1:ncol(lin.constraints)))
	} else if(!length(dimnames(lin.constraints)[[2]])) {
		dimnames(lin.constraints)[[2]] <- paste("Constr", 
			1:ncol(lin.constraints))
	}
	acnam <- dimnames(lin.constraints)[[1]]
	if(length(acnam)) {
		acngood <- intersect(acnam, assetnam)
		if(length(acngood) < nassets) {
			if(length(out.price) && length(intersect(
					acnam, assetnam[-out.price]))
					== length(assetnam[
					-out.price])) {
				if(!is.data.frame(lin.constraints)) {
					conmatgiv <- lin.constraints
					lin.constraints <- t(array(
						conmatgiv[1,], c(ncol(
						conmatgiv), nassets), 
						list( dimnames(
						conmatgiv)[[2]], 
						assetnam)))
					lin.constraints[acngood, ] <- 
						conmatgiv[acngood,]
				} else {
					# data frame
					cm.sub <- lin.constraints[
						1:length(out.price), ,
						drop=FALSE]
					dimnames(cm.sub)[[1]] <- 
						assetnam[out.price]
					lin.constraints <- rbind(
						lin.constraints, 
						cm.sub)
					lin.constraints <- 
						lin.constraints[
						assetnam, , drop=FALSE]
				}
			} else {
				stop(paste(nassets - length(acngood),
					"missing assets (or bad names)",
					"in 'lin.constraints'"))
			}
		} else {
			lin.constraints <- lin.constraints[
				assetnam, , drop=FALSE]
		}
	} else {
		if(nrow(lin.constraints) != nassets) {
			stop(paste("wrong number of assets in",
				"'lin.constraints', given is",
				nrow(lin.constraints), "should be",
				nassets))
		}
		if(do.warn["no.asset.names"]) {
			warning(paste("no row names on 'lin.constraints'", 
				"-- assuming correct order ('do.warn'",
				"suppression is 'no.asset.names')"))
		}
		dimnames(lin.constraints)[[1]] <- assetnam
	}
	linsizes["nconsmain"] <- nconsmain <- ncol(lin.constraints)
	linconstnames <- dimnames(lin.constraints)[[2]]
	cons.struc <- constraint.bnames(lin.constraints, value=TRUE)
	constrainvec <- cons.struc$values
	constrain.levels <- cons.struc$levels
	linsizes["maxconlev"] <- max(constrain.levels)
	linsizes["nconsub"] <- sum(constrain.levels) + 
		sum(constrain.levels == 0)
	bnam <- cons.struc$bnam
	if(!is.matrix(lin.bounds) || 
			!is.numeric(lin.bounds)) {
		stop("'lin.bounds' is not a numeric matrix")
	}
	if(ncol(lin.bounds) != 2) {
		stop(paste("'lin.bounds' must be a two-column matrix",
			"-- given has", ncol(lin.bounds), "column(s)"))
	}
	bngood <- intersect(bnam, dimnames(lin.bounds)[[1]])
	if(length(bngood) < length(bnam)) {
		if(do.warn["bounds.missing"]) {
			bc.setd <- setdiff(bnam, bngood)
			warning(paste(length(bc.setd),
				"missing row(s) in 'lin.bounds':",
				paste(bc.setd, collapse=", "),
				"-- no constraint on those not",
				"in bounds",
				"('do.warn' suppression is",
				"'bounds.missing')"))
		}
		bounds.con.given <- lin.bounds
		lin.bounds <- array(Inf, c(length(bnam),2),
			list(bnam, NULL))
		lin.bounds[,1] <- -Inf
		lin.bounds[bngood, ] <- bounds.con.given[bngood,]
	} else {
		lin.bounds <- lin.bounds[bnam, , 
			drop=FALSE]
	}
	if(any(is.na(lin.bounds)))
		stop("missing value(s) in 'lin.bounds'")
	if(any(lin.bounds[,1] > lin.bounds[,2])) {
		bou.bad <- dimnames(lin.bounds)[[1]][
			lin.bounds[,1] > lin.bounds[,2]]
		stop(paste("lower bound larger than upper bound in",
			length(bou.bad), "constraints in 'lin.bounds' --",
			paste(bou.bad, collapse=", ")))
	}
	if(any(is.infinite(lin.bounds))) {
		lbi <- rowSums(is.infinite(lin.bounds))
		if(any(lbi == 2)) {
			lbcol <- cons.struc$columns
			lbcallout <- setdiff(unique(lbcol), 
				lbcol[lbi != 2])
		} else lbcallout <- NULL
	} else {
		lbcallout <- NULL
	}
	if(!is.logical(lin.trade)) {
		stop(paste("'lin.trade' must be logical",
			"-- given is", mode(lin.trade)))
	}
	if(any(is.na(lin.trade)))
		stop("missing value(s) in 'lin.trade'")
	if(!is.logical(lin.abs)) {
		stop(paste("'lin.abs' must be logical",
			"-- given is", mode(lin.abs)))
	}
	if(any(is.na(lin.abs)))
		stop("missing value(s) in 'lin.abs'")
	ltlen <- length(lin.trade)
	if(ltlen != nconsmain) {
		if(ltlen != 1) {
			warning(paste("length of 'lin.trade' is",
				ltlen, "-- expecting 1 or", nconsmain))
		}
		lin.trade <- rep(lin.trade, length=nconsmain)
	}
	lalen <- length(lin.abs)
	if(lalen != nconsmain) {
		if(lalen != 1) {
			warning(paste("length of 'lin.abs' is",
				lalen, "-- expecting 1 or", nconsmain))
		}
		lin.abs <- rep(lin.abs, length=nconsmain)
	}
	if(long.only) {
		lin.abs[!lin.trade] <- TRUE
	}
	if(!length(lin.style) || !is.character(lin.style)) {
		stop(paste("'lin.style' must be a character",
			"vector with length greater than zero",
			"-- given has mode", mode(lin.style),
			"and length", length(lin.style)))
	}
	lin.stylemenu <- c("value", "weight", "count", "varfraction",
		"varvalue", "varmbfraction", "varmbvalue")
	lin.stylenum <- pmatch(lin.style, lin.stylemenu, nomatch=0,
		duplicates.ok=TRUE)
	if(any(lin.stylenum == 0)) {
		stop(paste("unknown or ambiguous choice",
			"for 'lin.style' -- allowable choices are:",
			paste(lin.stylemenu, collapse=", ")))
	}
	lslen <- length(lin.style)
	if(lslen != nconsmain) {
		if(lslen != 1) {
			warning(paste("length of 'lin.style' is",
				lslen, "-- expecting 1 or", nconsmain))
		}
		lin.style <- rep(lin.style, length=nconsmain)
	}
	if(any(lin.style == "count" && constrain.levels == 0)) {
		stop(paste("'lin.style' can not be 'count'",
			"with numeric constraint column",
			"-- violated for:",
			paste(dimnames(lin.constraints)[[2]][
			lin.style == "count" & constrain.levels == 0], 
			collapse=", ")))
	}
	lin.stylenum <- rep(lin.stylenum, length=nconsmain)

	if(!length(lin.rfloc)) {
		lin.rfloc <- 0
	} else if(!is.numeric(lin.rfloc) || any(is.na(lin.rfloc))) {
		stop(paste("'lin.rfloc' must be numeric with no misisng",
			"values -- given has mode", mode(lin.rfloc),
			"with", sum(is.na(lin.rfloc)), "missing value(s)"))
	}
	if(length(lin.rfloc) > nconsmain) {
		warning(paste("'lin.rfloc' has length", length(lin.rfloc),
			"but there are only", nconsmain, "main linear",
			"constraints"))
	}
	lin.rfloc <- rep(lin.rfloc, length=nconsmain)
	lin.rfloc[lin.stylenum < 4] <- -1 # lin.stylenum 1-based currently

	if(!length(lin.direction) || !is.numeric(lin.direction)) {
		stop(paste("'lin.direction' must be a numeric",
			"vector containing 0, 1 and/or -1",
			"-- given has mode", mode(lin.direction),
			"and length", length(lin.direction)))
	}
	lin.direction <- round(lin.direction)
	lin.direction <- match(lin.direction, c(-1, 0, 1), 
		nomatch=NA) - 2
	if(any(is.na(lin.direction))) {
		stop("not all values in 'lin.direction' in {0, 1, -1}")
	}
	if(long.only && any(lin.direction == -1)) {
		stop("long only and '-1' in 'lin.direction'")
	}
	ldlen <- length(lin.direction)
	if(ldlen != nconsmain) {
		if(ldlen != 1) {
			warning(paste("length of 'lin.direction' is",
				ldlen, "-- expecting 1 or", nconsmain))
		}
		lin.direction <- rep(lin.direction, length=nconsmain)
	}
	if(any(lin.rfloc >= 0 & !lin.abs & lin.direction == 0)) {
		rfout <- lin.rfloc >= 0 & !lin.abs & lin.direction == 0
		warning(paste(sum(rfout), 
			"case(s) of 'lin.abs' being FALSE with",
			"a variance style -- changing to 'lin.abs' TRUE"))
		lin.abs[rfout] <- TRUE
	}

	if(any(lin.style == "count")) {
		wh.cou <- seq(along=lin.style)[lin.style == "count"]
		wh.bou <- seq(length=nrow(lin.bounds))[match(
			cons.struc$columns, wh.cou, nomatch=0) > 0]
		boucou <- lin.bounds[wh.bou, , drop=FALSE]
		boucouint <- is.finite(boucou) & abs(boucou -
			round(boucou)) < 1e-4 & abs(boucou) < nassets
		if(any(boucouint)) {
			boucounam <- dimnames(boucouint)[[1]][
				boucouint[,1] | boucouint[,2] ]
			warning(paste(sum(boucouint), 
				"bound(s) on count constraints",
				"close to integer-valued",
				"-- you may not get results you",
				"expect, first offending",
				"sub-constraint is:",
				boucounam[1]))
		}
	}

	linconnam <- dimnames(lin.constraints)[[2]]
	if(length(lbcallout)) {
		nconsmain <- nconsmain - length(lbcallout)
		lin.bounds <- lin.bounds[match(lbcol, lbcallout, 
			nomatch=0) == 0, , drop=FALSE]
		linsizes["nconsmain"] <- nconsmain
		linsizes["nconsub"] <- nrow(lin.bounds)
		if(nconsmain == 0) {
			constrainvec <- 0
			lin.style <- lin.style[-lbcallout]
			lin.stylenum <- 0
			lin.trade <- FALSE
			lin.abs <- TRUE
			lin.direction <- 0
			lin.rfloc <- 0
			linconstnames <- NULL
			constrain.levels <- constrain.levels[-lbcallout]
			if(do.warn["infinite.bounds"]) {
				warning(paste("removing all linear",
					"constraints, all infinite",
					"bounds ('do.warn' suppression",
					"is 'infinite.bounds')"))
			}
		} else {
			lcditch <- outer((lbcallout - 1) * nassets, 
				1:nassets, "+")
			constrainvec <- constrainvec[-lcditch]
			lin.style <- lin.style[-lbcallout]
			lin.stylenum <- lin.stylenum[-lbcallout]
			lin.trade <- lin.trade[-lbcallout]
			lin.abs <- lin.abs[-lbcallout]
			lin.direction <- lin.direction[-lbcallout]
			lin.rfloc <- lin.rfloc[-lbcallout]
			linconstnames <- linconstnames[-lbcallout]
			constrain.levels <- constrain.levels[-lbcallout]
			linconnam <- linconnam[-lbcallout]
			if(do.warn["infinite.bounds"]) {
				warning(paste(length(lbcallout),
					"out of", ncol(lin.constraints),
					"linear constraints dropped",
					"due to infinite bounds",
					"('do.warn' suppression is",
					"'infinite.bounds')"))
			}
			lin.constraints <- lin.constraints[, -lbcallout,
				drop=FALSE]
		}
	}
	bounds.infinite <- lin.bounds
	lin.bounds[lin.bounds < -big] <- -big
	lin.bounds[lin.bounds > big] <- big

	list(constrain.levels=constrain.levels, nconsmain=nconsmain, 
		constrainvec=constrainvec, lin.stylenum=lin.stylenum, 
		lin.style=lin.style, lin.direction=lin.direction, 
		linconstnames=linconstnames, lin.trade=lin.trade, 
		lin.abs=lin.abs, lin.rfloc=lin.rfloc,
		lin.constraints=lin.constraints,
		low.constraint=lin.bounds[,1], up.constraint=lin.bounds[,2],
		bounds.infinite=bounds.infinite, linsizes=linsizes)
}

".tradeopt.precost" <-
function(long.buy.cost, long.sell.cost, short.buy.cost, short.sell.cost,
	limit.cost, cost.par, scale.cost, big, nassets, assetnam,
	tradnams, sizes, climit.only=FALSE)
{
	fun.copyright <- "Copyright 2003-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.precost 003"

	usecost <- length(long.buy.cost) + length(long.sell.cost) + 
		length(short.buy.cost) + length(short.sell.cost) 

	csizenam <- c("lbo", "lso", "sbo", "sso", "cost.type", "lsoff", 
		"sboff", "ssoff", "limit.cost")
	costsizes <- rep(0, length(csizenam))
	names(costsizes) <- csizenam
	nocost <- !usecost || (climit.only && !length(limit.cost))

	if(!usecost) {
		if(length(limit.cost)) {
			warning("'limit.cost' given but no costs given")
		}
	}

	## exit if costs not used

	if(nocost) {
		return(list(cost=0, cost.par=0, limit.cost=c(-big, big),
			costsizes=costsizes, cost.intercept=FALSE))
	}

	## costs are used so go about organizing the objects

	long.only <- sizes["long.only"]

	cost.intercept <- FALSE
	if(length(cost.par)) {
		if(!is.numeric(cost.par) || any(is.na(cost.par))) {
			stop(paste("'cost.par' must be numeric with no missing",
				"values -- given has mode", mode(cost.par),
				"length", length(cost.par), "and",
				sum(is.na(cost.par)), "missing value(s)"))
		}
		if(any(is.infinite(cost.par))) {
			stop(paste(sum(is.infinite(cost.par)), 
				"infinite value(s) in 'cost.par'"))
		}
		if(is.matrix(cost.par)) {
			costsizes["cost.type"] <- 3
		} else {
			costsizes["cost.type"] <- 2
		}
	} else {
		costsizes["cost.type"] <- 1
		cost.par <- 0
	}
	if(length(limit.cost)) {
		if(!is.numeric(limit.cost) || length(limit.cost) > 2 ||
				any(is.na(limit.cost))) {
			stop(paste("length of 'limit.cost' must be",
				"0 or 2, numeric with no missing values",
				"-- given has mode", mode(limit.cost),
				"length", length(limit.cost), "and",
				sum(is.na(limit.cost)), "missing value(s)"))
		}
		if(length(limit.cost) == 1) {
			stop("only one value for 'limit.cost' -- need range")
		} else {
			limit.cost <- sort(limit.cost)
			if(limit.cost[1] < -big) limit.cost[1] <- -big
			if(limit.cost[2] > big) limit.cost[2] <- big
		}
		costsizes["limit.cost"] <- as.numeric(limit.cost[2] < 
			big) + 2 * as.numeric(limit.cost[1] > 0)
	} else {
		limit.cost <- c(-big, big)
	}
	if(!length(long.buy.cost)) {
		cost.out <- c("long buys", "long sells", "short buys",
			"short sells")[c(T, !length(long.sell.cost),
			!length(short.buy.cost) && !long.only,
			!length(short.sell.cost) && !long.only)]
		warning(paste("no costs given for:", paste(cost.out,
			collapse=", ")))
	}
	scale.menu <- c("gross", "trade", "none")
	if(!is.character(scale.cost) || length(scale.cost) != 1) {
		stop(paste("'scale.cost' must be a single string",
			"-- given has length", length(scale.cost),
			"and mode", mode(scale.cost)))
	}
	scale.num <- pmatch(scale.cost, scale.menu, nomatch=0)
	if(scale.num == 0) {
		stop(paste("unknown or ambiguous choice for",
			"'scale.cost'", scale.cost, "-- possible choices are:",
			paste(scale.menu, collapse=", ")))
	}
	scale.cost <- scale.menu[scale.num]
	costsizes["scalecost"] <- switch(scale.cost, gross=0, trade=4, 
		none=-1)
	if(length(long.buy.cost)) {
		long.buy.cost <- as.matrix(long.buy.cost)
		if(!is.numeric(long.buy.cost) || any(is.na(long.buy.cost))) {
			stop(paste("'long.buy.cost' must be numeric with",
				"no missing values -- given has mode", 
				mode(long.buy.cost), "length",
				length(long.buy.cost), "and", 
				sum(is.na(long.buy.cost)), "missing value(s)"))
		}
		if(any(is.infinite(long.buy.cost))) {
			stop(paste(sum(is.infinite(long.buy.cost)),
				"infinite value(s) in 'long.buy.cost'"))
		}
		lbcnam <- dimnames(long.buy.cost)[[1]]
		if(!length(lbcnam) && nrow(long.buy.cost) != nassets) {
			stop(paste("wrong size for 'long.buy.cost'",
				"-- should have", nassets, 
				"assets, has", nrow(long.buy.cost)))
		}
		if(length(lbcnam)) {
			if(any(duplicated(lbcnam))) {
				stop(paste(sum(duplicated(lbcnam)), 
					"duplicate names in",
					"'long.buy.cost'"))
			}
			ilbcn <- intersect(lbcnam, assetnam)
			if(length(ilbcn) == nassets) {
				long.buy.cost <- long.buy.cost[assetnam,
					, drop=FALSE]
			} else {
				if(length(intersect(ilbcn, tradnams)) <
						length(tradnams)) {
				  stop(paste("'long.buy.cost' does not",
				    "include all tradable assets",
				    "-- missing", length(tradnams) -
				    length(intersect(ilbcn, tradnams))))
				}
				lbcgiv <- long.buy.cost[ilbcn,,
					drop=FALSE]
				long.buy.cost <- array(0, c(nassets,
					ncol(lbcgiv)), list(assetnam,
					NULL))
				long.buy.cost[tradnams,] <- lbcgiv[
					tradnams,]
			}
		} else {
			if(do.warn["no.asset.names"]) {
				warning(paste("no asset names on",
					"'long.buy.cost', assuming correct",
					"order ('do.warn' suppression is",
					"'no.asset.names')"))
			}
		}
		costsizes["lbo"] <- ncol(long.buy.cost)
		if(costsizes["lbo"] > 1 && any(abs(long.buy.cost[,1] > 
				1e-15))) {
			cost.intercept <- TRUE
		}
		costsizes["lsoff"] <- length(long.buy.cost)
		cost <- t(long.buy.cost)
	} else {
		if(!is.null(long.buy.cost) && 
				!is.numeric(long.buy.cost)) {
			stop(paste("bad value for 'long.buy.cost'",
				"given has mode", mode(long.buy..cost),
				"and length", length(long.buy.cost)))
		}
		costsizes["lbo"] <- 0
		costsizes["lsoff"] <- 0
		cost <- NULL
	}
	if(length(long.sell.cost)) {
		long.sell.cost <- as.matrix(long.sell.cost)
		if(!is.numeric(long.sell.cost) || any(is.na(long.sell.cost))) {
			stop(paste("'long.sell.cost' must be numeric with",
				"no missing values -- given has mode", 
				mode(long.sell.cost), "length",
				length(long.sell.cost), "and", 
				sum(is.na(long.sell.cost)), "missing value(s)"))
		}
		if(any(is.infinite(long.sell.cost))) {
			stop(paste(sum(is.infinite(long.sell.cost)),
				"infinite value(s) in 'long.sell.cost'"))
		}
		lscnam <- dimnames(long.sell.cost)[[1]]
		if(!length(lscnam) && nrow(long.sell.cost) != nassets) {
			stop(paste("wrong size for 'long.sell.cost'",
				"-- should represent", nassets, 
				"assets, given has", 
				nrow(long.sell.cost)))
		}
		if(length(lscnam)) {
			if(any(duplicated(lscnam))) {
				stop(paste(sum(duplicated(lscnam)),
					"duplicate names in",
					"'long.sell.cost'"))
			}
			ilscn <- intersect(lscnam, assetnam)
			if(length(ilscn) == nassets) {
				long.sell.cost <- long.sell.cost[
					assetnam, , drop=FALSE]
			} else {
				if(length(intersect(ilscn, tradnams)) <
						length(tradnams)) {
				  stop(paste("'long.sell.cost' does",
				    "not include all tradable assets",
				    "-- missing", length(tradnams) -
				    length(intersect(ilscn, 
				    tradnams))))
				}
				lscgiv <- long.sell.cost[ilscn,,
					drop=FALSE]
				long.sell.cost <- array(0, c(nassets,
					ncol(lscgiv)), list(assetnam,
					NULL))
				long.sell.cost[tradnams,] <- lscgiv[
					tradnams,]
			}
		} else {
			if(do.warn["no.asset.names"]) {
				warning(paste("no asset names on",
					"'long.sell.cost', assuming correct",
					"order ('do.warn' suppression is",
					"'no.asset.names')"))
			}
		}

		cost <- c(cost, t(long.sell.cost))
		costsizes["lso"] <- ncol(long.sell.cost)
		if(costsizes["lso"] > 1 && any(abs(long.sell.cost[,1] > 
				1e-15))) {
			cost.intercept <- TRUE
		}
	} else {
		if(!is.null(long.sell.cost) && 
				!is.numeric(long.sell.cost)) {
			stop(paste("bad value for 'long.sell.cost'",
				"-- given has mode", 
				mode(long.sell.cost), "and length",
				length(long.sell.cost)))
		}
		costsizes["lso"] <- 0
	}
	costsizes["sboff"] <- costsizes["lsoff"] + length(long.sell.cost)
	if(!long.only && length(short.buy.cost)) {
		short.buy.cost <- as.matrix(short.buy.cost)
		if(!is.numeric(short.buy.cost) || any(is.na(short.buy.cost))) {
			stop(paste("'short.buy.cost' must be numeric with",
				"no missing values -- given has mode", 
				mode(short.buy.cost), "length",
				length(short.buy.cost), "and", 
				sum(is.na(short.buy.cost)), "missing value(s)"))
		}
		if(any(is.infinite(short.buy.cost))) {
			stop(paste(sum(is.infinite(short.buy.cost)),
				"infinite value(s) in 'short.buy.cost'"))
		}
		sbcnam <- dimnames(short.buy.cost)[[1]]
		if(!length(sbcnam) && nrow(short.buy.cost) != nassets) {
			stop(paste("wrong size for 'short.buy.cost'",
				"-- should represent", nassets, 
				"assets, given represents",
				nrow(short.buy.cost)))
		}
		if(length(sbcnam)) {
			if(any(duplicated(sbcnam))) {
				stop(paste(sum(duplicated(sbcnam)),
					"duplicate names in",
					"'short.buy.cost'"))
			}
			isbcn <- intersect(sbcnam, assetnam)
			if(length(isbcn) == nassets) {
				short.buy.cost <- short.buy.cost[
					assetnam, , drop=FALSE]
			} else {
				if(length(intersect(isbcn, tradnams)) <
						length(tradnams)) {
				  stop(paste("'short.buy.cost' does",
				    "not include all tradable assets",
				    "-- missing", length(tradnams) -
				    length(intersect(isbcn, tradnams))))
				}
				sbcgiv <- short.buy.cost[isbcn,,
					drop=FALSE]
				short.buy.cost <- array(0, c(nassets,
					ncol(sbcgiv)), list(assetnam,
					NULL))
				short.buy.cost[tradnams,] <- sbcgiv[
					tradnams,]
			}
		} else {
			if(do.warn["no.asset.names"]) {
				warning(paste("no asset names on",
					"'short.buy.cost', assuming correct",
					"order ('do.warn' suppression is",
					"'no.asset.names')"))
			}
		}
		cost <- c(cost, t(short.buy.cost))
		costsizes["sbo"] <- ncol(short.buy.cost)
		if(costsizes["sbo"] > 1 && any(abs(short.buy.cost[,1] > 
				1e-15))) {
			cost.intercept <- TRUE
		}
	} else {
		if(long.only) short.buy.cost <- NULL
		if(!is.null(short.buy.cost) && 
				!is.numeric(short.buy.cost)) {
			stop(paste("bad value for 'short.buy.cost'",
				"-- given has mode", 
				mode(short.buy.cost), "and length",
				length(short.buy.cost)))
		}
		costsizes["sbo"] <- 0
	}
	costsizes["ssoff"] <- costsizes["sboff"] + length(short.buy.cost)
	if(!long.only && length(short.sell.cost)) {
		short.sell.cost <- as.matrix(short.sell.cost)
		if(!is.numeric(short.sell.cost) || 
				any(is.na(short.sell.cost))) {
			stop(paste("'short.sell.cost' must be numeric with",
				"no missing values -- given has mode", 
				mode(short.sell.cost), "length",
				length(short.sell.cost), "and", 
				sum(is.na(short.sell.cost)), 
				"missing value(s)"))
		}
		if(any(is.infinite(short.sell.cost))) {
			stop(paste(sum(is.infinite(short.sell.cost)),
				"infinite value(s) in 'short.sell.cost'"))
		}
		sscnam <- dimnames(short.sell.cost)[[1]]
		if(!length(sscnam) && nrow(short.sell.cost) != nassets){
			stop(paste("wrong size for 'short.sell.cost'",
				"-- should represent", nassets,
				"assets, given represent", 
				nrow(short.sell.cost)))
		}
		if(length(sscnam)) {
			if(any(duplicated(sscnam))) {
				stop(paste(sum(duplicated(sscnam)),
					"duplicate names in",
					"'short.sell.cost'"))
			}
			isscn <- intersect(sscnam, assetnam)
			if(length(isscn) == nassets) {
				short.sell.cost <- short.sell.cost[
					assetnam, , drop=FALSE]
			} else {
				if(length(intersect(isscn, tradnams)) <
						length(tradnams)) {
				  stop(paste("'short.sell.cost' does",
				    "not include all tradable assets",
				    "-- given is missing", 
				    length(tradnams) - length(intersect(
				    isscn, tradnams))))
				}
				sscgiv <- short.sell.cost[isscn,,
					drop=FALSE]
				short.sell.cost <- array(0, c(nassets,
					ncol(sscgiv)), list(assetnam,
					NULL))
				short.sell.cost[tradnams,] <- sscgiv[
					tradnams,]
			}
		} else {
			if(do.warn["no.asset.names"]) {
				warning(paste("no asset names on",
					"'short.sell.cost', assuming correct",
					"order ('do.warn' suppression is",
					"'no.asset.names')"))
			}
		}

		cost <- c(cost, t(short.sell.cost))
		costsizes["sso"] <- ncol(short.sell.cost)
		if(costsizes["sso"] > 1 && any(abs(short.sell.cost[,1] > 
				1e-15))) {
			cost.intercept <- TRUE
		}
	} else {
		if(long.only) short.sell.cost <- NULL
		if(!is.null(short.sell.cost) && 
				!is.numeric(short.sell.cost)) {
			stop(paste("bad value for 'short.sell.cost'",
				"-- given has mode", 
				mode(short.sell.cost), "and length",
				length(short.sell.cost)))
		}
		costsizes["sso"] <- 0
	}
	if(costsizes["cost.type"] > 1) {
		if(costsizes["cost.type"] == 3) {
			lcp <- ncol(cost.par)
		} else {
			lcp <- length(cost.par)
		}
		dcp <- costsizes[c("lbo", "lso", "sbo", "sso")] - lcp
		if(long.only) {
			if(any(dcp[1:2] != 0)) {
				stop(paste("'long.buy.cost' and",
					"'long.sell.cost' must both",
					"have", lcp, 
					"columns to match 'cost.par'",
					"-- 'long.buy.cost' has",
					costsizes["lbo"], 
					"and 'long.sell.cost' has",
					costsizes["lso"]))
			}
		} else {
			if(any(dcp != 0)) {
				stop(paste("all costs must have",
					lcp,
					"column(s) to match 'cost.par'",
					"-- 'long.buy.cost' has",
					costsizes["lbo"], 
					"'long.sell.cost' has",
					costsizes["lso"],
					"'short.buy.cost' has",
					costsizes["sbo"], 
					"'short.sell.cost' has",
					costsizes["sso"]))
			}
		}
	}
	if(costsizes["cost.type"] == 3) {
		cpnam <- dimnames(cost.par)[[1]]
		if(!length(cpnam) && nrow(cost.par) != nassets){
			stop(paste("wrong size for 'cost.par'",
				"-- should represent", nassets,
				"assets, given represent", 
				nrow(cost.par)))
		}
		if(length(cpnam)) {
			if(any(duplicated(cpnam))) {
				stop(paste(sum(duplicated(cpnam)),
					"duplicate names in",
					"'cost.par'"))
			}
			icpn <- intersect(cpnam, assetnam)
			if(length(icpn) == nassets) {
				cost.par <- cost.par[
					assetnam, , drop=FALSE]
			} else {
				if(length(intersect(icpn, tradnams)) <
						length(tradnams)) {
				  stop(paste("'cost.par' does",
				    "not include all tradable assets",
				    "-- given is missing", 
				    length(tradnams) - length(intersect(
				    icpn, tradnams))))
				}
				cpgiv <- cost.par[icpn,, drop=FALSE]
				cost.par <- array(0, c(nassets,
					ncol(cpgiv)), list(assetnam,
					NULL))
				cost.par[tradnams,] <- cpgiv[tradnams,]
			}
		} 
		cost.par <- t(cost.par)
	}
	list(cost=cost, cost.par=cost.par, limit.cost=limit.cost,
		costsizes=costsizes, cost.intercept=cost.intercept)
}

".tradeopt.preriskfrac" <-
function (risk.fraction, rf.style, rf.loc, nvar, nvarcomben, nassets, assetnam, 
	maxps, vtable, dwarn, big)
{
	fun.copyright <- "Copyright 2011-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.preriskfrac 003"

	style.menu <- c("fraction", "value", "marginalbench", "valmargbench",
		"corport", "abscorport")

	if(!length(risk.fraction)) {
		# exit since no risk fraction constraints
		return(list(rfracactive=rep(0, nvarcomben), rfracvec=1, 
			rfstynum=0, rf.style=NULL, rf.stylemenu=style.menu))
	}

	## continue on -- there are risk.fraction constraints

	if(!is.numeric(risk.fraction)) {
		stop(paste("'risk.fraction' must be numeric -- given",
			"has mode", mode(risk.fraction), "and length",
			length(risk.fraction)))
	}
	if(any(is.na(risk.fraction))) {
		stop(paste("missing values not allowed in 'risk.fraction'",
			"-- given has", sum(is.na(risk.fraction)),
			"missing value(s)"))
	}
	if(!nvar) {
		stop(paste("'risk.fraction' not allowed when",
			"'variance' is not given"))
	}

	if(!is.character(rf.style)) {
		stop(paste("'rf.style' needs to be character",
			"-- given is mode", mode(rf.style), "and length",
			length(rf.style)))
	}
	rfstynum <- pmatch(rf.style, style.menu, nomatch=0, duplicates.ok=TRUE)
	if(any(rfstynum == 0)) {
		stop(paste("unknown or ambiguous value(s) in 'rf.style' --",
			"allowable values are:", 
			paste(style.menu, collapse=", ")))
	}
	rf.style <- style.menu[rfstynum]
	rfstynum <- rfstynum - 1

	if(length(rf.loc)) {
		if(!is.numeric(rf.loc) || any(is.na(rf.loc))) {
			stop(paste("'rf.loc' must be numeric with no",
				"missing values -- given has mode",
				mode(rf.loc), "length", length(rf.loc),
				"and has", sum(is.na(rf.loc)), 
				"missing values"))
		}
		if(min(rf.loc) < 0 || max(rf.loc) >= nvarcomben) {
			stop(paste("'rf.loc' must have values from zero to",
				nvarcomben - 1, "-- given has values from",
				min(rf.loc), "to", max(rf.loc)))
		}
		if(min(rf.loc) > 0 && dwarn[["index.zero"]]) {
			warning(paste("'rf.loc' is zero-based, you may be",
				"assuming one-based ('do.warn' suppression",
				"is 'index.zero')"))
		}
	}

	rflen <- max(1, length(rfstynum), length(rf.loc))
	rfstynum <- rep(rfstynum, length=rflen)
	if(length(rf.loc)) {
		rfloc <- rep(rf.loc, length=rflen)
	} else {
		rfloc <- rep(0, rflen)
	}
	if(length(unique(paste(rfloc, rfstynum, sep="@@"))) < rflen) {
		stop(paste("bad specification for risk fraction types",
			"-- duplicate values for 'rf.loc' and 'rf.style'",
			"combination"))
	}
	rfracactive <- rep(0, nvarcomben)
	rfracactive[unique(rfloc)+1] <- 1
	useben <- vtable[2, rfloc + 1] >= 0

	rfd <- dim(risk.fraction)
	fracstyone <- rfstynum %% 2 == 0 | rfstynum %in% 4:5
	fracstysum <- rfstynum %% 2 == 0 & !(rfstynum %in% 4:5)
	if(length(risk.fraction) == 1 && !length(rfd) && 
			!length(names(risk.fraction))) {
		# single number
		if(risk.fraction <= 0) {
			stop(paste("the value for 'risk.fraction'",
				"must be positive when a single number",
				"-- given value is", risk.fraction))
		} else {
			if(all(fracstyone) && risk.fraction >= 1 &&
					dwarn[["superfluous.constraint"]]) {
				# no risk fraction constraints
				warning(paste("no constraints imposed",
					"by this 'risk.fraction'",
					"('do.warn' suppression is",
					"'superfluous.constraint')"))
			}
			if(nvarcomben > 1 && !length(rf.loc) && 
					dwarn[["riskfrac.part"]]) {
				warning(paste("this specification of",
					"'risk.fraction' only applies",
					"to the first variance",
					"combination ('do.warn' suppression",
					"is 'riskfrac.part')"))
			}
			if(any(fracstysum & !useben) && risk.fraction * maxps 
					< 1) {
				stop(paste("'risk.fraction' (", risk.fraction,
					") is too ",
					"small as the maximum portfolio ",
					"size is ", maxps, sep=""))
			}
			rfracvec <- c(rep(-big, nassets), 
				rep(risk.fraction, nassets))
		}
		if(rflen > 1 && length(rfracvec) > 1) {
			rfracvec <- rep(rfracvec, rflen)
		}
	} else if(is.null(rfd)) {
		# single vector
		if(nvarcomben > 1 && dwarn[["riskfrac.part"]]) {
			warning(paste("this specification of",
				"'risk.fraction' only applies",
				"to the first variance combination",
				"('do.warn' suppression is 'riskfrac.part')"))
		}
		rfnam <- names(risk.fraction)
		if(!length(rfnam)) {
			stop(paste("this specification of",
				"'risk.fraction' requires asset names"))
		}
		rfoutnam <- setdiff(rfnam, assetnam)
		rfoutnamlen <- length(rfoutnam)
		if(rfoutnamlen && rfoutnamlen < 6) {
			stop(paste("'risk.fraction' has", rfoutnamlen,
				"name(s) outside the universe:",
				paste(rfoutnam, collapse=", ")))
		} else if(rfoutnamlen >= 6) {
			stop(paste("'risk.fraction' has", rfoutnamlen,
				"names outside the universe",
				"the first few are:", 
				paste(rfoutnam[1:5], collapse=", ")))
		}
		if(any(duplicated(rfnam))) {
			rfndup <- rfnam[duplicated(rfnam)]
			if(length(rfndup) > 5) {
				stop(paste(length(rfndup), 
					"duplicated asset name(s) in",
					"'risk.fraction' -- first",
					"few are:", paste(rfndup[1:5],
					collapse=", ")))
			} else {
				stop(paste(length(rfndup), 
					"aduplicated sset name(s) in",
					"'risk.fraction':",
					paste(rfndup,
					collapse=", ")))
			}
		}
		if(length(risk.fraction) == nassets) {
			# since we are ruling out extraneous assets
			# all the universe must be present
			risk.fraction <- risk.fraction[assetnam]
			if(all(fracstysum & !useben)) {
				risk.fraction[risk.fraction > 1] <- 1
				if(sum(rev(sort(risk.fraction))[
						1:maxps]) < 1) {
					stop(paste("'risk.fraction'",
					  "too small for maximum",
					  "port size", maxps,
					  "the biggest constraints sum to",
					  sum(rev(sort(risk.fraction))[
					  1:maxps])))
				}
			}
			if(all(fracstyone) && all(risk.fraction >= 1) &&
					dwarn[["superfluous.constraint"]]) {
				warning(paste("no constraints imposed",
					"by this 'risk.fraction'",
					"('do.warn' suppression is",
					"'superfluous.constraint')"))
			}
			rfracvec <- c(rep(-big, nassets), risk.fraction)
		} else {
			# short vector with names
			rfracvec <- cbind(-1, rep(1, nassets))
			dimnames(rfracvec) <- list(assetnam, NULL)
			risk.fraction[risk.fraction > 1] <- 1
			rfracvec[names(risk.fraction), 2] <- risk.fraction
			if(all(fracstyone) && all(risk.fraction >= 1 &&
					dwarn[["superfluous.constraint"]])) {
				# no risk fraction constraints
				warning(paste("no constraints imposed",
					"by this 'risk.fraction'",
					"('do.warn' suppression is",
					"'superfluous.constraint')"))
			}
		}
		if(rflen > 1 && length(rfracvec) > 1) {
			rfracvec <- rep(rfracvec, rflen)
		}
	} else {
		# risk.fraction has a dim
		if(rfd[2] != 2) {
			stop(paste("when 'risk.fraction' has dimensions",
				"the second dimension must be 2",
				"-- given has", rfd[2]))
		}
		if(length(rfd) != 2 && length(rfd) != 3) {
			stop(paste("when 'risk.fraction' is an array,",
				"it must have a dim of length 2 or 3",
				"-- given has dim length", length(rfd)))
		} else if(all(fracstyone)) {
			risk.fraction[risk.fraction < -1] <- -1
			risk.fraction[risk.fraction > 1] <- 1
		}
		rfnam <- dimnames(risk.fraction)[[1]]
		if(!length(rfnam)) {
			if(rfd[1] == nassets) {
			    # test everything is equal
			    if(length(rfd) == 2) {
				if(all(risk.fraction[,1] == 
					   risk.fraction[1,1]) && 
					   all(risk.fraction[,2] == 
					   risk.fraction[1,2])) {
					rfnonamok <- TRUE
				} else {
					rfnonamok <- FALSE
				}
			    } else {
				# 3D array
				rfnonamok <- TRUE
				for(r3 in 1:rfd[3]) {
				    if(any(risk.fraction[,2,r3] !=
					   risk.fraction[1,2,r3])) {
					rfnonamok <- FALSE
					break
				    }
				    if(any(risk.fraction[,1,r3] !=
					   risk.fraction[1,1,r3])) {
					rfnonamok <- FALSE
					break
				    }
				}
			    }
			} else {
				rfnonamok <- FALSE
			}
			if(rfnonamok) {
			   rfnam <- assetnam
			   if(length(rfd) == 2) {
				dimnames(risk.fraction) <- list(assetnam,
					NULL)
			   } else {
				dimnames(risk.fraction) <- list(assetnam,
					NULL, NULL)
			   }
			} else {
			    stop(paste("this specification of",
				"'risk.fraction' requires asset names",
				"(as row names)"))
			}
		}
		if(any(duplicated(rfnam))) {
			rfndup <- rfnam[duplicated(rfnam)]
			if(length(rfndup) > 5) {
				stop(paste(length(rfndup), 
					"duplicated asset name(s) in",
					"'risk.fraction' -- first",
					"few are:", paste(rfndup[1:5],
					collapse=", ")))
			} else {
				stop(paste(length(rfndup), 
					"duplicated asset name(s) in",
					"'risk.fraction':",
					paste(rfndup,
					collapse=", ")))
			}
		}
		rfoutnam <- setdiff(rfnam, assetnam)
		rfoutnamlen <- length(rfoutnam)
		if(rfoutnamlen && rfoutnamlen < 6) {
			stop(paste("'risk.fraction' has", rfoutnamlen,
				"name(s) outside the universe:",
				paste(rfoutnam, collapse=", ")))
		} else if(rfoutnamlen >= 6) {
			stop(paste("'risk.fraction' has", rfoutnamlen,
				"names outside the universe",
				"the first few are:", 
				paste(rfoutnam[1:5], collapse=", ")))
		}
		if(length(rfd) == 3) {
			# 3D array
			if(rfd[3] > rflen) {
				if(rflen == 1) {
				   if(rfd[3] <= nvarcomben) {
					rflen <- rfd[3]
					rfloc <- seq(0, length=rflen)
					rfstynum <- rep(rfstynum, length=rflen)
					rf.style <- rep(rf.style, length=rflen)
					rfracactive[rfloc + 1] <- 1
				   } else {
				      stop(paste("third dimension of",
					"'risk.fraction' is", rfd[3],
					"but only", nvarcomben, 
					"variance benchmark combination(s)"))
				   }
				} else {
				   stop(paste("third dimension of",
					"'risk.fraction' is", rfd[3],
					"but only", rflen, 
					"risk fraction combination(s)"))
				}
			}
			if(rfd[1] != nassets) {
				# need to expand to full size
				rfrac.given <- risk.fraction
				rfd[1] <- nassets
				risk.fraction <- array(big, rfd, list(
					assetnam, NULL, NULL))
				risk.fraction[,1,] <- -big
				risk.fraction[dimnames(rfrac.given)[[1]],
					,] <- rfrac.given
			} else {
				# put into correct order
				risk.fraction <- risk.fraction[assetnam,
					,, drop=FALSE]
			}
			if(rfd[3] < rflen) {
				risk.fraction <- array(risk.fraction,
					c(nassets, 2, rflen), 
					list(assetnam, NULL, NULL))
				rfd[3] <- rflen
			}
			for(rj in 1:rfd[3]) {
			  if(fracstyone[rj] && all(risk.fraction[,2, rj] >= 1) 
				   && all(risk.fraction[,1, rj] <= -1)) {
				next
			  } 
			  rfbad <- sum(risk.fraction[,1, rj] > 
				risk.fraction[,2, rj])
			  if(rfbad) {
				stop(paste(rfbad, 
					"rows in slice", rj,
					"of 'risk.fraction'",
					"have the first column greater",
					"than the second"))
			  }
			  if(fracstysum[rj] && !useben[rj] &&  
					sum(rev(sort(pmin(1,
					risk.fraction[,2,rj])))[
					1:maxps]) < 1) {
				stop(paste("max 'risk.fraction'",
				  "values too small in slice", rj, 
				  "for maximum port size", maxps,
				  "the biggest constraints sum to",
			  	  sum(rev(sort(pmin(1, risk.fraction[,2,rj])))[
				  1:maxps])))
			  }
			}
			rfracvec <- as.vector(risk.fraction)
		} else {
			# risk.fraction is matrix, not 3D
			if(nvarcomben > 1 && !length(rf.loc) && 
				dwarn[["riskfrac.part"]]) {
			  warning(paste("this specification of",
				"'risk.fraction' only applies",
				"to the first variance combination",
				"('do.warn' suppression is 'riskfrac.part')"))
			}
			if(rfd[1] != nassets) {
				# need to expand to full size
				rfrac.given <- risk.fraction
				rfd[1] <- nassets
				risk.fraction <- array(big, rfd, list(
					assetnam, NULL))
				risk.fraction[,1] <- -big
				risk.fraction[dimnames(rfrac.given)[[1]],
					] <- rfrac.given
			} else {
				# put into correct order
				risk.fraction <- risk.fraction[assetnam,
					, drop=FALSE]
			}
			if(all(fracstyone) && all(risk.fraction[,2] >= 1) && 
					all(risk.fraction[,1] <= -1) &&
					dwarn[["superfluous.constraint"]]) {
				warning(paste("no constraints imposed",
					"by this 'risk.fraction'",
					"('do.warn' suppression is",
					"'superfluous.constraint')"))
			}
			rfracvec <- as.vector(risk.fraction)
			rfbad <- sum(risk.fraction[,1] > 
				risk.fraction[,2])
			if(rfbad) {
				stop(paste(rfbad, 
					"rows in 'risk.fraction'",
					"have the first column greater",
					"than the second"))
			}
			if(all(fracstysum & !useben) && sum(rev(sort(pmin(1, 
					risk.fraction[,2])))[
					1:maxps]) < 1) {
				stop(paste("max 'risk.fraction'",
				  "values are too small",
				  "for maximum port size", maxps,
				  "the largest constraints sum to",
				  sum(rev(sort(pmin(1, risk.fraction[,2])))[
				  1:maxps])))
			}
			if(rflen > 1 && length(rfracvec) > 1) {
				rfracvec <- rep(rfracvec, rflen)
			}
		}

	}
	if(length(rfracvec) == 1) {
		rfracactive[] <- 0
	} else {
		rfracvec[rfracvec < -big] <- -big
		rfracvec[rfracvec > big] <- big
	}
	list(rfracactive=rfracactive, rfracvec=rfracvec, rfstynum=rfstynum,
		rfloc=rfloc, rf.style=rf.style, rf.stylemenu=style.menu)
}

".tradeopt.alphaben" <-
function(bennam, benwt, nret, alphanam, expected.return, dowarn) {
	fun.copyright <- "Copyright 2003-2011 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.alphaben 002"

	if(!nret) return(expected.return)
	bena <- benwt %*% expected.return[names(benwt), , drop=FALSE]
	if(match(bennam, alphanam, nomatch=0) > 0) {
		obena <- expected.return[bennam,]
		baaq <- all.equal(as.vector(obena), as.vector(bena))
		if(dowarn && (!is.logical(baaq) || !baaq)) {
			warning(paste("'bench.weights' for", bennam,
				"imply different expected return",
				"than given value -- given is used",
				"('do.warn' suppression is",
				"'alpha.benchmark')"))
		}
	} else {
		expected.return[bennam, ] <- bena
	}
	expected.return
}

".tradeopt.varben" <-
function(bennam, benwt, nvar, variance, dowarn) {
	fun.copyright <- "Copyright 2003-2011 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.varben 002"

	lwt <- variance[,1,1]
	wnam <- names(lwt[!is.na(lwt)])
	lwt <- lwt[wnam]
	lwt[] <- 0
	lwt[names(benwt)] <- benwt
	for(i in 1:nvar) {
		bcov <- drop(variance[wnam,wnam,i] %*% lwt)
		bcex <- variance[bennam,wnam , i]
		if(any(is.na(bcex))) {
			variance[bennam,wnam , i] <- bcov
			variance[wnam, bennam, i] <- bcov
			variance[bennam, bennam, i] <- sum(lwt * bcov)
		} else {
			bcaq <- all.equal(as.vector(bcov), as.vector(bcex))
			if(dowarn && (!is.logical(bcaq) || !bcaq)) {
				warning(paste("'bench.weights' for", 
				   bennam,
				   "imply different covariances",
				   "than given values -- given are used",
				   "('do.warn' suppression is",
				   "'variance.benchmark')"))
			}
		}
	}
	variance
}

".unpack.violcode" <-
function(violcode) {
	fun.copyright <- "Copyright 2003-2011 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".unpack.violcode 001"

	ans <- character(0)
       	if(violcode >= 4194304) {
       		warning(paste("'violcode' is too large"))
       		violcode <- violcode - 4194304
	}
	if(violcode >= 2097152) {
		ans <- c(ans, "risk fraction")
		violcode <- violcode - 2097152
	}
	if(violcode >= 1048576) {
		ans <- c(ans, "distance")
		violcode <- violcode - 1048576
	}
	if(violcode >= 524288) {
		ans <- c(ans, "min ntrade")
		violcode <- violcode - 524288
	}
	if(violcode >= 262144) {
		ans <- c(ans, "forced trade")
		violcode <- violcode - 262144
	}
	if(violcode >= 131072) {
		ans <- c(ans, "close")
		violcode <- violcode - 131072
	}
	if(violcode >= 65536) {
		ans <- c(ans, "cost")
		violcode <- violcode - 65536
	}
	if(violcode >= 32768) {
		ans <- c(ans, "threshold")
		violcode <- violcode - 32768
	}
	if(violcode >= 16384) {
		ans <- c(ans, "sum of weights")
		violcode <- violcode - 16384
	}
	if(violcode >= 8192) {
		ans <- c(ans, "alpha")
		violcode <- violcode - 8192
	}
	if(violcode >= 4096) {
		ans <- c(ans, "variance")
		violcode <- violcode - 4096
	}
	if(violcode >= 2048) {
		ans <- c(ans, "portfolio size")
		violcode <- violcode - 2048
	}
	if(violcode >= 1024) {
		ans <- c(ans, "linear")
		violcode <- violcode - 1024
	}
	if(violcode >= 512) {
		ans <- c(ans, "max turnover")
		violcode <- violcode - 512
	}
	if(violcode >= 256) {
		ans <- c(ans, "min turnover")
		violcode <- violcode - 256
	}
	if(violcode >= 128) {
		ans <- c(ans, "short value")
		violcode <- violcode - 128
	}
	if(violcode >= 32) {
		ans <- c(ans, "long value")
		violcode <- violcode - 32
	}
	if(violcode >= 8) {
		ans <- c(ans, "net value")
		violcode <- violcode - 8
	}
	if(violcode >= 2) {
		ans <- c(ans, "gross value")
	}
	ans
}

".tradeopt.rectify.start" <-
function(start.sol, ntrade, assetnam, trade.univ, sharetol) {
	fun.copyright <- "Copyright 2003-2011 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.rectify.start 001"

	if(!is.list(start.sol)) {
		if(is.numeric(start.sol) && 
				length(names(start.sol))) {
			start.sol <- list(start.sol)
		} else {
			stop(paste("bad value for 'start.sol'",
				"-- given has mode",
				mode(start.sol), "and length",
				length(start.sol)))
		}
	}
	popgiven <- length(start.sol)
	shares <- id <- array(0, c(ntrade, popgiven))
	bad <- rep(FALSE, popgiven)
	for(i in 1:popgiven) {
		t.sh <- start.sol[[i]]
		if(any(is.na(t.sh))) 
			stop("missing value in 'start.sol'")
		if(!all(abs(t.sh) < sharetol)) {
			t.sh <- t.sh[abs(t.sh) >= sharetol]
		} else {
			t.sh[] <- 0
		}
		t.nam <- names(t.sh)
		g.nam <- unique(intersect(t.nam, assetnam))
		lg <- length(g.nam)
		if(!lg) {
			bad[i] <- TRUE
			next
		}
		if(lg == ntrade) {
			NULL
		} else if(lg > ntrade) {
			g.nam <- sample(g.nam, ntrade, 
				replace=FALSE)
		} else {
			# lg is too small
			tumod <- trade.univ
			tumod[g.nam] <- 0
			tradok <- assetnam[tumod > 0]
			# workaround for sample bug
			if(length(tradok) == 1) {
				gn.nam <- tradok
			} else {
				gn.nam <- sample(tradok, 
					ntrade - lg, 
					replace=FALSE)
			}
			t.sh <- c(t.sh[g.nam], rep(0, ntrade - lg))
			g.nam <- c(g.nam, gn.nam)
			names(t.sh) <- g.nam
		}
		id[, i] <- match(g.nam, assetnam) - 1
		shares[,i] <- t.sh[g.nam]
	}
	if(all(bad)) {
		warning("no suitable trades in 'start.sol' -- ignored")
		list(id=0, shares=0)
	} else {
		list(id=id[, !bad, drop=FALSE], shares=
			shares[, !bad, drop=FALSE])
	}
}

"trade.optimizer.pre" <-
function (prices, variance=NULL, expected.return=NULL, existing=NULL, 
	gross.value=NULL, net.value=NULL, long.value=NULL, short.value=NULL, 
	turnover=NULL, long.only=FALSE, max.weight=1, universe.trade=NULL, 
	lower.trade=NULL, upper.trade=NULL, risk.fraction=NULL, 
	rf.style="fraction", rf.loc=NULL, ntrade=NULL, port.size=NULL, 
	threshold=NULL, forced.trade=NULL, positions=NULL, tol.positions=0, 
	lin.constraints=NULL, lin.bounds=NULL, lin.trade=FALSE, lin.abs=TRUE, 
	lin.style="weight", lin.direction=0, lin.rfloc=NULL,
	alpha.constraint=NULL, var.constraint=NULL, bench.constraint=NULL, 
	dist.center=NULL, dist.style="weight", dist.bounds=NULL, 
	dist.trade=FALSE, dist.utility=FALSE, dist.prices=NULL, 
	sum.weight=NULL, limit.cost=NULL, close.number=NULL, 
	utility=NULL, risk.aversion=1, 
	benchmark=NULL, bench.trade=FALSE, bench.weights=NULL, 
	long.buy.cost=NULL, long.sell.cost=long.buy.cost, 
	short.buy.cost=long.buy.cost, short.sell.cost=long.buy.cost, 
	cost.par=NULL, scale.cost="gross", 
	start.sol=NULL, allowance=.9999, do.warn=NULL, penalty.constraint=1000,
	quantile=0.5, dest.wt=NULL, utable=NULL, atable=NULL, vtable=NULL, 
	dumpfile="", ..., seed, control, climit.only=FALSE, Mc) 
{
	fun.copyright <- "Copyright 2003-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- "trade.optimizer.pre 004"

	sub.range <- function(x) {
		if(any(is.na(x))) {
			if(all(is.na(x))) {
				c(0, 0)
			} else {
				c(-Inf, Inf)
			}
		} else if(any(is.infinite(x))) {
			if(all(is.infinite(x)) && diff(range(sign(x))) == 0) {
				c(0, 0)
			} else {
				range(x)
			}
		} else {
			range(x)
		}
	}

	if(!length(seed)) {
		seed <- seed.BurSt()
	} else if(is.numeric(seed) && length(seed) == 1) {
		seed <- seed.BurSt(seed)
	}
	if(!is.numeric(seed) || length(seed) != 625 || any(is.na(seed))) {
		stop(paste("bad input for 'seed' -- given has mode",
			mode(seed), "and length", length(seed)))
	}
	if(length(do.warn) && !is.logical(do.warn)) {
		stop(paste("'do.warn' must either be NULL or a logical",
			"vector (usually with names) -- given has mode",
			mode(do.warn), "and length", length(do.warn)))
	}
	do.warn.menu <- c("cost.intercept.nonzero", "value.range",
		"extraneous.assets", "no.asset.names", "benchmark.long.short",
		"variance.list", "turnover.max", "max.weight.restrictive",
		"neg.dest.wt", "penalty.size", "ignore.max.weight", 
		"converged", "noninteger.forced", "bounds.missing", 
		"positions.names", "start.noexist", "random.start",
		"novariance.optim", "nonzero.penalty", "neg.risk.aversion",
		"zero.iterations", "infinite.bounds", "notrade", 
		"randport.failure", "utility.switch", "thresh.notrade",
		"dist.style", "dist.zero", "dist.prices", "zero.variance",
		"alpha.benchmark", "variance.benchmark", "var.eps", 
		"back.compat", "index.zero", "riskfrac.part", "exit.obj",
		"superfluous.constraint")
	if(length(names(do.warn))) {
		if(any(is.na(do.warn))) {
			isna.dowarn <- is.na(do.warn)
			stop(paste(sum(isna.dowarn), 
				"element(s) of 'do.warn' are missing values:",
				paste(names(do.warn)[isna.dowarn],
				collapse=", ")))
		}
		do.warn.given <- do.warn
		do.warn <- rep(TRUE, length(do.warn.menu))
		names(do.warn) <- do.warn.menu
		do.warn["converged"] <- FALSE
		do.warn.num <- pmatch(names(do.warn.given), do.warn.menu, 
			nomatch=0)
		if(any(do.warn.num == 0)) {
			stop(paste("unknown or ambiguous names in 'do.warn':",
				paste(names(do.warn.given)[do.warn.num == 0], 
				collapse=", "),
				"-- valid choices are:",
				paste(paste('"', sort(do.warn.menu), '"',
				sep=""), collapse=", ")))
		}
		do.warn[do.warn.num] <- do.warn.given
	} else {
		if(length(do.warn)) {
			do.warn <- rep(do.warn, length=length(do.warn.menu))
			names(do.warn) <- do.warn.menu
		} else {
			do.warn <- rep(TRUE, length=length(do.warn.menu))
			names(do.warn) <- do.warn.menu
			do.warn["converged"] <- FALSE
		}
	}
	if(is.character(control)) control <- get(control)
	if(is.function(control)) {
		control <- control(...)
	}
	conlen <- c(icon=380, dcon=290, aux=9)
	icontrol <- control$icontrol
	dcontrol <- control$dcontrol
	auxcontrol <- control$aux
	if(length(icontrol) != conlen["icon"]) {
		stop(paste("bad length", length(icontrol), 
			"for 'icontrol' component of 'control', should be",
			conlen["icon"]))
	}
	if(length(dcontrol) != conlen["dcon"]) {
		stop(paste("bad length", length(dcontrol), 
			"for 'dcontrol' component of 'control', should be",
			conlen["dcon"]))
	}
	if(length(auxcontrol) != conlen["aux"]) {
		stop(paste("bad length", length(auxcontrol), 
			"for 'auxcontrol' component of 'control', should be",
			conlen["aux"]))
	}
	big <- dcontrol["big"]
	safe.mode <- auxcontrol["safe.mode"]
	sharetol <- auxcontrol["sharetol"]
	vtd <- NULL

	prices <- drop(prices)
	if(length(dim(prices))) {
		ldp <- length(dim(prices))
		if(ldp == 1) {
			assetnam <- dimnames(prices)[[1]]
			dim(prices) <- NULL
			names(prices) <- assetnam
		} else {
			errmsg <- "'prices' expected to be a numeric vector with names,"
			if(ldp == 2) {
				if(inherits(prices, "data.frame")) {
					errmsg <- paste(errmsg, "not a data frame",
						"-- perhaps you meant to give",
						"the first column?")
				} else {
					errmsg <- paste(errmsg, "not a matrix")
				}
			} else {
				errmsg <- paste(errmsg, 
					"not an array of dimension", ldp)
			}
			stop(errmsg)
		}
	}
	if(!is.numeric(prices)) {
		stop(paste("'prices' not numeric -- given has mode", 
			mode(prices)))
	}
	assetnam <- names(prices)
	if(any(is.na(prices))) {
		num.miss.price <- sum(is.na(prices))
		if(num.miss.price == 1) {
			stop(paste("missing value in 'prices' for:", 
				names(prices)[is.na(prices)]))
		}
		if(num.miss.price < 6) {
			stop(paste(num.miss.price, 
				"missing value in 'prices' for assets:",
				paste(names(prices)[is.na(prices)], 
				collapse=', ')))
		} else {
			stop(paste(num.miss.price, 
				"missing values in 'prices'"))
		}
	}
	if(any(prices < 0)) {
		stop(paste(sum(prices < 0), 
			"negative value(s) found in 'prices'"))
	}
	if(any(is.infinite(prices))) {
		stop(paste(sum(is.infinite(prices)), 
			"infinite value(s) found in 'prices'"))
	}

	checkinput <- list(prices=prices[1:5], variance=NULL, 
		expected.return=NULL, existing=NULL)

	storage.mode(prices) <- "double"
	if(length(long.only) != 1 || !is.logical(long.only) || 
			is.na(long.only)) {
		stop(paste("'long.only' must be a single non-missing",
			"logical value -- given has mode", mode(long.only), 
			"and length", length(long.only), "and", 
			sum(is.na(long.only)), "missing value(s)"))
	}
	if(length(benchmark) && !is.character(benchmark)) {
		stop(paste("'benchmark' must be NULL, or one or more",
			"character strings"))
	}
	if(!length(benchmark) && !is.null(benchmark)) {
		stop(paste("'benchmark' must be NULL, or one or more",
			"character strings"))
	}
	if(length(benchmark) && any(nchar(benchmark) == 0)) {
		stop("at least one empty string in 'benchmark'")
	}
	if(length(bench.constraint)) {
		if(!length(variance)) {
			stop("benchmark constraint but NULL variance")
		}
		if(!is.numeric(bench.constraint)) {
			stop("'bench.constraint' is not numeric")
		}
		if(is.matrix(bench.constraint)) {
			bench.con.names <- dimnames(bench.constraint)[[1]]
		} else {
			bench.con.names <- names(bench.constraint)
		}
		bench.constraint <- as.matrix(bench.constraint)
		if(ncol(bench.constraint) > 2) {
			stop(paste("too many columns for 'bench.constraint'",
				"-- should be have 1 or 2 columns"))
		}
		if(any(is.na(bench.constraint))) 
			stop("missing value(s) in 'bench.constraint'")
		if(ncol(bench.constraint) == 1) {
			bench.constraint[bench.constraint > big] <- big
			bench.con.names <- dimnames(bench.constraint)[[1]]
			bench.constraint <- cbind(-big, bench.constraint)
			dimnames(bench.constraint) <- list(bench.con.names,
				NULL)
		} else {
			bench.constraint[bench.constraint > big] <- big
			if(any(bench.constraint[,1] >= bench.constraint[,2])) {
				stop(paste(sum(bench.constraint[,1] >= 
					bench.constraint[,2]), "constraint(s)",
					"in 'bench.constraint' have the",
					"lower bound >= the upper"))
			}
		}
		bc.nam <- dimnames(bench.constraint)[[1]]
		if(!length(bc.nam) || any(nchar(bc.nam) == 0)) {
			stop(paste("improper id(s) in 'bench.constraint'",
				"-- each constraint should be identified",
				"with one of the assets in 'variance'"))
		}
	} else {
		if(!is.null(bench.constraint) && !is.numeric(bench.constraint))
			stop("bad value for 'bench.constraint'")
	}
	allben <- unique(c(benchmark, dimnames(bench.constraint)[[1]]))
	extra.assets <- NULL
	if(length(allben)) {
		benind <- match(allben, assetnam, nomatch=NA)
		if(any(is.na(benind))) {
			if(is.list(variance))
				stop(paste("need all benchmarks in prices",
					"when giving compact versions of",
					"variances (to help ensure correct",
					"order of assets in variance)"))
			extra.assets <- allben[is.na(benind)]
			newp <- rep(0, length(extra.assets))
			names(newp) <- extra.assets
			prices <- c(prices, newp)
			assetnam <- names(prices)
		}
		if(!long.only && do.warn["benchmark.long.short"]) {
			warning(paste("benchmarks may not be what you",
				"intend in long-short portfolios, you might",
				"want variance relative to benchmark -- see",
				"Special Instruction 2 in the User's Manual",
				"('do.warn' suppression is",
				"'benchmark.long.short')"))
		}
	}
	nassets <- length(prices)
	if(!length(assetnam) || any(nchar(assetnam) == 0) || 
			any(is.na(assetnam))) {
		stop("'prices' must be a named vector with no missing names")
	}
	if(length(unique(assetnam)) < nassets) {
		an.dup <- duplicated(assetnam)
		an.dup.sum <- sum(an.dup)
		if(an.dup.sum < 9) {
			stop(paste(an.dup.sum, "duplicate name(s) in 'prices':",
				paste(assetnam[an.dup], collapse=", ")))
		} else {
			stop(paste(an.dup.sum, "duplicate names in 'prices'. ",
				"First few are:",
				paste(assetnam[an.dup][1:5], collapse=", ")))
		}
	}

	varbfill <- NULL
	if(is.data.frame(variance)) variance <- as.matrix(variance)
	if(is.list(variance)) {
		if(do.warn["variance.list"]) {
			warning(paste("no way to check order of assets in",
				"variance lists -- the user is responsible",
				"for getting the order correct -- including",
				"benchmarks ('do.warn' suppression is",
				"'variance.list')"))
		}
		vnam <- names(variance)
		vardata <- variance$vardata
		vartype <- variance$vartype
		varoffset <- variance$varoffset
		nvarfactors <- variance$nvarfactors
		nvar <- length(vartype)
		if(nvar == 0) stop("bad 'vartype' component in 'variance'")
		if(any(is.na(vartype))) {
			stop(paste(sum(is.na(vartype)), "missing value(s)",
				"in 'vartype' component in 'variance'"))
		}
		if(any(vartype < 0 | vartype > 3))
			stop("faulty 'vartype' component in 'variance'")
		if(any(vartype == 1 | vartype == 2)) {
			if(length(nvarfactors) != nvar)
				stop("need 'nvarfactors' component of 'variance'")
			if(any(is.na(nvarfactors[vartype == 1 | vartype == 2])))
				stop(paste("missing value(s) for",
					"'nvarfactors' (where needed) in",
					"'variance'"))
		} else {
			# make a default version
			nvarfactors <- rep(0, nvar)
		}
		tvlen <- numeric(nvar)
		for(i in 1:nvar) {
			tvlen[i] <- switch(vartype[i] + 1, nassets * nassets, 
				nassets * (nvarfactors[i] + 1), 
				nvarfactors[i] * (nvarfactors[i] + nassets) + 
					nassets,
				round((nassets + 1) * nassets / 2))
		}
		if(length(vardata) != sum(tvlen)) {
			stop("length of 'vardata' in 'variance' wrong for declared type(s)")
		}
		tvoffset <- cumsum(c(0, tvlen[-nvar]))
		if(any(is.na(vardata))) {
			stop(paste(sum(is.na(vardata)), 
				"missing value(s) in 'vardata' in 'variance'"))
		}
		if(length(varoffset)) {
			if(any(is.na(varoffset)))
				stop("missing value(s) in 'varoffset' in 'variance'")
			if(any(varoffset != tvoffset))
				stop("'varoffset' component of 'variance' does not match declared type(s)")
		} else {
			varoffset <- tvoffset
		}
		variance <- vardata
		checkinput$variance <- c(vardata[1:5], vartype)
	} else if(!length(variance)) {
		if(!is.null(variance)) {
			stop("zero length object for 'variance' that is not NULL")
		}
		if(length(benchmark)) {
			stop("'benchmark' given but not 'variance'")
		}
		nvar <- 0
		vartype <- 0
		varoffset <- 0
		nvarfactors <- 0
	} else {
		if(!is.numeric(variance)) {
			stop(paste("'variance' should be numeric -- given",
				"has mode", mode(variance), "and length",
				length(variance)))
		}
		dv <- dim(variance)
		ldv <- length(dv)
		if(ldv != 2 && ldv != 3)
			stop(paste("'variance' must be a numeric matrix or",
				"3-D array -- given has mode",
				mode(variance), "and length", length(variance)))
		if(dv[1] != dv[2]) stop("'variance' is not square")
		dnv <- dimnames(variance)[[1]]
		if(!all(dnv == dimnames(variance)[[2]])) {
			stop("row and column names of 'variance' differ")
		}
		if(any(duplicated(dnv))) {
			stop(paste(sum(duplicated(dnv)), "asset(s) duplicated",
				"in 'variance':", paste(dnv[duplicated(dnv)],
				collapse=", ")))
		}
		if(ldv == 3) {
			varslnam <- dimnames(variance)[[3]]
		} else {
			varslnam <- NULL
		}
		if(length(dnv) && (length(dnv) != nassets || 
				!all(dnv == assetnam))) {
                        if(length(intersect(assetnam, dnv)) < nassets) {
                        	if(length(intersect(assetnam, c(dnv, allben))) 
						== nassets) {
					# not all benchmarks in the variance
				  vargive <- variance
				  if(ldv == 2) {
				  	variance <- array(NA, c(nassets,nassets),
					   list(assetnam, assetnam))
					variance[dnv, dnv] <- vargive
				
				  } else {
				  	variance <- array(NA, c(nassets,nassets,
					   dv[3]),
					   list(assetnam, assetnam, NULL))
					variance[dnv, dnv, ] <- vargive
				  }
				  varbfill <- setdiff(allben, dnv)
				} else {
                                	errmsg <- paste("'variance' does not",
						"hold all the assets in prices",
						if(length(allben) && length(intersect(assetnam, c(dnv, allben))) > length(intersect(assetnam, dnv)))
							"and benchmarks")
					vn.out <- setdiff(assetnam, dnv)
					if(length(vn.out) < 9) {
						errmsg <- paste(errmsg, ": ",
							paste(vn.out, 
							collapse=", "),
							sep="")
					} else {
						errmsg <- paste(errmsg, ": ",
							"first 5 of ",
							length(vn.out), ": ",
							paste(vn.out[1:5], 
							collapse=", "),
							sep="")
					}
					stop(errmsg)
				}
                        }
			if(ldv == 2) {
				variance <- variance[assetnam, assetnam]
			} else {
				variance <- variance[assetnam, assetnam, ,
					drop=FALSE]
			}
			dv <- dim(variance)
		} else {
			if(!length(dnv) && do.warn["no.asset.names"]) {
				warning(paste("no row names on 'variance',",
					"assuming correct order of assets",
					"('do.warn' suppression is",
					"'no.asset.names')"))
			}
		}
		if(dv[1] != nassets) {
			stop(paste("'variance' is the wrong size",
				"-- expected to be (at least)", nassets,
				"by", nassets))
		}
		if(!length(varbfill) && any(is.na(variance))) {
			stop(paste(sum(is.na(variance)), 
				"missing value(s) in 'variance'"))
		}
		if(any(is.infinite(variance))) {
			stop(paste(sum(is.infinite(variance)), 
				"infinite value(s) in 'variance'"))
		}
		if(ldv == 2) {
			dv <- c(dv, 1)
			nvar <- 1
			if(sum(diag(variance) == 0, na.rm=TRUE) > 1 && 
					do.warn["zero.variance"]) {
				warning(paste("more than one zero variance",
					"(on the diagonal)",
				 	"-- given has",
				 	sum(diag(variance) == 0),
					"('do.warn' suppression is",
					"'zero.variance')"))
			}
			varsym <- all.equal.numeric(variance, t(variance))
			if(!is.logical(varsym) || !varsym) {
				stop(paste("'variance' is not symmetric",
					"-- results would be highly suspect"))
			}
		} else {
			nvar <- dv[3]
			for(vs in 1:nvar) {
				varsli <- variance[,,vs]
				if(sum(diag(varsli) == 0, na.rm=TRUE) > 1 &&
						do.warn["zero.variance"]) {
					warning(paste("more than one zero",
						"variance (on the diagonal)",
				  		"-- given has",
				  		sum(diag(varsli) == 0),
				  		"at slice", vs,
						"('do.warn' suppression is",
						"'zero.variance')"))
			 	}
				varsym <- all.equal.numeric(varsli, t(varsli))
				if(!is.logical(varsym) || !varsym) {
					stop(paste("slice", vs, "of 'variance'",
						"is not symmetric -- results",
						"would be highly suspect"))
				}
			}
		}
		dimnames(variance) <- NULL # for S+ compatibility
		dim(variance) <- dv
		dimnames(variance) <- list(assetnam, assetnam, varslnam)
		vartype <- rep(0, nvar)
		varoffset <- seq(0, by = nassets*nassets, length = nvar)
		nvarfactors <- rep(0, nvar)
		checkinput$variance <- c(variance[1:5], nvar)
	}

	exist.lvalue <- exist.svalue <- 0
	if(inherits(existing, "portfolBurSt")) {
		existing <- existing$new.portfolio
	}
	if(length(existing) && !is.numeric(existing)) {
		stop(paste("'existing' must be a numeric vector",
			"-- given has mode", mode(existing), "and length",
			length(existing)))
	}
	if(length(existing) && any(is.na(existing))) {
		stop(paste(sum(is.na(existing)), 
			"missing value(s) in 'existing'"))
	}
	if(length(existing) && any(is.infinite(existing))) {
		stop(paste(sum(is.infinite(existing)), 
			"infinite value(s) in 'existing'"))
	}
	existing <- drop(existing)
	existing <- existing[existing != 0]
	if(length(existing)) {
		if(!length(names(existing)))
			stop("no names (asset ids) for 'existing'")
		exist.id <- match(names(existing), assetnam, nomatch=NA) - 1
		if(any(is.na(exist.id))) {
			stop(paste(sum(is.na(exist.id)), 
				"asset(s) in 'existing' but not in 'prices':",
				paste(names(existing)[is.na(exist.id)],
				collapse=", ")))
		}
		existnam <- names(existing)
		l.ex <- existing > 0
		s.ex <- existing < 0
		if(any(l.ex)) {
			exist.lvalue <- sum(existing[l.ex] * 
				prices[existnam[l.ex]])
		}
		if(any(s.ex)) {
			exist.svalue <- -sum(existing[s.ex] * 
				prices[existnam[s.ex]])
		}
		norig <- length(existing)
		checkinput$existing <- c(existing[1:5], norig)
	} else {
		existing <- 0; existnam <- names(existing) <- assetnam[1]
		exist.id <- 0
		norig <- 0
	}

	if(!is.numeric(allowance) || length(allowance) != 1 || 
			is.na(allowance)) {
		stop(paste("'allowance' must be a single non-missing number",
			"less than one -- given has mode", mode(allowance), 
			"and length", length(allowance), "and", 
			sum(is.na(allowance)), "missing value(s)"))
	}
	if(allowance >= 1 || allowance <= 0) {
		stop(paste("'allowance' must be positive and strictly",
			"less than 1 -- given value is", allowance))
	}

	if(length(turnover)) {
		if(!is.numeric(turnover)) {
			stop(paste("'turnover' should be numeric, not",
				mode(turnover)))
		}
		if(any(is.na(turnover))) 
			stop("missing value(s) in 'turnover'")
		if(length(turnover) == 1) {
			if(turnover <= 0) { 
				if(norig == 0) {
					stop(paste("'turnover' must be",
					  "positive without an existing",
					  "portfolio"))
				}
				turnover <- c(0, 0)
				turnover.type <- -1
			} else {
				turnover <- c(0, turnover)
				turnover.type <- ifelse(is.finite(
					turnover[2]), 1, 0)
			}
		} else {
			if(length(turnover) != 2)
				stop("length of 'turnover' greater than 2")
			turnover <- sort(turnover)
			if(is.infinite(turnover[1])) {
				stop("minimum turnover is infinite")
			}
			turnover[1] <- max(0, turnover[1])
			if(turnover[2] <= 0) {
				if(norig == 0) {
					stop(paste("'turnover' must be",
					  "positive without an existing",
					  "portfolio"))
				}
				turnover <- c(0, 0)
				turnover.type <- -1
			} else {
				turnover.type <- 2 * (turnover[1] > 0) + 
					turnover[2] < Inf
			}
		}
	} else {
		turnover <- c(0, Inf)
		turnover.type <- 0
	}
	if(diff(range(prices)) > 1e-12 && turnover.type >= 0) {
		oneprice <- FALSE
		medprice <- median(prices)
	} else {
		oneprice <- TRUE
	}
	if(long.only) {
		if(exist.svalue > 0) {
			stop(paste("short positions exist but long-only declared\n",
				"if this is not a mistake, see",
				"Special Instruction 1 in the User's Manual",
				collapse=" "))
		}
		if(length(short.value) && any(short.value != 0)) 
			stop("'short.value' given with 'long.only=TRUE'")
		gnl <- c(gross.value, net.value, long.value)
		if(length(gnl)) {
			if(!is.numeric(gnl)) {
				stop(paste("'gross.value', 'net.value' or",
					"'long.value' not numeric",
					"\ngross.value mode:", 
					mode(gross.value),
					"\nnet.value mode:", mode(net.value),
					"\nlong.value mode:", mode(long.value)
					))
			}
			if(any(is.na(gnl))) {
				stop(paste("missing value in 'gross.value',",
					"'net.value' or 'long.value'"))
			}
			len.gnl <- c(length(gross.value), length(net.value),
				length(long.value))
 			if(any(len.gnl > 2)) {
				names(len.gnl) <- c("'gross.value'", 
					"'net.value'", "'long.value'")
				len.gnl <- len.gnl[len.gnl > 2]
				stop(paste(paste(names(len.gnl), 
					collapse=", "), "may have length",
					"at most 2 -- actual length(s) are:",
					paste(len.gnl, collapse=", ")))
			}
		} else {
			if(is.infinite(turnover[2])) {
				stop(paste("need at least one of",
					"'gross.value', 'long.value',",
					"'net.value', 'turnover'"))
			}
			gnl <- c(max(0, exist.lvalue - turnover[2]), 
				exist.lvalue + turnover[2])
		}
		gross.value <- range(gnl)
		if(length(gross.value) && gross.value[1] == gross.value[2]) {
			gross.value[1] <- allowance * gross.value[2]
		}
		if(length(gross.value)) {
			imp.gross <- exist.lvalue + turnover[2]
			if(gross.value[1] > imp.gross)
				stop(paste("'turnover' is inconsistent with",
					"'gross.value' -- minimum gross is",
					gross.value[1], "turnover allows",
					"at most", imp.gross))
		} else {
			# turnover, no gross.value
			if(norig) {
				gross.value <- c(max(0, 
					exist.lvalue - turnover[2]),
					exist.lvalue + turnover[2])
			} else {
				gross.value <- c(turnover[2] *
					allowance, turnover[2])
			}
		}
		if(!oneprice && do.warn["value.range"]) {
			if(diff(gross.value) < medprice) {
				warning(paste("tight range for 'gross.value':",
					paste(format(as.vector(gross.value)),
					collapse=" to "),
					"('do.warn' suppression is 'value.range')"))
			}
			if(turnover.type > 0 && diff(turnover) < 
					medprice) {
				warning(paste("tight range for 'turnover':",
					paste(format(as.vector(turnover)),
					collapse=" to "),
					"('do.warn' suppression is 'value.range')"))
			}
		}
		long.value <- net.value <- gross.value
		short.value <- c(0, 0)
	} else {
		# long-short
		vpres <- c(g=length(gross.value), n=length(net.value),
			l=length(long.value), s=length(short.value))
		if(!any(vpres) && is.infinite(turnover[2])) {
			stop(paste("need to specify one or more money values",
				"-- 'turnover' and/or gross/net, long/short "))
		}
		if(any(vpres > 2)) {
			stop(paste("none of 'gross.value' 'net.value'",
				"'long.value' 'short.value' may have length",
				"greater than 2", 
				"\ngross.value mode:", 
				mode(gross.value),
				"length:", length(gross.value),
				"\nnet.value mode:", 
				mode(net.value),
				"length:", length(net.value),
				"\nlong.value mode:", 
				mode(long.value),
				"length:", length(long.value),
				"\nshort.value mode:", 
				mode(short.value),
				"length:", length(short.value)))
		}
		if(any(is.infinite(short.value))) {
			stop("infinite values not allowed in 'short.value'")
		}
		if(length(short.value) == 2 && short.value[1] * 
				short.value[2] < 0) {
			stop(paste("both positive and negative values",
				"in 'short.value' not allowed",
				"-- values should be positive"))
		}
		if(!any(vpres)) {
			if(norig) {
				gross.value <- c(max(0, exist.svalue +
					exist.lvalue - turnover[2]),
					exist.svalue + exist.lvalue + 
					turnover[2])
				net.value <- c(exist.lvalue - exist.svalue -
					turnover[2],
					exist.lvalue - exist.svalue + 
					turnover[2])
				long.value <- c(max(0, exist.lvalue 
					- turnover[2]), exist.lvalue + 
					turnover[2])
				short.value <- c(max(0, exist.svalue 
					- turnover[2]), exist.svalue + 
					turnover[2])
			} else {
				gross.value <- c(0, turnover[2])
				net.value <- c(-turnover[2], turnover[2])
				long.value <- gross.value
				short.value <- gross.value
			}
		} else {
			# at least one value present
			mallv <- c(gross.value, net.value, long.value, 
				short.value)
			if(!is.numeric(mallv)) {
				stop(paste("at least one of 'gross.value',",
					"'net.value', 'long.value',",
					"'short.value' is not numeric",
					"(NULL is okay):",
					"\ngross.value mode:", 
					mode(gross.value),
					"length:", length(gross.value),
					"\nnet.value mode:", 
					mode(net.value),
					"length:", length(net.value),
					"\nlong.value mode:", 
					mode(long.value),
					"length:", length(long.value),
					"\nshort.value mode:", 
					mode(short.value),
					"length:", length(short.value)))
			}
			if(vpres["g"] >= 1) {
				if(any(is.na(gross.value)))
					stop("missing value(s) in 'gross.value'")
				if(vpres["g"] == 1) {
					gross.value <- c(gross.value * 
						allowance, gross.value)
				}
				gross.value <- sort(gross.value)
			}
			if(vpres["l"] >= 1) {
				if(any(is.na(long.value)))
					stop("missing value(s) in 'long.value'")
				if(vpres["l"] == 1) {
					long.value <- c(long.value * allowance,
						long.value)
				}
				long.value <- sort(long.value)
			}
			if(vpres["s"] >= 1) {
				if(any(is.na(short.value)))
					stop("missing value(s) in 'short.value'")
				if(vpres["s"] == 1) {
					short.value <- sort(abs(c(short.value * 
						allowance, short.value)))
				}
				short.value <- sort(short.value)
			}
			if(!vpres["g"]) {
				if(!vpres["l"] || !vpres["s"]) 
					stop("need either 'gross.value' and 'net.value', or 'long.value' and 'short.value' or 'long.only=TRUE'")
				gross.value <- range(outer(long.value,
					abs(short.value), "+"))
			}
			if(vpres["n"] >= 1) {
				if(any(is.na(net.value)))
					stop("missing value(s) in 'net.value'")
				if(vpres["n"] == 1) {
					if(net.value == 0) {
						net.value <- c(-(1 - 
							allowance) * 
							max(gross.value), (1 - 
							allowance) * max(
							gross.value))
					} else {
						net.value <- c(net.value * 
							allowance, net.value)
					}
				}
				net.value <- sort(net.value)
			} else {
				if(!vpres["l"] || !vpres["s"]) 
					stop("need either 'gross.value' and 'net.value', or 'long.value' and 'short.value' or 'long.only=TRUE'")
				net.value <- range(outer(long.value,
					abs(short.value), "-"))
			}
			if(net.value[1] < -gross.value[2]) {
				net.value[1] <- -gross.value[2]
			}
			if(net.value[2] > gross.value[2]) {
				net.value[2] <- gross.value[2]
			}
			if(net.value[1] > net.value[2]) {
				stop(paste("bad value for 'net.value'",
					"-- minimum net is too large"))
			}
			if(!vpres["l"]) {
				if(!vpres["g"] || !vpres["n"]) 
					stop("need either 'gross.value' and 'net.value', or 'long.value' and 'short.value' or 'long.only=TRUE'")
				long.value <- range(outer(gross.value,
					net.value, "+")/2)
			}
			if(!vpres["s"]) {
				if(!vpres["g"] || !vpres["n"]) 
					stop("need either 'gross.value' and 'net.value', or 'long.value' and 'short.value' or 'long.only=TRUE'")
				short.value <- range(outer(gross.value,
					net.value, "-")/2)
				short.value[short.value < 0] <- 0
			} else {
				short.value <- sort(abs(short.value))
			}
			if(sum(vpres > 0) > 2) {
				# check for inconsistencies
				if(vpres["g"] && vpres["n"]) {
					if(vpres["l"]) {
						long.value <- sort(long.value)
						imp.l <- range(outer(
							gross.value,
							net.value, "+")/2)
						if(imp.l[1] > long.value[2] ||
								imp.l[2] <
								long.value[1]) {
						  stop(paste("'long.value' inconsistent",
						    "\n'long.value':",
						    long.value[1], 
						    long.value[2], 
						    "\nlong implied from gross and net:",
						    imp.l[1], imp.l[2]))
						}
					}
					if(vpres["s"]) {
						imp.s <- range(outer(
							gross.value,
							net.value, "-")/2)
						if(imp.s[1] > short.value[2] ||
								imp.s[2] <
								short.value[1]) {
						  stop(paste("'short.value' inconsistent",
						    "\n'short.value':", 
						    short.value[1], 
						    short.value[2], 
						    "\nshort implied from gross and net:",
						    imp.s[1], imp.s[2]))
						}
					}
				} else {
					# long and short given
					if(vpres["g"]) {
						gross.value <- sort(gross.value)
						imp.g <- range(outer(
							long.value,
							short.value, "+"))
						if(imp.g[1] > gross.value[2] ||
								imp.g[2] <
								gross.value[1]) {
						  stop(paste("'gross.value' inconsistent",
						    "\n'gross.value':", 
						    gross.value[1], 
						    gross.value[2], 
						    "\ngross implied from long and short:",
						    imp.g[1], imp.g[2]))
						}
					}
					if(vpres["n"]) {
						net.value <- sort(net.value)
						imp.n <- range(outer(
							long.value,
							short.value, "-"))
						if(imp.n[1] > net.value[2] ||
								imp.n[2] <
								net.value[1]) {
						  stop(paste("'net.value' inconsistent",
						    "\n'net.value':", 
						    net.value[1], 
						    net.value[2], 
						    "\nnet implied from long and short:",
						    imp.n[1], imp.n[2]))
						}
					}
				}
			}
		}
		if(is.finite(turnover[2])) {
			imp.gross <- exist.lvalue + exist.svalue + 
				turnover[2]
			if(gross.value[1] > imp.gross)
				stop(paste("'turnover' is inconsistent with",
					"'gross.value' -- minimum gross is",
					gross.value[1], "but turnover",
					"allows at most", imp.gross))
		}
		if(!oneprice && do.warn["value.range"]) {
			if(diff(gross.value) < medprice) {
				warning(paste("tight range for 'gross.value':",
					paste(format(as.vector(gross.value)),
					collapse=" to "),
					"('do.warn' suppression is 'value.range')"))
			}
			if(diff(net.value) < medprice) {
				warning(paste("tight range for 'net.value':",
					paste(format(as.vector(net.value)),
					collapse=" to "),
					"('do.warn' suppression is 'value.range')"))
			}
			if(diff(turnover) < medprice) {
				warning(paste("tight range for 'turnover':",
					paste(format(as.vector(turnover)),
					collapse=" to "),
					"('do.warn' suppression is 'value.range')"))
			}
		}
	}
	if(any(is.infinite(gross.value))) {
		stop(paste("infinite value(s) in given or computed",
			"'gross.value':", gross.value[1], gross.value[2]))
	}
	if(long.value[2] > gross.value[2]) {
		long.value[2] <- gross.value[2]
	}
	if(short.value[2] > gross.value[2]) {
		short.value[2] <- gross.value[2]
	}
	if(is.finite(turnover[2])) {
		if(turnover[2] > gross.value[2] + exist.lvalue + 
				exist.svalue) {
			if(do.warn["turnover.max"]) {
				warning(paste("maximum turnover constraint (", 
					turnover[2], 
					") is not binding -- dropping it", 
					" ('do.warn' suppression is 'turnover.max')",
					sep=''))
			}
			turnover[2] <- Inf
			turnover.type <- turnover.type - 1
		}
	}

	out.price <- NULL
	if(!is.logical(bench.trade) || length(bench.trade) != 1 ||
			is.na(bench.trade)) {
		stop(paste("'bench.trade' must be a single non-missing",
			"logical value -- given has mode", mode(bench.trade), 
			"and length", length(bench.trade), "and",
			sum(is.na(bench.trade)), "missing value(s)"))
	}
	if(length(benchmark)) {
		bench.id <- match(benchmark, assetnam, nomatch=NA) - 1
		if(any(is.na(bench.id))) {
			stop(paste(sum(is.na(bench.id)), 
				"in 'benchmark' not in names of 'prices':",
				paste(benchmark[is.na(bench.id)], 
				collapse=', ')))
		}
		if(!bench.trade) {
			prices[bench.id + 1] <- 0
			out.price <- bench.id + 1
		}
		nbenchmarks <- length(benchmark)
	} else {
		bench.id <- -1
		nbenchmarks <- 0
	}

	if(!is.numeric(max.weight) || length(max.weight) == 0) {
		stop(paste("'max.weight' must be a numeric vector",
			"-- given has mode", mode(max.weight), "and length",
			length(max.weight)))
	}
	max.weight <- drop(max.weight)
	if(any(is.na(max.weight))) {
		stop("at least one missing value in 'max.weight'")
	}
	if(any(max.weight < 0)) {
		stop("at least one negative value in 'max.weight'")
	}
	if(any(max.weight > 1)) {
		warning("at least one 'max.weight' greater than 1")
		# allow single variable problems to be done without warning
		max.weight[max.weight > 1.6] <- 1.6
	}
	if(length(names(max.weight))) {
		mw.given <- max.weight[intersect(names(max.weight), assetnam)]
		if(!length(mw.given)) stop("all bad names for 'max.weight'")
		if(length(mw.given) < length(max.weight) && 
				do.warn["extraneous.assets"]) {
			warning(paste(length(max.weight) - length(mw.given),
				"asset(s) in 'max.weight' ignored:",
				paste(setdiff(names(max.weight), 
				names(mw.given)), collapse=', '),
				"('do.warn' suppression is",
				"'extraneous.assets')"))
		}
		max.weight <- rep(1, nassets)
		names(max.weight) <- assetnam
		max.weight[names(mw.given)] <- mw.given
	} else {
		if(length(max.weight) != 1)
			warning(paste("replicating 'max.weight' which",
				"has multiple values and no names"))
		max.weight <- rep(max.weight, length=nassets)
		names(max.weight) <- assetnam
	}


	nsize <- 56
	sizes <- integer(nsize)
	names(sizes) <- c("nassets", "nvariances", "nalphas", "nutil", "ndest",
		"turnover.constraint", "lbo", "lso", "sbo", "sso", "cost.type", 
		"nodoubleconst", "long.only", "nbenchmarks", "norig", "ntrade", 
		"ntradebuysell", "ntradebuyonly", "ntradesellonly", 
		"single.search", "nconsmain", "nvarcon", "nalphacon", 
		"nalcomben", "nvarcomben", "qwt.all1", "shortcut", "maxconlev", 
		"nsumwtcon", "lsoff", "sboff", "ssoff", "adjust", "scalecost",
		"nconsub", "threshgiven", "computetradeval", "ignore.util",
		"limit.cost", "close.number.type", "n.forced.trades",
		"min.ntrade", "portsize.on", "distnum", "distconnum", 
		"riskfrac", "nvarrf", "nbenrf", "nvarbenrf", "nsize", "ndval",
		"startgiven", "minsumwt", "totriskfrac", "invvol", "bench.trade")
	sizes["nsize"] <- nsize
	sizes["bench.trade"] <- bench.trade
	
	presumwt <- .tradeopt.presumwt(sum.weight)
	sizes[names(presumwt$sumwtsizes)] <- presumwt$sumwtsizes
	implied.min.port.size <- presumwt$implied.min.port.size
	sumwtid <- presumwt$sumwtid
	sum.weight <- presumwt$sum.weight
	if(length(sum.weight)) {
		t.upper <- gross.value[2] * pmin(max.weight, sum.weight[1,2]) / 
			prices
	} else {
		t.upper <- gross.value[2] * max.weight / prices
	}
	t.upper <- pmin(t.upper, long.value[2] / prices)
	t.upper <- floor(t.upper)
	names(t.upper) <- assetnam
	if(long.only) {
		t.lower <- rep(0, nassets)
	} else {
		if(length(sum.weight)) {
			t.lower <- - gross.value[2] * pmin(max.weight,
				sum.weight[1,2]) / prices
		} else {
			t.lower <- - gross.value[2] * max.weight / prices
		}
		t.lower <- pmax(t.lower, -short.value[2] / prices)
	}
	t.lower <- ceiling(t.lower)
	names(t.lower) <- assetnam
	t.upper[existnam] <- t.upper[existnam] - existing
	t.lower[existnam] <- t.lower[existnam] - existing
	if(is.finite(turnover[2])) {
		tt.upper <- floor(turnover[2] / prices)
		t.upper <- pmin(t.upper, tt.upper)
		t.lower <- pmax(t.lower, -tt.upper)
	}
	t.upper[prices == 0] <- 0
	t.lower[prices == 0] <- 0
	tmw.upper <- t.upper
	tmw.lower <- t.lower

	position.force <- NULL
	existfullLen <- rep(0, nassets)
	names(existfullLen) <- assetnam
	existfullLen[existnam] <- existing
	positions.give <- positions
	pos.portsize <- NA
	if(length(positions)) {
		if(!is.matrix(positions) || !is.numeric(positions)) {
			stop("'positions' must be a numeric matrix")
		}
		ncpos <- ncol(positions)
		if(ncpos != 2 && ncpos != 4 && ncpos != 8) {
			stop("'positions' must have 2, 4 or 8 columns")
		}
		if(ncpos > 4) { 
			if(length(threshold)) {
				stop(paste("thresholding not allowed",
					"in 'positions' when 'threshold' given",
					"-- either remove 'threshold' or",
					"the last 4 columns of 'positions'"))
			}
			if(any(is.na(positions[, -1:-4]))) {
				stop(paste(sum(is.na(positions[,-1:-4])),
					"missing values found in",
					"threshold portion of 'positions'",
					"(columns 5 through 8)"))
			}
			if(any(is.infinite(positions[, -1:-4]))) {
				stop(paste(sum(is.infinite(positions[,-1:-4])),
					"infinite values found in",
					"threshold portion of 'positions'",
					"(columns 5 through 8)"))
			}
		}
		posan <- dimnames(positions)[[1]]
		if(!length(posan)) {
			if(nrow(positions) == nassets && !sum(is.na(positions))
					&& all(apply(positions, 2, function(z) 
					diff(sub.range(z)) == 0))) {
				dimnames(positions) <- list(assetnam, NULL)
				dimnames(positions.give) <- list(assetnam, NULL)
				posanok <- posan <- assetnam
			} else {
				stop(paste("'positions' must have row names",
					"(asset ids) unless all rows are the",
					"same and there is the right number",
					"of rows"))
			}
		} else {
			posanok <- intersect(posan, assetnam)
		}
		if(!length(posanok)) {
			stop("no row names of 'positions' match asset names")
		}
		posanex <- length(setdiff(posan, assetnam))
		posanmis <- length(setdiff(assetnam, posan))
		if(posanex || posanmis) {
			if(do.warn["positions.names"]) {
				warning(paste("'positions' has", posanex,
					"asset(s) not in universe and",
					posanmis, "missing asset(s)",
					"('do.warn' suppression is 'positions.names')"))
			}
			if(posanex) {
				positions <- positions[posanok,]
			}
		}
		posna <- is.na(positions[,1]) | is.na(positions[,2])
		if(ncpos >= 4) {
			posna <- posna | is.na(positions[,3]) | 
				is.na(positions[,4])
		}
		if(ncpos > 4 && any(is.na(positions[!posna,]))) {
			stop("missing values inappropriately in 'positions'")
		}
		if(any(positions[!posna,1] > positions[!posna,2])) {
			stop(paste("1st column of 'positions' has",
				sum(positions[!posna,1] > positions[!posna,2]),
				"value(s) bigger than 2nd column"))
		}
		if(any(posna)) {
			posnotrade <- names(posna[posna])
			t.lower[posnotrade] <- 0
			t.upper[posnotrade] <- 0
			positions <- positions[!posna, ]
			posanok <- dimnames(positions)[[1]]
			pos.notrade <- length(posnotrade)
			pos.portsize <- sum((positions[,1] > 0 & positions[,2]
				> 0) | (positions[,1] < 0 & positions[,2] < 
				0)) + length(intersect(posnotrade, existnam))
		} else {
			pos.notrade <- 0
			pos.portsize <- sum((positions[,1] > 0 & positions[,2]
				> 0) | (positions[,1] < 0 & positions[,2] < 0))
		}
		if(long.only && any(positions[,2] < 0)) {
			stop(paste("long-only and 2nd column of 'positions' has",
				sum(positions[,2] < 0), "negative value(s)"))
		}
		posportlow <- ceiling(positions[, 1] / prices[posanok])
		posportup <- floor(positions[, 2] / prices[posanok])
		if(any(posportlow > posportup)) {
			postroubloc <- posportlow > posportup
			postroubval <- round(positions[,1] / prices[posanok])
			posportlow[postroubloc] <- postroubval[postroubloc]
			posportup[postroubloc] <- postroubval[postroubloc]
		}
		posexcom <- intersect(posanok, existnam)
		if(length(posexcom)) {
			posforpl <- posportlow[posexcom] > existing[posexcom]
			posforpu <- posportup[posexcom] < existing[posexcom]
			if(any(posforpl | posforpu)) {
				position.force <- c(posportlow[posexcom][
					posforpl] - existing[posexcom][
					posforpl], posportup[posexcom][
					posforpu] - existing[posexcom][
					posforpu])
				if(tol.positions > 0) {
					posfval <- position.force * prices[
						names(position.force)]
					posfin <- abs(posfval) > tol.positions
					position.force <- position.force[posfin]
				}
			}
			t.lower[posexcom] <- pmax(t.lower[posexcom],
				posportlow[posexcom] - existing[posexcom])
			t.upper[posexcom] <- pmin(t.upper[posexcom],
				posportup[posexcom] - existing[posexcom])
			posportlow[posexcom] <- posportlow[posexcom] -
				existing[posexcom]
			posportup[posexcom] <- posportup[posexcom] -
				existing[posexcom]
		}
		posexout <- setdiff(posanok, existnam)
		if(length(posexout)) {
			posforpl <- posportlow[posexout] > 0
			posforpu <- posportup[posexout] < 0
			if(any(posforpl | posforpu)) {
				position.force <- c(position.force, 
					posportlow[posexout][posforpl], 
					posportup[posexout][posforpu])
			}
			t.lower[posexout] <- pmax(t.lower[posexout],
				posportlow[posexout])
			t.upper[posexout] <- pmin(t.upper[posexout],
				posportup[posexout])
		}
		if(ncpos >= 4) {
			if(any(positions[,3] > positions[,4])) {
				stop(paste("3rd column of 'positions' has",
					sum(positions[,3] > positions[,4]),
					"value(s) bigger than 4th column"))
			}
			postradelow <- ceiling(positions[,3] / prices[posanok])
			postradeup <- floor(positions[,4] / prices[posanok])
			if(any(postradeup < posportlow | postradelow > 
					posportup)) {
				inconpos <- posanok[postradeup < posportlow |
					postradelow > posportup]
				stop(paste(length(inconpos), "asset(s) with",
					"trade 'positions' inconsistent with",
					"portfolio 'positions':",
					paste(inconpos, collapse=', ')))
			}
			if(any(postradelow > postradeup)) {
				posttroubloc <- postradelow > postradeup
				postrademid <- round(positions[,3] / prices[
					posanok])
				postradelow[posttroubloc] <- postrademid[
					posttroubloc]
				postradeup[posttroubloc] <- postrademid[
					posttroubloc]
			}
			if(long.only && any(postradeup < 
					-existfullLen[posanok])) {
				stop(paste(sum(postradeup < 
					-existfullLen[posanok]),
					"element(s) in 4th column of",
					"'positions' too small for long-only"))
			}
			posfortl <- postradelow > 0
			posfortu <- postradeup < 0
			if(any(posfortl | posfortu)) {
				position.force <- c(position.force, 
					postradelow[posfortl], 
					postradeup[posfortu])
			}
			t.lower[posanok] <- pmax(t.lower[posanok],
				postradelow[posanok])
			t.upper[posanok] <- pmin(t.upper[posanok],
				postradeup[posanok])
		}
	} else {
		if(!is.null(positions) && !is.numeric(positions)) {
			stop(paste("bad value for 'positions'",
				"should be either NULL or a numeric matrix"))
		}
		position.force <- NULL
		pos.notrade <- 0
	}
	if(length(position.force)) {
		if(any(duplicated(names(position.force)))) {
			pforcespl <- split(position.force, 
				names(position.force))
			pforcewide <- unlist(lapply(pforcespl, function(x)
				min(x) < 0 & max(x) > 0))
			if(any(pforcewide)) {
				stop(paste("inconsistent forced trades",
					"from 'positions' for:",
					paste(names(pforcewide[pforcewide]),
					collapse=", ")))
			}
			position.force.orig <- position.force
			position.force <- unlist(lapply(pforcespl, function(x)
				if(x[1] > 0) max(x) else min(x)))
		}
	}

	forced.given <- forced.trade
	if(length(forced.trade)) {
		if(!length(names(forced.trade)) || !is.numeric(forced.trade)) {
			stop(paste("'forced.trade' must be NULL or a named",
				"numeric vector, not", mode(forced.trade)))
		}
		if(any(is.na(forced.trade))) {
			stop(paste(sum(is.na(forced.trade)),
				"missing value(s) in 'forced.trade'"))
		}
		if(any(is.infinite(forced.trade))) {
			stop(paste(sum(is.infinite(forced.trade)),
				"infinite value(s) in 'forced.trade'"))
		}
		if(ft.sd <- length(setdiff(names(forced.trade), assetnam))) {
			stop(paste(ft.sd, 
				"unknown asset(s) named in 'forced.trade':",
				paste(setdiff(names(forced.trade), assetnam),
				collapse=", ")))
		}
		if(any(duplicated(names(forced.trade)))) {
			stop(paste("duplicate names in 'forced.trade':",
				paste(names(forced.trade)[
				duplicated(names(forced.trade))], 
				collapse=", ")))
		}
		if(any(forced.trade == 0)) {
			stop(paste(sum(forced.trade == 0),
				"zero value(s) in 'forced.trade'",
				"-- you probably mean to use 'universe.trade'"))
		}
	} else {
		if(!is.null(forced.trade) && !is.numeric(forced.trade)) {
			stop(paste("bad value for 'forced.trade'",
				"-- should be NULL or a named numeric vector"))
		}
	}
	if(length(position.force) && length(forced.trade)) {
		force.combo <- c(forced.trade, position.force)
		if(any(duplicated(names(force.combo)))) {
			cforcespl <- split(force.combo, 
				names(force.combo))
			cforcewide <- unlist(lapply(cforcespl, function(x)
				min(x) < 0 & max(x) > 0))
			if(any(cforcewide)) {
				stop(paste("'forced.trade' and 'positions' inconsistent for:",
					paste(names(cforcewide[cforcewide]),
					collapse=", ")))
			}
			forced.trade <- unlist(lapply(cforcespl, function(x)
				if(x[1] > 0) max(x) else min(x)))
		} else {
			forced.trade <- force.combo
		}
	} else {
		forced.trade <- c(forced.trade, position.force)
	}

	mw.outlaws <- setdiff(assetnam[t.upper < 0 | t.lower > 0], 
	 	names(position.force))
	mw.force <- NULL
	if(length(mw.outlaws)) {
		if(auxcontrol["enforce.max.weight"]) {
			mw.fneg <- floor(tmw.upper[tmw.upper < 0])
			if(length(mw.fneg)) {
				mw.fneg <- pmax(mw.fneg, 
					t.lower[names(mw.fneg)])
				mw.fneg <- mw.fneg[mw.fneg < 0]
			}
			mw.fpos <- ceiling(tmw.lower[tmw.lower > 0])
			if(length(mw.fpos)) {
				mw.fpos <- pmin(mw.fpos, 
					t.upper[names(mw.fpos)])
				mw.fpos <- mw.fpos[mw.fpos > 0]
			}
			mw.force <- c(mw.fneg, mw.fpos)
			mw.fnout <- names(mw.fneg)[mw.fneg < tmw.lower[names(
				mw.fneg)]]
			mw.fpout <- names(mw.fpos)[mw.fpos > tmw.upper[names(
				mw.fpos)]]
			if(length(c(mw.fnout, mw.fpout))) {
				if(do.warn["ignore.max.weight"]) {
					warning(paste("'max.weight' not entirely enforced for:",
						paste(c(mw.fnout, mw.fpout), 
						collapse=", "),
						"('do.warn' suppression is 'ignore.max.weight')"))
				}
				if(length(mw.fnout)) {
					mw.force[mw.fnout] <- ceiling(tmw.lower[
						mw.fnout])	
				}
				if(length(mw.fpout)) {
					mw.force[mw.fpout] <- floor(tmw.upper[
						mw.fpout])
				}
			}
		} else {
			mw.out.ign <- setdiff(mw.outlaws, names(forced.trade))
			if(length(mw.out.ign) && do.warn["ignore.max.weight"]) {
				warning(paste("'max.weight' not being enforced for:",
					paste(mw.out.ign, collapse=", "),
						"('do.warn' suppression is 'ignore.max.weight')"))
			}
		}
		t.lower[t.lower > 0] <- 0
		t.upper[t.upper < 0] <- 0
	}
	if(!bench.trade) {
		t.lower[allben] <- 0
		t.upper[allben] <- 0
	}

	if(length(universe.trade)) {
		if(!is.character(universe.trade)) {
			stop(paste("'universe.trade' must be a vector",
				"of asset names -- given has mode",
				mode(universe.trade), "and length",
				length(universe.trade)))
		}
		universe.trade <- unique(universe.trade)
		if(length(intersect(assetnam, universe.trade)) < 
				length(universe.trade)) {
			utgood <- intersect(assetnam, universe.trade)
			if(!length(utgood)) {
				stop(paste("no assets in common between",
					"'prices' and 'universe.trade'"))
			}
			if(do.warn["extraneous.assets"]) {
				warning(paste(length(universe.trade) - 
					length(utgood), 
					"element(s) of 'universe.trade' not",
					"in universe:",
					paste(setdiff(universe.trade, utgood), 
					collapse=', '),
					"('do.warn' suppression is",
					"'extraneous.assets')"))
			}
			universe.trade <- utgood
		}
		no.trade <- setdiff(assetnam, universe.trade)
		if(length(no.trade)) {
			no.force <- intersect(no.trade, names(forced.trade))
			if(length(no.force)) {
				stop(paste("forced trade(s) not in",
					"'universe.trade':",
					paste(no.force, collapse=", ")))
			}
			no.mwforce <- intersect(no.trade, names(mw.force))
			if(length(no.mwforce)) {
				mw.force <- mw.force[intersect(universe.trade,
					names(mw.force))]
			}
			t.lower[no.trade] <- 0
			t.upper[no.trade] <- 0
		}
	} else {
		if(!is.null(universe.trade) && !is.character(universe.trade)) {
			stop(paste("bad value for 'universe.trade'",
				"-- should be NULL or a vector of characters"))
		}
	}

	if(length(upper.trade)) {
		if(!is.numeric(upper.trade)) {
			stop(paste("'upper.trade' should be numeric, not",
				mode(upper.trade)))
		}
		if(any(is.na(upper.trade))) {
			stop(paste(sum(is.na(upper.trade)),
				"missing value(s) in 'upper.trade'"))
		}
		if(length(names(upper.trade))) {
			upper.given <- upper.trade[intersect(
				names(upper.trade), assetnam)]
			if(!length(upper.given)) 
				stop("all unknown names in 'upper.trade'")
			upper.trade <- rep(Inf, nassets)
			names(upper.trade) <- assetnam
			upper.trade[names(upper.given)] <- upper.given
		} else {
			if(length(upper.trade) != 1 && length(upper.trade) 
					!= nassets) {
				warning("replicating multiple values for 'upper.trade' which has no names")
			}
			upper.trade <- rep(upper.trade, length=nassets)
			names(upper.trade) <- assetnam
		}
		if(any(upper.trade < 0)) {
			warning(paste(sum(upper.trade < 0), 
				"element(s) of 'upper.trade' less than 0",
				"set to 0--you probably want to use forced.trade"))
			upper.trade[upper.trade < 0] <- 0
		}
		upper.in <- TRUE
	} else {
		upper.in <- FALSE
		upper.trade <- rep(Inf, nassets)
		names(upper.trade) <- assetnam
	}
	if(length(lower.trade)) {
		if(!is.numeric(lower.trade)) {
			stop(paste("'lower.trade' should be numeric, not",
				mode(lower.trade)))
		}
		if(any(is.na(lower.trade))) {
			stop(paste(sum(is.na(lower.trade)),
				"missing value(s) in 'lower.trade'"))
		}
		if(length(names(lower.trade))) {
			lower.given <- lower.trade[intersect(
				names(lower.trade), assetnam)]
			if(!length(lower.given)) 
				stop("all unknown names in 'lower.trade'")
			lower.trade <- rep(-Inf, nassets)
			names(lower.trade) <- assetnam
			lower.trade[names(lower.given)] <- lower.given
		} else {
			if(length(lower.trade) != 1 && length(lower.trade)
					!= nassets) {
				warning("replicating multiple values for 'lower.trade' which has no names")
			}
			lower.trade <- rep(lower.trade, length=nassets)
			names(lower.trade) <- assetnam
		}
		if(any(lower.trade > 0)) {
			warning(paste(sum(lower.trade > 0), 
				"element(s) of 'lower.trade' greater than 0",
				"set to 0--you probably want to use 'forced.trade'"))
			lower.trade[lower.trade > 0] <- 0
		}
		lower.in <- TRUE
	} else {
		lower.in <- FALSE
		lower.trade <- rep(-Inf, nassets)
		names(lower.trade) <- assetnam
	}

	force.nonint <- NULL
	if(length(forced.trade) || length(mw.force)) {
		force.overnam <- intersect(names(forced.trade), 
			names(mw.force))
		if(length(force.overnam)) {
			if(any(sign(forced.trade[force.overnam] *
					mw.force[force.overnam]) < 0)) {
				force.con <- force.overnam[sign(forced.trade[
					force.overnam] *  
					mw.force[force.overnam]) < 0]
				stop(paste("contradictory forced trades",
					"('max.weight' versus explicit):",
					paste(force.con, collapse=", ")))
			}
			force.all <- c(forced.trade, mw.force)
			force.all <- force.all[!duplicated(names(force.all))]
			fon.up <- force.overnam[forced.trade[force.overnam] > 0]
			fon.do <- force.overnam[forced.trade[force.overnam] < 0]
			if(length(fon.up)) {
				force.all[fon.up] <- pmax(forced.trade[fon.up],
					mw.force[fon.up])
			}
			if(length(fon.do)) {
				force.all[fon.do] <- pmin(forced.trade[fon.do],
					mw.force[fon.do])
			}
			forced.trade <- force.all
		} else {
			forced.trade <- c(forced.trade, mw.force)
		}
		force.nam <- names(forced.trade)
		lower.force <- lower.trade[force.nam]
		upper.force <- upper.trade[force.nam]
		force.close <- force.nam[ forced.trade - lower.force < 1 |
			upper.force - forced.trade < 1 ]
		if(length(force.close)) {
			force.nonint <- forced.trade[force.close] %% 1 > 
				sharetol & (ceiling(forced.trade[force.close])
				> upper.force[force.close] | floor(
				forced.trade[force.close]) < lower.force[
				force.close])
			if(any(force.nonint) && do.warn["noninteger.forced"]) {
				warning(paste(sum(force.nonint),
					"trade(s) forced to be non-integer:",
					paste(names(force.nonint)[force.nonint],
					collapse=", "), 
					"('do.warn' suppression is 'noninteger.forced')"))
			}
		}
		force.illegal <- force.nam[ forced.trade > 
			upper.trade[force.nam] | forced.trade < 
			lower.trade[force.nam] ]
		if(length(force.illegal)) {
			force.illegal <- unique(force.illegal)
			stop(paste("forced trade(s) violate upper or lower",
				"trade (inconsistent forced trades?):",
				paste(force.illegal, collapse=", ")))
		}
		force.neg <- forced.trade[forced.trade < 0]
		force.pos <- forced.trade[forced.trade > 0]

		force.wfrac <- abs(forced.trade - round(forced.trade)) > 
			sharetol
		force.frac <- names(forced.trade)[force.wfrac]
		force.frac <- setdiff(force.frac, force.close)
		if(length(force.frac)) {
			force.fracneg <- intersect(names(force.neg),
				force.frac)
			if(length(force.fracneg)) {
				force.neg[force.fracneg] <- floor(
					force.neg[force.fracneg])
				forced.trade[force.fracneg] <- force.neg[
					force.fracneg]
			}
			force.fracpos <- intersect(names(force.pos),
				force.frac)
			if(length(force.fracpos)) {
				force.pos[force.fracpos] <- ceiling(
					force.pos[force.fracpos])
				forced.trade[force.fracpos] <- force.pos[
					force.fracpos]
			}
		}
	} else {
		force.neg <- force.pos <- NULL
	}

	if(upper.in) {
		uptint <- floor(upper.trade)
		if(any(upper.trade - uptint > sharetol, na.rm=TRUE)) {
			uout <- upper.trade - uptint > sharetol & 
				is.finite(upper.trade)
			uoutnam <- names(upper.trade)[uout]
			if(norig && any(abs(existing - round(existing)) > 
					sharetol)) {
				xout <- existnam[abs(existing - 
					round(existing)) > sharetol]
				uoutnam <- setdiff(uoutnam, xout)
			}
			if(length(force.nonint)) {
				uoutnam <- setdiff(uoutnam, names(force.nonint))
			}
			if(length(uoutnam)) {
				upper.trade[uoutnam] <- uptint[uoutnam]
			}
		}
	}
	if(lower.in) {
		lowtint <- ceiling(lower.trade)
		if(any(lowtint - lower.trade > sharetol, na.rm=TRUE)) {
			lout <- lowtint - lower.trade > sharetol & 
				is.finite(lower.trade)
			loutnam <- names(lower.trade)[lout]
			if(norig && any(abs(existing - round(existing)) > 
					sharetol)) {
				xout <- existnam[abs(existing - 
					round(existing)) > sharetol]
				loutnam <- setdiff(loutnam, xout)
			}
			if(length(force.nonint)) {
				loutnam <- setdiff(loutnam, names(force.nonint))
			}
			if(length(loutnam)) {
				lower.trade[loutnam] <- lowtint[loutnam]
			}
		}
	}

	lower.trade <- pmax(lower.trade, t.lower)
	upper.trade <- pmin(upper.trade, t.upper)
	if(any(lower.trade > upper.trade)) {
		stop(paste(sum(lower.trade > upper.trade), 
			"case(s) of 'lower.trade' greater than 'upper.trade':",
			paste(assetnam[lower.trade > upper.trade], 
			collapse=', ')))
	}

	upper.trade[upper.trade > big] <- big
	lower.trade[lower.trade < -big] <- -big

	if(length(positions.give) && ncol(positions.give) > 4) {
		posthresh <- positions[, -1:-4]
		threshold <- posthresh / prices[dimnames(posthresh)[[1]] ] 
		threshold[, c(1,3)] <- floor(threshold[, c(1,3)])
		threshold[, c(2,4)] <- ceiling(threshold[, c(2,4)])
	}
	if(length(threshold)) {
		threshold <- as.matrix(threshold)
		if(!is.numeric(threshold)) {
			stop(paste("'threshold' must be numeric, not",
				mode(threshold)))
		}
		if(any(is.na(threshold))) {
			stop(paste(sum(is.na(threshold)), 
				"missing value(s) in 'threshold'"))
		}
		threshgive <- threshold
		nct <- ncol(threshgive)
		if(nct > 4) {
			stop(paste("'threshold' must have 1 to 4 columns, has",
				nct))
		}
		threshnam <- dimnames(threshgive)[[1]]
		if(!length(threshnam)) {
			threshdif <- apply(threshgive, 2, function(x) 
				diff(range(x)))
			if(any(threshdif > 1e-12)) {
				stop("'threshold' must include asset names unless all rows are the same")
			}
			if(nrow(threshgive) != nassets) {
				stop(paste("'threshold' has", nrow(threshgive),
					"rows, expected", nassets))
			}
			threshnam <- assetnam
			dimnames(threshgive) <- list(assetnam, NULL)
		}
		ltnout <- length(setdiff(threshnam, assetnam))
		if(ltnout && do.warn["extraneous.assets"]) {
			warning(paste(ltnout, 
				"asset(s) in threshold not used",
				"('do.warn' suppression is 'extraneous.assets')"))
			threshnam <- intersect(threshnam, assetnam)
			threshgive <- threshgive[threshnam, , drop=FALSE]
		}
		threshold <- array(0, c(nassets, 4), list(assetnam, NULL))
		thresh.trade <- thresh.low <- thresh.up <- 0
		switch(nct,
			{
			# nct == 1
			threshold[threshnam, 1] <- -abs(threshgive)
			threshold[threshnam, 2] <- abs(threshgive)
			if(!all(threshgive == 0)) thresh.trade <- 1
			},
			{
			# nct == 2
			threshgivesort <- t(apply(threshgive, 1, sort))
			threshlowbad <- sum(threshgivesort[,1] > 0)
			threshhibad <- sum(threshgivesort[,2] < 0)
			if(threshlowbad + threshhibad) {
				stop(paste("bad matrix input for 'threshold':",
					threshlowbad, 
					"positive low trade values ",
					threshhibad, 
					"negative high trade values"))
			}
			threshold[threshnam, ] <- threshgivesort
			if(!all(threshgive == 0)) thresh.trade <- 1
			},
			{
			# nct == 3
			if(!long.only) stop("bad argument for 'threshold' -- 3 columns not allowed for long-short portfolios")
			if(any(threshgive[,1] > 0) || any(threshgive[,2:3] 
					< 0)) {
				stop(paste("values of the wrong sign in",
					"at least one column of 'threshold'",
					"-- should not be positive in the",
					"first, and not negative in second",
					"and third"))
			}
			threshold[threshnam, -3] <- threshgive
			if(any(threshgive[,1:2] != 0)) thresh.trade <- 1
			thresh.up <- 4
			},
			{
			# nct == 4
			if(any(threshgive[,c(1,3)] > 0) || 
					any(threshgive[,c(2,4)] < 0)) {
				stop(paste("values of the wrong sign in",
					"at least one column of 'threshold'",
					"-- should not be positive in first",
					"and third, and not be negative in",
					"the second and fourth"))
			}
			threshold[threshnam,] <- threshgive
			if(any(threshgive[,1:2] != 0)) thresh.trade <- 1
			if(!long.only && any(threshgive[,3] < 0)) 
				thresh.low <- 2
			if(any(threshgive[,4] > 0)) thresh.up <- 4
			}
		)
		if(norig == 0 && thresh.low + thresh.up > 0) {
			# simplify to just trade threshold
			threshold[,1] <- pmin(threshold[,1], threshold[,3])
			threshold[,2] <- pmax(threshold[,2], threshold[,4])
			thresh.trade <- 1
			thresh.low <- thresh.up <- 0
		}
		sizes["threshgiven"] <- thresh.trade + thresh.low + thresh.up
		if(norig) {
			existpred <- rep(FALSE, nassets)
			names(existpred) <- assetnam
			existpred[existnam] <- TRUE
			threshold[!existpred,1] <- pmin(threshold[!existpred,1],
				threshold[!existpred,3])
			threshold[!existpred,3] <- threshold[!existpred,1]
			threshold[!existpred,2] <- pmax(threshold[!existpred,2],
				threshold[!existpred,4])
			threshold[!existpred,4] <- threshold[!existpred,2]
		}
		lthreshrev <- threshold[,1] < lower.trade
		lthreshnam <- uthreshnam <- NULL
		if(any(lthreshrev)) {
			lthreshnam <- assetnam[lthreshrev]
			lotthr <- lower.trade
			lower.trade[lthreshrev] <- 0
		}
		uthreshrev <- threshold[,2] > upper.trade
		if(any(uthreshrev)) {
			uthreshnam <- assetnam[uthreshrev]
			uptthr <- upper.trade
			upper.trade[uthreshrev] <- 0
		}
		bthreshnam <- intersect(lthreshnam, uthreshnam)
		if(length(bthreshnam)) {
			bthreshnam <- bthreshnam[ lotthr[bthreshnam] < 0 |
				uptthr[bthreshnam] > 0 ]
		}
		lbthr <- length(bthreshnam)
		if(lbthr > 6 && do.warn["thresh.notrade"]) {
			warning(paste("about", lbthr, 
				"assets disallowed from trading",
				"because of large threshold values",
				"the first few are:",
				paste(bthreshnam[1:5], collapse=", "),
				"('do.warn' suppression is 'thresh.notrade')"))
		} else if(lbthr && do.warn["thresh.notrade"]) {
			warning(paste("about", lbthr, 
				"assets disallowed from trading",
				"because of large threshold values",
				"they are:",
				paste(bthreshnam, collapse=", "),
				"('do.warn' suppression is 'thresh.notrade')"))
		}
		if(any(is.infinite(threshold))) {
			stop(paste("infinite values not allowed in",
				"'threshold' -- found",
				sum(is.infinite(threshold))))
		}
	} else {
		if(!is.null(threshold) && !is.numeric(threshold)) {
			stop(paste("bad value for 'threshold'",
				"-- needs to be NULL or numeric"))
		}
		sizes["threshgiven"] <- 0
		threshold <- double(1)
	}
	if(length(force.neg)) {
		upper.trade[names(force.neg)] <- force.neg
	}
	if(length(force.pos)) {
		lower.trade[names(force.pos)] <- force.pos
	}

	trade.univ <- rep(0, nassets)
	names(trade.univ) <- assetnam
	trade.univ[lower.trade >= 0 & upper.trade > 0] <- 1
	trade.univ[lower.trade < 0 & upper.trade <= 0] <- 2
	trade.univ[lower.trade < 0 & upper.trade > 0] <- 3
	if(length(forced.trade)) {
		trade.univ[names(forced.trade)] <- trade.univ[
			names(forced.trade)] + 4
		# if(length(force.close)) {
		# 	trade.univ[force.close] <- trade.univ[force.close] + 2
		# }
	}

	if(any(prices[trade.univ > 0] <= 0)) {
		stop("zero or negative prices for",
			sum(prices[trade.univ > 0] <= 0),
			"tradable asset(s)")
	}

	if(is.null(ntrade)) ntrade <- nassets
	if(length(ntrade) != 1 && length(ntrade) != 2) {
		stop(paste("'ntrade' must have length 1 or 2 -- given",
			"has length", length(ntrade), "and mode",
			mode(ntrade), "and", 
			sum(is.na(ntrade)), "missing value(s)"))
	}
	if(!is.numeric(ntrade) || any(is.na(ntrade)) || any(ntrade < 0)) {
		stop(paste("'ntrade' must be 1 or 2 non-negative,",
			"non-missing integers",
			"or NULL -- given has mode", mode(ntrade),
			"and length", length(ntrade), "and", 
			sum(is.na(ntrade)), "missing value(s)"))
	}
	ntrade.orig <- ntrade
	ntrade <- sort(ntrade)
	ntrade <- pmin(ntrade, nassets + 1)
	ntrade.round <- round(ntrade)
	if(any(abs(ntrade.round - ntrade) > 1e-6)) {
		stop(paste(sum(abs(ntrade.round - ntrade) > 1e-6),
			"value(s) in 'ntrade' not sufficiently close",
			"to an integer"))
	}
	ntrade <- ntrade.round
	ntrade.given <- max(ntrade)
	if(length(ntrade) == 2) {
		min.ntrade <- ntrade[1]

		ntrade <- ntrade[2]
	} else {
		ntrade <- min(ntrade, nassets + 1)
		if(ntrade < 0) {
			stop(paste("'ntrade' must be non-negative,",
				"value given was:", ntrade))
		}
		min.ntrade <- 0
	}
	if(norig) {
		ntnew <- length(setdiff(assetnam[trade.univ > 0], existnam))
		maxportsize.nat <- norig + min(ntrade, ntnew)
	} else {
		maxportsize.nat <- min(ntrade, sum(trade.univ > 0))
	}
	ntrade <- min(ntrade, sum(trade.univ > 0))
	if(length(ntrade.orig) == 2 && min(ntrade.orig) > ntrade) {
		stop(paste("minimum number of assets to trade specified as",
			min(ntrade.orig), "but maximum possible to trade is",
			sum(trade.univ > 0), "and maximum number to trade is",
			ntrade))
	}

	if(length(forced.trade) > ntrade) {
		stop(paste("'ntrade' (", ntrade, ") smaller than number of",
			" forced trades (", length(forced.trade), ")",
			sep=""))
	}
	if(length(forced.trade) && turnover[2] < sum(abs(forced.trade) * 
			prices[names(forced.trade)])) {
		stop(paste("forced trade value (", sum(abs(forced.trade) *
			prices[names(forced.trade)]), 
			") exceeds 'turnover' upper limit (",
			turnover[2], ")", sep=""))
	}

	if(is.null(port.size)) port.size <- c(0, nassets + 1)
	if(!is.numeric(port.size) || any(is.na(port.size)) || 
			any(port.size < 0)) {
		stop(paste("'port.size' must be 1 or 2 non-negative,",
			"non-missing integers",
			"or NULL -- given has mode", mode(port.size),
			"and length", length(port.size), "and", 
			sum(is.na(port.size)), "missing value(s)"))
	}
	if(implied.min.port.size > norig + ntrade) {
		stop(paste( "impossible portfolio size", implied.min.port.size,
			"implied by 'sum.weight'", "with 'ntrade' equal", 
			ntrade, "and", norig, "assets in existing portfolio"))
	}
	port.size.orig <- port.size
	port.size <- pmin(port.size, nassets + 1)
	port.size.round <- round(port.size)
	if(any(abs(port.size - port.size.round) > 1e-6)) {
		stop(paste(sum(abs(port.size - port.size.round) > 1e-6),
			"value(s) in 'port.size' not sufficiently close",
			"to an integer"))
	}
	port.size <- port.size.round
	if(length(port.size) == 2) {
		port.size <- sort(port.size)
		port.size[port.size < 0] <- 0
		if(all(port.size == 0)) stop("maximum 'port.size' is zero")
		port.size[1] <- max(port.size[1], implied.min.port.size)
		if(min(port.size.orig) > norig + ntrade) {
			stop(paste("impossible value for minimum 'port.size'",
				min(port.size.orig), "with 'ntrade' equal", 
				ntrade, "and", norig, 
				"assets in existing portfolio"))
		}
		if(min(port.size.orig) > nassets) {
			stop(paste("impossible value for minimum 'port.size'",
				min(port.size.orig), "with number of assets",
				"equal to", nassets))
		}
	} else if(length(port.size) == 1) {
		# this must be user input
		if(port.size < norig - ntrade) {
			stop(paste("impossible value for 'port.size' (",
				port.size, "), should be at least ",
				norig - ntrade, " since 'ntrade' is only ",
				ntrade, " and the existing portfolio has ",
				norig, " assets", sep=''))
		}
		if(port.size >= norig + ntrade) port.size <- nassets + 1
		port.size <- c(implied.min.port.size, port.size)
	} else if(length(port.size) == 0) {
		port.size <- c(implied.min.port.size, nassets + 1)
	} else {
		stop(paste("'port.size' must have length 0, 1 or 2",
			"-- given has length", length(port.size), "and mode",
			mode(port.size)))
	}
	if(implied.min.port.size > port.size[2]) {
		stop(paste( "impossible portfolio size:", implied.min.port.size,
			"implied by 'sum.weight'",
			"with maximum port.size equal", port.size[2]))
	}
	if(!is.na(pos.portsize) && pos.portsize > port.size[2]) {
		stop(paste(pos.portsize, "assets forced into portfolio by",
			"'positions' argument but only up to", port.size[2],
			"assets allowed"))
	}
	sizes["portsize.on"] <- port.size[1] > 0 || port.size[2] < nassets
	
	if(length(close.number)) {
		if(length(close.number) > 2) 
			stop(paste("'close.number' must have length 0, 1, or 2",
				"-- given has length", length(close.number),
				"and mode", mode(close.number)))
		if(!is.numeric(close.number)) {
			stop(paste("'close.number' must be numeric",
				"-- given value has mode", mode(close.number),
				"and length", length(close.number)))
		}
		if(any(is.na(close.number))) {
			stop(paste(sum(is.na(close.number)),
				"missing value(s) in 'close.number'"))
		}
		if(any(is.infinite(close.number))) {
			stop(paste(sum(is.infinite(close.number)),
				"infinite value(s) in 'close.number'"))
		}
		close.round <- round(close.number)
		if(any(abs(close.round - close.number) > 1e-6)) {
			stop(paste(sum(abs(close.round - close.number) > 1e-6),
				"value(s) in 'close.number' not",
				"sufficiently close to an integer"))
		}
		close.number <- close.round
		if(any(close.number < 0)) {
			stop("negative numbers not allowed in 'close.number'")
		}
		if(length(close.number) == 1) {
			close.number <- c(close.number, close.number)
		} else {
			close.number <- sort(close.number)
		}
		if(close.number[1] > ntrade) {
			stop(paste("minimum number to close (", 
				close.number[1], ") is greater than 'ntrade' (",
				ntrade, ")", sep=""))
		}
		if(close.number[1] > norig) {
			stop(paste("minimum number to close (", 
				close.number[1], ") is greater than the",
				" number of existing positions (",
				norig, ")", sep=""))
		}
		close.number[1] <- max(close.number[1], 0,
			norig - max(port.size))
		close.number[2] <- min(close.number[2], ntrade, norig,
			max(0, floor((norig - min(port.size) + ntrade)/2)))
	} else {
		close.number <- c(max(0, norig - max(port.size)), 
			min(max(0, floor((norig - min(port.size) + ntrade)/2)),
			ntrade, norig))
	}
	if(close.number[1] > close.number[2]) {
		stop(paste("inconsistent constraints between 'close.number'",
			" (at least ", close.number[1], ", no more than ",
			close.number[2],
			") and implied or explicit 'port.size' (at least ",
			min(port.size), ", no more than ", maxportsize.nat,
			")", sep=""))
	}
	if(length(existing)) {
		closeable <- lower.trade[existnam] <= -existing &
			-upper.trade[existnam] <= existing
		ncloseable <- sum(closeable)
	} else {
		ncloseable <- 0
	}
	if(close.number[1] > ncloseable) {
		stop(paste("minimum number of positions to close is",
			close.number[1], "but only", ncloseable,
			"assets are closeable"))
	}
	if(close.number[1] > 0 && is.finite(turnover[2])) {
		closeval <- sort(abs(prices[existnam] * existing)[closeable])
		close.treq <- sum(closeval[1:close.number[1]])
		if(close.treq > turnover[2]) {
			stop(paste("need 'turnover' to be at least",
				close.treq, "in order to close",
				close.number[1], "positions"))
		}
	}
	close.num.type <- as.numeric(close.number[2] < ntrade) + 2 *
		as.numeric(close.number[1] > 0)

	if(turnover.type >= 0) {
		ntrade <- min(ntrade, max(port.size) + norig)
		if(ntrade < 0) stop("no trades allowed in this formulation")
		if(ntrade == 0) {
			if(norig == 0) {
				stop("zero 'ntrade' and no existing portfolio")
			}
			if(ntrade.given > 0 && do.warn["notrade"]) {
				warning(paste("no trading allowed in this",
					"formulation ('do.warn' suppression",
					"is 'notrade')"))
			}
			turnover.type <- -1
			ntrade <- 1
			icontrol["funeval.max"] <- 1
		}
	} else {
		ntrade <- 1
		icontrol["funeval.max"] <- 1
	}
	icontrol["npar"] <- ntrade
	tradnams <- names(trade.univ)[trade.univ > 0]

	mwsum <- sum(rev(sort(max.weight[tradnams]))[1:min(max(port.size),
		maxportsize.nat, length(tradnams))])
	if(mwsum < 1.001 && length(tradnams) > 1 && ntrade + norig > 1 &&
			icontrol["funeval.max"] > 1 && turnover.type >= 0) {
		stop("'max.weight' is too restrictive")
	}
	if(mwsum < 1.5 && length(tradnams) > 4 && ntrade + norig > 2 &&
			do.warn["max.weight.restrictive"] && turnover.type
			>= 0) {
		warning(paste("'max.weight' is quite restrictive ('do.warn'",
			"suppression is 'max.weight.restrictive')"))
	}

	if(length(expected.return)) {
		expected.return <- as.matrix(expected.return)
		alphanam <- dimnames(expected.return)[[1]]
		if(length(alphanam)) {
			if(any(duplicated(alphanam))) {
				stop(paste(sum(duplicated(alphanam)),
					"duplicated asset(s) in",
					"'expected.return':", paste(
					alphanam[duplicated(alphanam)],
					collapse=", ")))
			}
			al.good <- unique(intersect(alphanam, assetnam))
			if(length(intersect(al.good, tradnams)) < 
					length(tradnams))
				stop(paste("'expected.return' missing",
					"tradable asset(s):",
					paste(setdiff(tradnams, al.good),
					collapse=", ")))
			if(length(al.good) == nassets) {
				expected.return <- expected.return[assetnam,,
					drop=FALSE]
			} else {
				exret.orig <- expected.return
				if(bench.trade && length(benchmark) && 
						any(is.na(match( benchmark, 
						al.good, nomatch=NA)))) {
					warning("assuming zero expected return for benchmark(s)")
				}
				expected.return <- array(0, c(nassets,
					dim(exret.orig)[2]), list(assetnam,
					NULL))
				expected.return[al.good, ] <- exret.orig[
					al.good,]
			}
		} else {
			if(nrow(expected.return) != nassets) {
				stop(paste("'expected.return' not the",
					"correct size -- should represent",
					nassets, "assets but given represents",
					nrow(expected.return), "and has mode",
					mode(expected.return)))
			}
			if(do.warn["no.asset.names"]) {
				warning(paste("no asset names for",
					"'expected.return', assuming correct",
					"order ('do.warn' suppression is",
					"'no.asset.names')"))
			}
		}
		if(!is.numeric(expected.return)) {
			stop(paste("'expected.return' should be numeric",
				"-- given has mode", mode(expected.return),
				"and length", length(expected.return)))
		}
		if(any(is.na(expected.return))) {
			stop(paste(sum(is.na(expected.return)),
				"missing value(s) in 'expected.return'"))
		}
		if(any(is.infinite(expected.return))) {
			stop(paste(sum(is.infinite(expected.return)),
				"infinite value(s) in 'expected.return'"))
		}
		nret <- dim(expected.return)[2]
		checkinput$expected.return <- c(expected.return[1:5], nret)
	} else {
		if(!is.null(expected.return) && !is.numeric(expected.return)) {
			stop(paste("bad value for 'expected.return'",
				"-- should be NULL or numeric, actual is",
				mode(expected.return)))
		}
		expected.return <- 0
		nret <- 0
	}

	sizes[c("nassets", "ntrade", "norig")] <- c(nassets, ntrade, norig) 
	sizes["long.only"] <- long.only
	sizes[c("nvariances", "nalphas", "nbenchmarks")] <- c(nvar, nret,
		nbenchmarks)
	sizes["turnover.constraint"] <- turnover.type
	sizes["ntradebuyonly"] <- sum(trade.univ == 1 | trade.univ == 5 |
		trade.univ == 7)
	sizes["ntradesellonly"] <- sum(trade.univ == 2 | trade.univ == 6 |
		trade.univ == 8)
	sizes["ntradebuysell"] <- sum(trade.univ == 3)
	sizes["adjust"] <- auxcontrol["adjust"]
	sizes["nodoubleconst"] <- if(auxcontrol["doubleconst"]) 0 else 1
	sizes["single.search"] <- auxcontrol["single.search"]
	sizes["close.number.type"] <- close.num.type
	sizes["ignore.util"] <- 0
	sizes["min.ntrade"] <- min.ntrade
	shortcut <- NA
	if(is.na(shortcut)) {
		if(length(existing) > 2 && icontrol["funeval.max"] > 1) {
			sizes["shortcut"] <- 1
		} else {
			sizes["shortcut"] <- 0
		}
	} else {
		sizes["shortcut"] <- shortcut
	}

	sizes["n.forced.trades"] <- length(forced.trade)
	if(sizes["n.forced.trades"]) {
		forced.id <- match(names(forced.trade), assetnam) - 1
		forced.ord <- order(forced.id)
		forced.id <- forced.id[forced.ord]
		forced.trade <- forced.trade[forced.ord]
	} else {
		forced.id <- 0
		forced.trade <- 0
	}

	if(!length(start.sol) && turnover.type >= 0 && icontrol["funeval.max"]
			<= 1) {
		stop("need 'start.sol' when 'funeval.max' <= 1")
	}
	real.start <- NULL
	sizes["startgiven"] <- 0
	if(length(start.sol)) {
		if(inherits(start.sol, "portfolBurSt"))
			start.sol <- start.sol$trade
		if(icontrol["funeval.max"] <= 1) {
			if(is.list(start.sol)) {
				real.start <- start.sol[[1]]
			} else {
				real.start <- start.sol
			}
			real.start <- real.start[real.start != 0]
		}
		start.rec <- .tradeopt.rectify.start(start.sol, ntrade, 
			assetnam, trade.univ, sharetol)
		start.sol <- start.rec$shares
		start.id <- start.rec$id
		popgiven <- ncol(start.sol)
		if(!length(popgiven)) popgiven <- 0
		sizes["startgiven"] <- icontrol["popgiven"] <- popgiven 
		if(popgiven > icontrol["icon01"]) {
			icontrol["icon01"] <- popgiven
		}
	} else if(norig > 0 && min.ntrade <= 0 && 
			sizes["n.forced.trades"] == 0) {
		start.sol <- rep(0, ntrade)
		if(turnover.type >= 0) {
			start.which <- which(trade.univ != 0) 
			start.which <- start.which[order(rep(seed, length=
				length(start.which)))]
			start.id <- sort(start.which[1:ntrade]) - 1
		} else {
			start.id <- 0
		}
		icontrol["popgiven"] <- 1
	} else {
		icontrol["popgiven"] <- 0
		start.id <- start.sol <- rep(0, ntrade)
	}

	predist <- .tradeopt.predist(dist.center=dist.center,
		dist.style=dist.style, dist.bounds=dist.bounds,
		dist.trade=dist.trade, dist.utility=dist.utility,
		dist.prices=dist.prices, big=big, nassets=nassets,
		assetnam=assetnam, do.warn=do.warn, prices=prices,
		gross.value=gross.value)
	sizes[names(predist$distsizes)] <- predist$distsizes

	bc.id <- bc.loc <- bc.lval <- bc.uval <- NULL
	bc.num <- 0
	if(length(vtable)) {
		if(length(bench.constraint) && safe.mode) 
			stop("'bench.constraint' may not be given if 'vtable' is")
		vtbench <- attr(vtable, "benchmarks")
		vtable <- as.matrix(vtable)
		if(nrow(vtable) != 3 || !is.numeric(vtable)) 
			stop("'vtable' must be a numeric matrix with 3 rows")
		if(any(is.na(vtable))) stop("missing value(s) in 'vtable'")
		if(length(vtbench) != ncol(vtable)) {
			stop(paste("length of 'benchmarks' attribute of ",
				"'vtable' (", length(vtbench), ") is ",
				"not equal to the number of columns in ",
				"'vtable' (", ncol(vtable), ")", sep=""))
		}
		if(!is.character(vtbench)) {
			stop(paste("'benchmarks' attribute of 'vtable'",
				"should be character -- given mode is",
				mode(vtbench)))
		}
		vtbenid <- rep(-1, ncol(vtable))
		if(any(nchar(vtbench))) {
			vtbensub <- vtbench[nchar(vtbench) > 0]
			vtbout <- setdiff(vtbensub, assetnam)
			if(length(vtbout)) {
				stop(paste(length(vtbout), "element(s)",
					"of the 'benchmarks' attribute of",
					"'vtable' are unknown assets:",
					paste(vtbout, collapse=", ")))
			}
			vtbenid[nchar(vtbench) > 0] <- match(vtbensub,
				assetnam) - 1
		}
		vtable[2, ] <- vtbenid
		v.a <- vtable[1,]
		if(nvar && (any(v.a < 0 || v.a >= nvar))) {
			stop(paste("variance(s) out of bounds in 'vtable'",
				"-- should be zero-based indices from 0 to",
				nvar - 1))
		}
		if(!nvar && (any(v.a >= 0 || ncol(vtable) > 1))) {
			stop(paste("'vtable' wrong for no variances",
				"-- should be one-column matrix with first",
				"row containing '-1'"))
		}
		if(!all(is.finite(vtable[3,]))) {
			stop(paste("bad utility.only in 'vtable'",
				"-- must be finite and not missing"))
		}
		dimnames(vtable) <- list(c("variance", "benchmark", 
			"utility.only"), NULL)
		attr(vtable, "benchmarks") <- vtbench
	} else if(nvar == 0) {
		vtable <- cbind(c(variance=-1, benchmark=-1, utility.only=1))
		attr(vtable, "benchmarks") <- ""
	} else {
		v.a1 <- seq(0, by=1, length=nvar)
		v.a <- rep(v.a1, length(bench.id))
		v.b <- rep(bench.id, rep(length(v.a1), length(bench.id)))
		# vtable <- rbind(variance=v.a, benchmark=v.b)
		vtable <- rbind(variance=v.a, benchmark=v.b,
		 	utility.only=1)
		if(length(bench.constraint)) {
			bc.id <- match(dimnames(bench.constraint)[[1]], 
				assetnam, nomatch=NA) - 1
			if(any(is.na(bc.id))) {
				stop(paste(sum(is.na(bc.id)), 
					"bad asset names in 'bench.constraint':",
					paste(dimnames(bench.constraint)[[1]]
					[is.na(bc.id)], collapse=", ")))
			}
			if(!bench.trade) {
				out.price <- unique(c(out.price, bc.id + 1))
			}
			vt.orig <- vtable
			vtoc <- ncol(vt.orig)
			vt.new <- array(NA, c(3, nvar * length(bc.id)))
			vt.new[1,] <- v.a1
			vt.new[2,] <- rep(bc.id, rep(nvar, length(bc.id)))
			vt.new[3,] <- 0
			vtable <- cbind(vt.orig, vt.new)
			vt.dup <- rev(duplicated(rev(paste(vtable[1,],
				vtable[2,]))))
			vtable <- vtable[, !vt.dup, drop=FALSE]
			vtd <- match(paste(vt.orig[1,], vt.orig[2,]),
				paste(vtable[1,], vtable[2,]))
			bc.loc <- seq(0, by=1, length=ncol(vtable))[
				vtable[3,] == 0]
			bc.num <- ncol(vt.new)
			if(length(bc.loc) != bc.num) {
				stop(paste("bad computation for",
					"'bench.constraint' -- found",
					length(bc.loc), "locations, expected",
					bc.num))
			}
			bc.uval <- rep(bench.constraint[,2], rep(nvar, 
				nrow(bench.constraint)))
			bc.lval <- rep(bench.constraint[,1], rep(nvar, 
				nrow(bench.constraint)))
		}
		vtbench <- rep("", ncol(vtable))
		vtbid <- vtable[2,] + 1
		vtbench[vtbid > 0] <- assetnam[ vtbid[vtbid > 0] ]
		attr(vtable, "benchmarks") <- vtbench
	}

	if(length(out.price)) {
		if(any(prices[-out.price] <= 0)) 
			stop(paste(sum(prices[-out.price] <= 0), 
				"usable price(s) are negative or zero"))
	} else {
		if(any(prices <= 0)) stop("negative or zero prices found")
	}

	if(length(atable)) {
		atbench <- attr(atable, "benchmarks")
		atable <- as.matrix(atable)
		if(nrow(atable) != 2 || !is.numeric(atable)) {
			stop(paste("'atable' must be a numeric matrix",
				"with 2 rows -- given has mode",
				mode(atable), "and length", length(atable)))
		}
		if(any(is.na(atable))) {
			stop(paste(sum(is.na(atable)),
				"missing value(s) in 'atable'"))
		}
		if(length(atbench) != ncol(atable)) {
			stop(paste("length of 'benchmarks' attribute of ",
				"'atable' (", length(atbench), ") is ",
				"not equal to the number of columns in ",
				"'atable' (", ncol(atable), ")", sep=""))
		}
		if(!is.character(atbench)) {
			stop(paste("'benchmarks' attribute of 'atable'",
				"should be character -- given mode is",
				mode(atbench)))
		}
		atbenid <- rep(-1, ncol(atable))
		if(any(nchar(atbench))) {
			atbensub <- atbench[nchar(atbench) > 0]
			atbout <- setdiff(atbensub, assetnam)
			if(length(atbout)) {
				stop(paste(length(atbout), "element(s)",
					"of the 'benchmarks' attribute of",
					"'atable' are unknown assets:",
					paste(atbout, collapse=", ")))
			}
			atbenid[nchar(atbench) > 0] <- match(atbensub,
				assetnam) - 1
		}
		atable[2, ] <- atbenid
		a.a <- atable[1,]
		if(nret && (any(a.a < 0 || a.a >= nret))) {
			stop(paste("alpha id(s) out of bounds in 'atable'",
				"-- should be zero-based indices from 0 to",
				nret - 1))
		}
		if(!nret && (any(a.a >= 0 || ncol(atable) > 1))) {
			stop(paste("'atable' wrong for no expected returns",
				"-- should be one-column matrix with first",
				"row containing '-1'"))
		}
		dimnames(atable) <- list(c("alpha", "benchmark"), NULL)
		attr(atable, "benchmarks") <- atbench
	} else {
		if(nret) {
			a.a1 <- seq(0, by=1, length=nret)
			a.a <- rep(a.a1, length(bench.id))
			a.b <- rep(bench.id, rep(length(a.a1), 
				length(bench.id)))
			atable <- rbind(a.a, a.b)
		} else {
			atable <- matrix(c(-1,-1), 2, 1)
		}
		dimnames(atable) <- list(c("alpha", "benchmark"), NULL)
		atbench <- rep("", ncol(atable))
		atbid <- atable[2,] + 1
		atbench[atbid > 0] <- assetnam[ atbid[atbid > 0] ]
		attr(atable, "benchmarks") <- atbench
	}

	sizes["nvarcomben"] <- nvarcomben <- ncol(vtable)
	sizes["nalcomben"] <- nalcomben <- ncol(atable)

	if(!is.numeric(penalty.constraint)) {
		stop(paste("'penalty.constraint' must be numeric, not",
			mode(penalty.constraint)))
	}
	if(any(is.na(penalty.constraint)) || 
			any(is.infinite(penalty.constraint))) {
		stop(paste(sum(is.na(penalty.constraint)), 
			"missing value(s) in 'penalty.constraint' and",
			sum(is.infinite(penalty.constraint)), 
			"infinite value(s)"))
	}
	if(!length(penalty.constraint)) 
		stop("'penalty.constraint' is length zero")
	if(any(penalty.constraint < 0)) 
		stop("negative value(s) in 'penalty.constraint'")

	# linear constraints
	linabs.miss <- missing(lin.abs)
	linpre <- .tradeopt.prelin(lin.constraints=lin.constraints,
		lin.bounds=lin.bounds, lin.style=lin.style, 
		lin.trade=lin.trade, lin.direction=lin.direction, 
		lin.abs=lin.abs, lin.rfloc=lin.rfloc, big=big, nassets=nassets, 
		assetnam=assetnam, out.price=out.price, sizes=sizes,
		do.warn=do.warn)
	constrain.levels <- linpre$constrain.levels
	nconsmain <- linpre$nconsmain
	if(nconsmain && linabs.miss && (!long.only || any(lin.trade)) && 
			do.warn["back.compat"]) {
		warning(paste("the default value of 'lin.abs' is now 'TRUE'",
			"unlike in previous versions ('do.warn'  suppression",
			"is 'back.compat' -- or just specify 'lin.abs')"))
	}
	constrainvec <- linpre$constrainvec
	lin.stylenum <- linpre$lin.stylenum
	lin.style <- linpre$lin.style
	lin.direction <- linpre$lin.direction
	lin.abs <- linpre$lin.abs
	lin.trade <- linpre$lin.trade
	lin.constraints <- linpre$lin.constraints
	lin.rfloc <- linpre$lin.rfloc
	linconstnames <- linpre$linconstnames
	low.constraint <- linpre$low.constraint
	up.constraint <- linpre$up.constraint
	bounds.infinite <- linpre$bounds.infinite
	sizes[names(linpre$linsizes)] <- linpre$linsizes

	gross.value <- sort(gross.value)
	net.value <- sort(net.value)
	net.value[1] <- max(net.value[1], -gross.value[2])
	net.value[2] <- min(net.value[2], gross.value[2])
	long.value <- sort(long.value)
	long.value[1] <- max(0, long.value[1])
	long.value[2] <- min(long.value[2], gross.value[2])
	short.value <- sort(abs(short.value))
	short.value[1] <- max(0, short.value[1])
	short.value[2] <- min(short.value[2], gross.value[2])
	turnover[2] <- min(turnover[2], big)
	low.constraint <- c(low.constraint, gross.value[1], net.value[1],
		long.value[1], short.value[1], turnover[1], min(port.size))
	up.constraint <- c(up.constraint, gross.value[2], net.value[2],
		long.value[2], short.value[2], turnover[2], max(port.size))

	if(length(var.constraint)) {
		if(nvar == 0) {
			stop("variance constraint but NULL variance")
		}
		if(!is.numeric(var.constraint)) {
			stop(paste("'var.constraint' must be numeric",
				"-- given has mode", mode(var.constraint)))
		}
		if(is.matrix(var.constraint)) {
			vcnam <- dimnames(var.constraint)[[1]]
		} else {
			vcnam <- names(var.constraint)
		}
		var.constraint <- as.matrix(var.constraint)
		if(ncol(var.constraint) > 2) {
			stop(paste("too many columns in 'var.constraint'",
				"-- should have one or two columns, given has",
				ncol(var.constraint)))
		}
		if(any(is.na(var.constraint))) 
			stop("missing value(s) in 'var.constraint'")
		if(ncol(var.constraint) == 1) {
			var.constraint[var.constraint > big] <- big
			var.constraint <- cbind(-big, var.constraint)
			dimnames(var.constraint) <- list(vcnam, NULL)
		} else {
			var.constraint[var.constraint < -big] <- -big
			var.constraint[var.constraint > big] <- big
			if(any(var.constraint[,1] >= var.constraint[,2])) {
				stop(paste(sum(var.constraint[,1] >= 
					var.constraint[,2]), "constraint(s)",
					"in 'var.constraint' have the",
					"lower bound >= the upper"))
			}
		}
		sizes["nvarcon"] <- nrow(var.constraint) + bc.num
		if(length(dimnames(var.constraint)[[1]])) {
			varconid <- as.numeric(dimnames(var.constraint)[[1]])
			if(any(is.na(varconid))) {
				stop(paste("bad (row)names on",
					"'var.constraint' -- should be",
					"zero-based indices between 0 and",
					nvarcomben - 1, "inclusive"))
			}
		} else {
			varconid <- seq(0, by=1, length=nrow(var.constraint))
		}
		if(any(varconid < 0 | varconid >= nvarcomben)) {
			stop(paste("bad (row)names for",
				"'var.constraint' -- the names",
				"should be 0-indexed not 1-indexed,",
				"allowed range is 0 to", nvarcomben - 1,
				"inclusive"))
		}
		vtable[3, varconid + 1] <- 0
	} else {
		if(!is.null(var.constraint) && !is.numeric(var.constraint)) {
			stop(paste("bad value for 'var.constraint'",
				"-- needs to be either NULL or numeric",
				"given has mode", mode(var.constraint)))
		}
		sizes["nvarcon"] <- bc.num
		varconid <- NULL
	}
	if(length(alpha.constraint)) {
		if(!is.numeric(alpha.constraint)) {
			stop(paste("'alpha.constraint' must be numeric",
				"-- given has mode", mode(alpha.constraint)))
		}
		if(is.matrix(alpha.constraint)) {
			alphnam <- dimnames(alpha.constraint)[[1]]
		} else {
			alphnam <- names(alpha.constraint)
		}
		alpha.constraint <- as.matrix(alpha.constraint)
		if(nret == 0) {
			stop(paste("alpha constraints do not make sense",
				"for this formulation -- no expected returns"))
		}
		if(ncol(alpha.constraint) > 2) {
			stop(paste("too many columns for 'alpha.constraint'",
				"-- should have 1 or 2 columns, given has",
				ncol(alpha.constraint)))
		}
		if(any(is.na(alpha.constraint)))
			stop("missing value(s) in 'alpha.constraint'")
		if(ncol(alpha.constraint) == 1) {
			alpha.constraint[alpha.constraint < -big] <- -big
			alpha.constraint <- cbind(alpha.constraint, big)
			dimnames(alpha.constraint) <- list(alphnam, NULL)
		} else {
			alpha.constraint[alpha.constraint < -big] <- -big
			alpha.constraint[alpha.constraint > big] <- big
			if(any(alpha.constraint[,1] >= alpha.constraint[,2])) {
				stop(paste(sum(alpha.constraint[,1] >=
					alpha.constraint[,2]), "constraint(s)",
					"in 'alpha.constraint' have the",
					"lower bound >= the upper"))
			}
		}
		sizes["nalphacon"] <- nrow(alpha.constraint)
		if(length(dimnames(alpha.constraint)[[1]])) {
			alphaconid <- as.numeric(dimnames(alpha.constraint)[[
				1]])
			if(any(is.na(alphaconid))) {
				stop(paste("bad (row)names on",
					"'alpha.constraint' -- need to be",
					"zero-based indices from 0 to",
					nalcomben - 1))
			}
		} else {
			alphaconid <- seq(0, by=1, length=sizes["nalphacon"])
		}
		if(any(alphaconid < 0 | alphaconid >= nalcomben)) {
			stop(paste("bad (row)names for",
				"'alpha.constraint' -- the names",
				"should be zero-based indices from 0 to",
				nalcomben - 1))
		}
	} else {
		if(!is.null(alpha.constraint) && !is.numeric(alpha.constraint)){
			stop(paste("bad value for 'alpha.constraint'",
				"-- given has mode", mode(alpha.constraint),
				"and length", length(alpha.constraint)))
		}
		sizes["nalphacon"] <- 0
		alphaconid <- NULL
	}

	pc.given <- penalty.constraint
	penalty.constraint <- rep(1000, length = nconsmain + 14 + 
		sizes["nvarcon"] + sizes["nalphacon"] + sizes["distconnum"])
	pcn.set1 <- c("gross", "net", "long", "short", "turnover", "port.size")
	pcn.set2 <- c("sum.weight", "cost", "close", "forced.trade", 
		"min ntrade", "trade threshold", "portfolio threshold")
	pcnam <- c(linconstnames, pcn.set1, if(bc.num) paste("benchmark", 
		dimnames(bench.constraint)[[1]]), if(sizes["nvarcon"] > bc.num)
		paste("variance", varconid), if(sizes["nalphacon"]) 
		paste("alpha", alphaconid), pcn.set2, if(sizes["distconnum"])
		paste("dist", seq(sizes["distnum"])[!dist.utility]), 
		"risk.fraction")
	names(penalty.constraint) <- pcnam
	if(length(names(pc.given))) {
		pc.num <- match(names(pc.given), names(penalty.constraint),
			nomatch=NA)
		if(any(is.na(pc.num))) {
			stop(paste("name(s) of 'penalty.constraint' not right:",
				paste(names(pc.given)[is.na(pc.num)], 
				collapse=", ")))
		}
		penalty.constraint[pc.num] <- pc.given
	} else {
		penalty.constraint[] <- pc.given
	}
	if(length(var.constraint)) {
		vc.up <- var.constraint[,2]
		vc.lo <- var.constraint[,1]
	} else {
		vc.up <- vc.lo <- NULL
	}
	if(length(alpha.constraint)) {
		ac.up <- alpha.constraint[,2]
		ac.lo <- alpha.constraint[,1]
	} else {
		ac.up <- ac.lo <- NULL
	}
	if(length(sum.weight)) {
		up.constraint <- c(up.constraint, vc.up, bc.uval, 
			ac.up, sum.weight[,2])
		low.constraint <- c(low.constraint, vc.lo, bc.lval,
			ac.lo, sum.weight[,1])
	} else {
		up.constraint <- c(up.constraint, vc.up, bc.uval, ac.up)
		low.constraint <- c(low.constraint, vc.lo, bc.lval, ac.lo)
	}
	constrain.levels <- c(constrain.levels, varconid, bc.loc, alphaconid, 
		sumwtid, 0)

	ndval <- 10
	dvalues <- double(ndval)
	dvalnam <- c("", "origgross", "sharetol", "", "", "gross.trade", 
		"net.trade", "new.trade.avetol", "quantile", "qwt.sum")
	names(dvalues) <- dvalnam
	sizes["ndval"] <- ndval

	dvalues["sharetol"] <- sharetol 
	if(norig) {
		if(turnover.type == 2) {
			# min trade, no max
			dvalues["gross.trade"] <- max(0.25 * gross.value[2],
				1.2 * turnover[1])
		} else if(turnover.type > 0) {
			if(1.2 * turnover[1] > 0.8 * turnover[2]) {
				dvalues["gross.trade"] <- mean(turnover)
			} else {
				dvalues["gross.trade"] <- 0.8 * turnover[2]
			}
		} else {
			dvalues["gross.trade"] <- 0.25 * gross.value[2]
		}
		dvalues["origgross"] <- exist.lvalue + exist.svalue
	} else {
		dvalues["gross.trade"] <- gross.value[2]
		dvalues["origgross"] <- 0
	}
	if(is.finite(turnover[2])) {
		dvalues["gross.trade"] <- min(turnover[2] * .99, 
			dvalues["gross.trade"])
	}
	exist.net <- exist.lvalue - exist.svalue
	nt.val <- mean(net.value) - exist.net
	if(!long.only && abs(nt.val) > 0.8 * dvalues["gross.trade"]) {
		if(exist.net > net.value[2]) {
			if(exist.net - net.value[2] < 0.8 * dvalues[
					"gross.trade"]) {
				dvalues["net.trade"] <- -0.8 * dvalues[
					"gross.trade"]
			} else {
				dvalues["net.trade"] <- -dvalues["gross.trade"]
			}
		} else if(exist.net < net.value[1]) {
			if(net.value[1] - exist.net < 0.8 * dvalues[
					"gross.trade"]) {
				dvalues["net.trade"] <- 0.8 * dvalues[
					"gross.trade"]
			} else {
				dvalues["net.trade"] <- dvalues["gross.trade"]
			}
		} else {
		# inside span of net
		dvalues["net.trade"] <- sign(nt.val) * 0.5 * 
			dvalues["gross.trade"]
		}
	} else {
		dvalues["net.trade"] <- nt.val
	}

        if(length(quantile) != 1) {
		stop(paste("'quantile' must have length one",
			"-- given has length", length(quantile)))
	}
	if(!is.numeric(quantile)) {
		stop(paste("'quantile' must be numeric -- given has mode",
			mode(quantile)))
	}
	if(is.na(quantile)) stop("missing value for 'quantile'")
	if(quantile < 0 || quantile > 1) {
		stop(paste("'quantile' must be between 0 and 1 (inclusive)",
			"-- given has value:", quantile))
	}
	dvalues["quantile"] <- quantile 
	if(length(dest.wt)) {
		if(!is.numeric(dest.wt)) {
			stop(paste("'dest.wt' must be numeric -- given",
				"has mode", mode(dest.wt), "and length",
				length(dest.wt)))
		}
		if(length(dest.wt) != sizes["ndest"]) {
			stop(paste("'dest.wt' should have length", 
				sizes["ndest"], "not", length(dest.wt)))
		}
		if(any(is.na(dest.wt))) stop("missing value(s) in 'dest.wt'")
		if(any(dest.wt <= 0)) 
			stop("negative or zero weights not allowed in 'dest.wt'")
		dvalues["qwt.sum"] <- qwt.sum <- sum(dest.wt)
		sizes["qwt.all1"] <- 0
	} else {
		sizes["qwt.all1"] <- 1
		dest.wt <- 1
	}


	costpre <- .tradeopt.precost(long.buy.cost=long.buy.cost, 
		long.sell.cost=long.sell.cost, short.buy.cost=short.buy.cost, 
		short.sell.cost=short.sell.cost, limit.cost=limit.cost,
		cost.par=cost.par, scale.cost=scale.cost, big=big,
		nassets=nassets, assetnam=assetnam, tradnams=tradnams,
		sizes=sizes, climit.only=climit.only)
	cost <- costpre$cost
	cost.par <- costpre$cost.par
	limit.cost <- costpre$limit.cost
	cost.intercept <- costpre$cost.intercept
	sizes[names(costpre$costsizes)] <- costpre$costsizes

	riskfracpre <- .tradeopt.preriskfrac(risk.fraction=risk.fraction,
		rf.style=rf.style, rf.loc=rf.loc, nvar=nvar, 
		nvarcomben=nvarcomben, nassets=nassets, assetnam=assetnam, 
		maxps=min(maxportsize.nat, max(port.size)), vtable=vtable,
		dwarn=do.warn[c("index.zero", "riskfrac.part", 
		"superfluous.constraint")], big=big)
	rfracactive <- riskfracpre$rfracactive
	rfracvec <- riskfracpre$rfracvec
	rfstynum <- riskfracpre$rfstynum
	rfloc <- riskfracpre$rfloc

	rf2 <- .tradeopt.riskfrac2(rfracactive=rfracactive, rfloc=rfloc, 
		rfstynum=rfstynum, vartype=vartype, vtable=vtable, 
		nassets=nassets, assetnam=assetnam, lin.stylenum=lin.stylenum,
		lin.rfloc=lin.rfloc, rf.stylemenu=riskfracpre$rf.stylemenu,
		dumpfile=dumpfile, Mc=Mc)
	rftab <- rf2$rftab
	rfvarid <- rf2$rfvarid
	bwreq <- rf2$bwreq
	benchwtid <- rf2$benchwtid
	lin.rfmap <- rf2$linrfmap
	rf.style <- rf2$rf.style
	sizes[names(rf2$sizesrf)] <- rf2$sizesrf
	if(is.matrix(rftab)) {
		vtable[3, unique(rftab[4,]) + 1] <- 0 # not utility only
	}
	if(!length(bench.weights) && length(bwreq)) {
		stop(paste("need 'bench.weights' (because of",
			"risk fraction type constraints) for:",
			paste("'", bwreq, "'", sep="", collapse=", ")))
	}
	if(length(bench.weights)) {
		# process bench.weights
		bwnam <- names(bench.weights)
		if(!is.list(bench.weights)) {
			if(length(bwreq)) {
				stop(paste("'bench.weights' must be a",
					"list containing the weights",
					"for (that is, with names of):",
					paste(bwreq, collapse=", ")))
			} else {
				stop(paste("'bench.weights' must be a",
					"list (but is not required for this",
					"specification)"))
			}
		}
		bwmis <- setdiff(bwreq, bwnam)
		if(length(bwmis)) {
			stop(paste(length(bwmis), "required",
				"benchmark(s) (for variance decomposition)",
				"missing from 'bench.weights':",
				paste(bwmis, collapse=", ")))
		}
		bwvmis <- setdiff(varbfill, bwnam)
		if(length(bwvmis)) {
			stop(paste(length(bwvmis), "required",
				"benchmark(s) (for filling in variance)",
				"missing from 'bench.weights':",
				paste(bwvmis, collapse=", ")))
		}
		bwx <- setdiff(bwnam, allben)
		if(length(bwx)) {
			warning(paste(length(bwx), "extraneous component(s)",
				"in 'bench.weights':", 
				paste(bwx, collapse=", ")))
			bench.weights <- bench.weights[intersect(bwnam, allben)]
		}
		benchweights <- array(0, c(nassets, 
			length(bwreq)), list(assetnam, bwreq))
		for(bi in seq(along=bench.weights)) {
			t.ben <- bench.weights[[bi]]
			bin <- names(bench.weights)[bi]
			if(!is.numeric(t.ben)) {
			  stop(paste("the", bin,
				"component of 'bench.weights'",
				"is not numeric -- its mode is",
				mode(t.ben)))
			}
			if(!length(names(t.ben))) {
			  stop(paste("the", bin,
				"component of 'bench.weights'",
				"does not have names"))
			}
			if(any(is.na(t.ben))) {
			  stop(paste("the", bin,
				"component of 'bench.weights'",
				"has", sum(is.na(t.ben)), "missing value(s)"))
			}
			tbsum <- sum(abs(t.ben))
			if((tbsum > .999 && tbsum < 1.01) ||
				      (tbsum>99.9 && tbsum<101)){
				t.ben <- t.ben / tbsum
			} else {
			  stop(paste("the", bin,
				"component of 'bench.weights'",
				"has sum of absolute values of",
				tbsum, "-- should be 1"))
			}
			bwix <- setdiff(names(t.ben), assetnam)
			if(length(bwix)) {
			  stop(paste("the", bin,
				"component of 'bench.weights'",
				"has", length(bwix), "assets",
				"that are not in the universe"))
			}
			if(match(bin, bwreq, nomatch=0) > 0) {
				benchweights[names(t.ben), bin] <- t.ben
			}
			expected.return <- .tradeopt.alphaben(bin, t.ben, nret, 
				alphanam, expected.return, 
				do.warn["alpha.benchmark"])
			if(nvar && all(vartype == 0)) {
				variance <- .tradeopt.varben(bin, t.ben, nvar, 
					variance, do.warn["variance.benchmark"])
			}
		}
		if(!length(bench.weights) || !sizes["totriskfrac"]) {
			benchweights <- 1
			benchwtid <- -1
		}
	} else {
		# no bench.weights
		if(length(varbfill)) {
			stop(paste(length(varbfill), "benchmark(s) not",
				"in 'variance' and 'bench.weights' is",
				"not given -- the missing benchmarks are:",
				paste(varbfill, collapse=", ")))
		}
		benchweights <- 1
		benchwtid <- -1
	}
	if(norig) {
		if(long.only) {
			bigval <- sum((existfullLen + upper.trade) * prices)
		} else {
			bigval <- sum(pmax(abs(existfullLen + upper.trade),
				abs(existfullLen + lower.trade)) * prices)
			lonval <- sum(pmax(existfullLen + upper.trade, 0) * 
				prices)
			shoval <- -sum(pmin(existfullLen + lower.trade, 0) * 
				prices)
		}
	} else {
		if(long.only) {
			bigval <- sum(upper.trade * prices)
		} else {
			bigval <- sum(pmax(-lower.trade, upper.trade) * prices)
			lonval <- sum(pmax(upper.trade, 0) * prices)
			shoval <- -sum(pmin(lower.trade, 0) * prices)
		}
	}
	if(bigval < gross.value[1]) {
		stop(paste("gross value specified to be at least",
			gross.value[1], "but other constraints seem to",
			"limit gross value to", bigval))
	}
	if(!long.only) {
		if(lonval < long.value[1]) {
			stop(paste("long value specified to be at least",
				long.value[1], "but other constraints seem to",
				"limit long value to", lonval))
		}
		if(shoval < short.value[1]) {
			stop(paste("short value specified to be at least",
				short.value[1], "but other constraints seem to",
				"limit short value to", shoval))
		}
	}
	if(length(variance) && all(vartype == 0)) {
		if(ldv == 2) {
			vzero <- diag(drop(variance)) == 0
		} else {
			vzero <- array(FALSE, c(nassets, dv[3]))
			for(i in 1:dv[3]) {
				vzero[,i] <- diag(variance[,,i]) == 0
			}
			vzero <- apply(vzero, 1, all)
		}
		if(any(vzero)) {
			zas <- assetnam[vzero]
			zas.max <- max((existfullLen[zas] + upper.trade[zas]) *
				prices[zas], -(existfullLen[zas] + 
				lower.trade[zas]) * prices[zas])
			if(any(zas.max > gross.value[1])) {
				stop(paste("possible to have a zero variance",
					"portfolio, more restrictions on",
					"zero variance assets required",
					"-- the zero variance",
					"assets are:", paste(zas, 
					collapse=", ")))
			}
		}
	}

	low.constraint <- c(low.constraint, limit.cost[1], close.number[1])
	up.constraint <- c(up.constraint, limit.cost[2], close.number[2])
	sizes["computetradeval"] <- sizes["turnover.constraint"] ||
		any(lin.trade) || sizes["shortcut"] || 
		scale.cost == "trade"
	if(cost.intercept && do.warn["cost.intercept.nonzero"] && 
			sizes["cost.type"] == 1)  {
		warning(paste("non-zero cost intercepts ('do.warn'",
			"suppression is 'cost.intercept.nonzero')"))
	}
	if(is.na(icontrol["icon22"])) {
		if(nconsmain) {
			icontrol["icon22"] <- 3 
			dcontrol["dcon15"] <- 1
		} else {
			icontrol["icon22"] <- 0
		}
	}
	if(icontrol["iterations.max"] == 0 && do.warn["zero.iterations"]) {
		warning(paste("zero iterations is not the same as",
			"no optimization ('do.warn' suppression is",
			"'zero.iterations'"))
	}
	if(exists("pop.ezlicense.file")) {
		ezlicense <- as.character(pop.ezlicense.file)
		if(!nchar(ezlicense)) 
			stop("no characters in 'pop.ezlicense.file'")
		if(substring(ezlicense, nchar(ezlicense) - 3) != ".txt")
			stop("location of ezlicense must end in '.txt'")
	} else {
		ezlicense <- "/usr/share/BurSt/POP/ezlicensefile.txt"
	}
	if(any(is.na(icontrol))) {
		stop(paste(sum(is.na(icontrol)), 
			"missing value(s) in 'icontrol' component of 'control'"))
	}
	if(any(is.na(dcontrol))) {
		stop(paste(sum(is.na(dcontrol)), 
			"missing value(s) in 'dcontrol' component of 'control'"))
	}
	con.checklen <- 8 + sum(sizes[c("nconsub", "nvarcon", "nalphacon", 
		"nsumwtcon")])
	if(length(low.constraint) != con.checklen || length(up.constraint)
			!= con.checklen) {
		stop("unidentified problem with constraint specification")
	}
	sizecontrol <- c(sizes, icontrol)
	mode(sizecontrol) <- "integer"
	mode(atable) <- "integer"
	mode(vtable) <- "integer"
	dvalcontrol <- c(dvalues, dcontrol)
	mode(prices) <- "double"
	mode(existing) <- "double"
	mode(dvalcontrol) <- "double"
	mode(penalty.constraint) <- "double"
	mode(forced.trade) <- "double"

	value.limits <- rbind(gross.value, net.value, long.value, short.value)
        dimnames(value.limits) <- list(c("gross", "net", "long", "short"),
                c("lower", "upper"))
	prices.small <- prices[unique(c(existnam, predist$distnam,
		unlist(lapply(bench.weights, names))))]
	universe.size <- c(universe.total=nassets, tradable=length(tradnams),
                select.universe=if(length(universe.trade))
                length(universe.trade) else nassets,
                positions.notrade=pos.notrade)
	if(length(allben)) {
                allbenval <- match(allben, assetnam) - 1
                names(allbenval) <- allben
        } else {
		allbenval <- NULL
	}

	linpack <- NULL
	if(nconsmain) {
		lin.style <- rep(lin.style, length= nconsmain)
		names(lin.style) <- linconstnames
		lin.rfmap <- rep(lin.rfmap, length= nconsmain)
		linpack$lintable <- data.frame(style=lin.style, 
			trade=lin.trade, absolute=lin.abs, 
			levels=constrain.levels[1:nconsmain], 
			direction=lin.direction, rfloc=lin.rfloc, 
			riskfrac.col=lin.rfmap + 1)
		linpack$lin.bounds <- bounds.infinite
		linpack$lin.constraints <- lin.constraints
	}

	Clist <- list(assetnam=assetnam, dowarn=do.warn,
		checkinput=checkinput, "existid"=as.integer(exist.id), 
		existing=existing, prices=prices,
		"tradeuniv"=as.integer(trade.univ),
		lowupp=as.double(c(lower.trade, upper.trade)), 
		variance=as.double(variance), 
		vartype=as.integer(vartype), 
		varoffset=as.integer(varoffset),
		nvarfactors=as.integer(nvarfactors), 
		expecret=as.double(expected.return),
		"benchid"=as.integer(bench.id), cost=as.double(cost), 
		costpar=as.double(cost.par),
		threshold=as.double(threshold),
		constrainvec=as.double(constrainvec), 
		constrainlevels=as.integer(constrain.levels), 
		lowconstrain=as.double(low.constraint),
		highconstrain=as.double(up.constraint), 
		penaltyconstraint=penalty.constraint,
		constraintype=as.integer(lin.trade + 
		2*lin.abs), linstyle=as.integer(lin.stylenum),
		lindirection=as.integer(lin.direction),
		linrfmap=as.integer(lin.rfmap),
		"destwt"=as.double(dest.wt),
		sizecontrol=sizecontrol,
		"startid"=as.integer(start.id), 
		startsol=as.double(start.sol),
		forcedid=as.integer(forced.id),
		forcedtrade=forced.trade,
		rfracvec=as.double(rfracvec),
		rfstynum=as.integer(rfstynum),
		rf.style=rf.style,
		rfracactive=as.integer(rfracactive),
		benchweights=as.double(benchweights),
		benchwtid=as.integer(benchwtid),
		rfvarid=as.integer(rfvarid), rftab=as.integer(rftab),
		distcenter=as.double(predist$distcenter),
		distbounds=as.double(predist$distbounds),
		diststynum=as.integer(predist$diststynum), # 1 pre-subtracted
		distusenum=as.integer(predist$distusenum),
		distcoef=as.double(predist$distcoef),
		distscale=as.double(predist$distscale),
		distcoefloc=as.integer(predist$distcoefloc),
		"alphatable"=atable, "vartable"=vtable,
		dvalcontrol=dvalcontrol,
		seed=as.integer(seed), ezlicense=ezlicense,
		auxcontrol=auxcontrol, dist.utility=predist$dist.utility,
		value.limits=value.limits, prices.small=prices.small,
		universe.size=universe.size, benchmarks=allbenval,
		linpack=linpack, distpack=predist$distpack, 
		real.start=real.start, position.force=position.force, 
		max.weight=max.weight, utility=utility, 
		risk.aversion=risk.aversion, utable=utable, 
		bench.constraint=bench.constraint, forced.trade=forced.given,
		positions=positions, tol.positions=tol.positions, vtdmatch=vtd, 
		dumpfile=dumpfile)
	Clist
}

".tradeopt.predist" <-
function ( dist.center, dist.style, dist.bounds, dist.trade, dist.utility, 
	dist.prices, big, nassets, assetnam, do.warn, prices, gross.value)
{
	fun.copyright <- "Copyright 2011 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.predist 001"

	distsizes <- c(distnum=0, distconnum=0)
	if(length(dist.center)) {
		if(!is.list(dist.center)) {
			if(is.numeric(dist.center) && 
					length(names(dist.center))) {
				dist.center <- list(dist.center)
			} else {
				stop(paste("'dist.center' must be either a",
					"list of named numeric vectors, or",
					"one named numeric vector -- given",
					"has mode", mode(dist.center), 
					"and length", length(dist.center)))
			}
		}
		distsizes["distnum"] <- distnum <- length(dist.center)

		if(!is.character(dist.style) || !length(dist.style)) {
			stop(paste("'dist.style' must be a character",
				"vector of length at least 1",
				"-- given has mode", mode(dist.style),
				"and length", length(dist.style)))
		}
		if(length(dist.style) != 1 && length(dist.style) !=
				distnum) {
			warning(paste("length of 'dist.style' being",
				"coerced to", distnum, 
				"-- given length is", 
				length(dist.style)))
		}
		dslen <- length(dist.style)
		if(dslen != distnum) {
			if(dslen != 1) {
				warning(paste("length of 'dist.style' is",
					dslen, "-- expecting 1 or", distnum))
			}
			dist.style <- rep(dist.style, length=distnum)
		}
		dist.stymenu <- c("value", "shares", "weight", "sumsqwi",
			"customvalue", "customshares", "customweight", 
			"customsumsqwi")
		dist.stynum <- pmatch(dist.style, dist.stymenu,
			nomatch=0, duplicates.ok=TRUE)
		if(any(dist.stynum == 0)) {
			stop(paste("unknown or ambiguous value(s)",
				"in 'dist.style' -- valid values are:",
				paste(paste('"', dist.stymenu, '"', sep=""),
				collapse=", ")))
		}
		dist.style <- dist.stymenu[dist.stynum]

		if(!is.logical(dist.trade) || !length(dist.trade)) {
			stop(paste("'dist.trade' must be a logical",
				"vector of length at least 1",
				"-- given has mode", mode(dist.trade),
				"and length", length(dist.trade)))
		}
		if(any(is.na(dist.trade))) {
			stop(paste(sum(is.na(dist.trade)), "missing value(s)",
				"in 'dist.trade'"))
		}
		if(length(dist.trade) != 1 && length(dist.trade) !=
				distnum) {
			warning(paste("length of 'dist.trade' being",
				"coerced to", distnum, 
				"-- given length is", 
				length(dist.trade)))
		}
		if(!is.logical(dist.utility) || !length(dist.utility)) {
			stop(paste("'dist.utility' must be a logical",
				"vector of length at least 1",
				"-- given has mode", mode(dist.utility),
				"and length", length(dist.utility)))
		}
		if(any(is.na(dist.utility))) {
			stop(paste(sum(is.na(dist.utility)), "missing value(s)",
				"in 'dist.utility'"))
		}
		if(length(dist.utility) != 1 && length(dist.utility) !=
				distnum) {
			warning(paste("length of 'dist.utility' being",
				"coerced to", distnum, 
				"-- given length is", 
				length(dist.utility)))
		}
		dtlen <- length(dist.trade)
		if(dtlen != distnum) {
			if(dtlen != 1) {
				warning(paste("length of 'dist.trade' is",
					dtlen, "-- expecting 1 or", distnum))
			}
			dist.trade <- rep(dist.trade, length=distnum)
		}
		dulen <- length(dist.utility)
		if(dulen != distnum) {
			if(dulen != 1) {
				warning(paste("length of 'dist.utility' is",
					dulen, "-- expecting 1 or", distnum))
			}
			dist.utility <- rep(dist.utility, length=distnum)
		}
		dist.usenum <- as.numeric(dist.trade) + 2 * 
			as.numeric(dist.utility)

		distconnum <- sum(!dist.utility)
		distsizes["distconnum"] <- distconnum
		if(!length(dist.bounds)) {
			distsizes["distconnum"] <- distconnum <- 0

			distbou.nc <- 0
		} else {
			if(!is.numeric(dist.bounds)) {
				stop(paste("'dist.bounds' must be numeric",
					"-- given has mode", mode(dist.bounds),
					"and length", length(dist.bounds)))
			}
			dist.bounds <- as.matrix(dist.bounds)
			distbou.nc <- ncol(dist.bounds)
		}
		if(distbou.nc == 0) {
			# everything should be checked by now
			distbounds <- 0
		} else if(distbou.nc > 2) {
		    	if(distconnum != distnum) {
				stop(paste("'dist.bounds' should be either a",
					"two-column matrix with", distnum, "or",
					distconnum, "rows, or a vector or",
					"one-column matrix of length", distnum,
					"or", distconnum))
		    	} else {
				stop(paste("'dist.bounds' should be either a",
					"two-column matrix with", distnum, 
					"rows, or a vector or",
					"one-column matrix of length", distnum))
		    	}
		} else if(distbou.nc == 2) {
			if(nrow(dist.bounds) == distnum) {
				distbounds <- dist.bounds
			} else if(nrow(dist.bounds) == distconnum) {
				distbounds <- cbind(rep(-big, distnum),
					big)
				distbounds[!dist.utility,] <-
					dist.bounds
			} else {
				if(distconnum == distnum) {
					stop(paste("wrong size for",
					  "'dist.bounds' -- given has",
					  "two columns and",
					  nrow(dist.bounds), "row(s)",
					  "-- should have", distnum,
					  "row(s)"))
				} else {
					stop(paste("wrong size for",
					  "'dist.bounds' -- given has",
					  "two columns and",
					  nrow(dist.bounds), "row(s)",
					  "-- should have", distnum,
					  "or", distconnum, "rows"))
				}
			}
		} else {
			# one column
			distbounds <- cbind(rep(-big, distnum), big)
			if(length(dist.bounds) == distnum) {
				distbounds[,2] <- dist.bounds
			} else if(length(dist.bounds) == distconnum) {
				distbounds[!dist.utility,2] <- 
					dist.bounds
			} else {
				if(distconnum == distnum) {
					stop(paste("wrong size for",
					  "'dist.bounds' -- given has length",
					  nrow(dist.bounds), 
					  "-- should have length", 
					  distnum, "(or be a two-column matrix",
					  "with", distnum, "row(s))"))
				} else {
					stop(paste("wrong size for",
					  "'dist.bounds' -- given has",
					  "length",
					  nrow(dist.bounds), 
					  "-- should have length", 
					  distnum, "or", distconnum,
					  "(or be a two-column matrix with",
					  distnum, "or", distconnum, "rows)"))
				}
			}
		}
		if(distconnum && is.matrix(distbounds) && any(distbounds[
				!dist.utility,1] > distbounds[
				!dist.utility,2])) {
			warning(paste("at least one lower bound in",
				"'dist.bounds' larger than the",
				"corresponding upper bound"))
		}
		distbounds[distbounds < -big] <- -big
		distbounds[distbounds > big] <- big
		distcoefloc <- rep(-1, distnum)
		distcuststy <- substring(dist.style, 1, 6) == "custom"
		if(any(distcuststy)) {
			dist.custnum <- sum(distcuststy)
			if(!length(dist.prices)) {
				stop(paste(dist.custnum,
					"value(s) in 'dist.style'",
					"need(s) 'dist.prices'",
					"but 'dist.prices' has zero length"))
			}
			if(!is.list(dist.prices)) {
				if(is.numeric(dist.prices) && 
						length(names(dist.prices))) {
					dist.prices <- list(dist.prices)
				} else {
					stop(paste("'dist.prices' must be either",
						"a list of named numeric",
						"vectors, or one named numeric",
						"vector -- given has mode", 
						mode(dist.prices), 
						"and length", 
						length(dist.prices)))
				}
			}
			if(!(length(dist.prices) %in% c(1, dist.custnum, 
					distnum))) {
				stop(paste("length of 'dist.prices' is",
					length(dist.prices), 
					"-- possible lengths are:",
					paste(unique(c(1, dist.custnum, 
					distnum)), collapse=", ")))
			}
			if(length(dist.prices) == 1) {
				distcoef <- rep(0, nassets)
				names(distcoef) <- assetnam
				this.dist <- dist.prices[[1]]
				if(!is.numeric(this.dist) || 
						!length(names(this.dist))) {
					stop(paste("(the only) 'dist.prices'",
						"is not a named numeric vector",
						"-- it has mode", 
						mode(this.dist), "and length",
						length(this.dist)))
				}
				if(all(this.dist == 0)) {
					stop(paste("all values in 'dist.prices'",
						"are zero"))
				}
				disout <- setdiff(names(this.dist), assetnam)
				if(length(disout) > 6) {
					stop(paste("'dist.prices'",
						"contains", length(disout), 
						"assets not in the universe",
						"-- the first few are:",
						paste(disout[1:6], 
						collapse=", ")))
				} else if(length(disout)) {
					stop(paste("'dist.prices'",
						"contains", length(disout), 
						"asset(s) not in the universe:",
						paste(disout, collapse=", ")))
				}
				dismis <- setdiff(assetnam, names(this.dist))
				if(do.warn["dist.prices"] && length(dismis)) {
					warning(paste("'dist.prices'",
						"is missing", length(dismis),
					 	"asset(s) from the universe",
					 	"-- setting them to zero",
						"('do.warn' suppression is",
						"'dist.prices')"))
				}
				distcoef[names(this.dist)] <- this.dist
				distcoefloc[distcuststy] <- 0
				distcoef <- as.matrix(distcoef)
			} else if(length(dist.prices) == distnum) {
			  distcoef <- array(0, c(nassets, dist.custnum), 
				list(assetnam, NULL))
			  distcount <- 0
			  for(i in 1:distnum) {
				if(!distcuststy[i]) next
				this.dist <- dist.prices[[i]]
				if(!is.numeric(this.dist) || 
						!length(names(this.dist))) {
					stop(paste("distance price", i, 
						"is not a named numeric vector",
						"-- it has mode", 
						mode(this.dist), "and length",
						length(this.dist)))
				}
				if(all(this.dist == 0)) {
					stop(paste("all values in component",
						i, "of 'dist.prices' are zero"))
				}
				disout <- setdiff(names(this.dist), assetnam)
				if(length(disout) > 6) {
					stop(paste("distance price", i,
						"contains", length(disout), 
						"assets not in the universe",
						"-- the first few are:",
						paste(disout[1:6], 
						collapse=", ")))
				} else if(length(disout)) {
					stop(paste("distance price", i,
						"contains", length(disout), 
						"asset(s) not in the universe:",
						paste(disout, collapse=", ")))
				}
				dismis <- setdiff(assetnam, names(this.dist))
				if(do.warn["dist.prices"] && length(dismis)) {
					warning(paste("'dist.prices'", i,
						"is missing", length(dismis),
					 	"asset(s) from the universe",
					 	"-- setting them to zero",
						"('do.warn' suppression is",
						"'dist.prices')"))
				}
				distcoef[names(this.dist), distcount + 1] <- 
					this.dist
				distcoefloc[i] <- distcount
				distcount <- distcount + 1
			  }
			} else {
				# length(dist.prices) == dist.custnum
			  distcoef <- array(0, c(nassets, dist.custnum), 
				list(assetnam, NULL))
			  for(i in 1:dist.custnum) {
				this.dist <- dist.prices[[i]]
				if(!is.numeric(this.dist) || 
						!length(names(this.dist))) {
					stop(paste("distance coef", i, 
						"is not a named numeric vector",
						"-- it has mode", 
						mode(this.dist), "and length",
						length(this.dist)))
				}
				disout <- setdiff(names(this.dist), assetnam)
				if(length(disout) > 6) {
					stop(paste("distance price", i,
						"contains", length(disout), 
						"assets not in the universe",
						"-- the first few are:",
						paste(disout[1:6], 
						collapse=", ")))
				} else if(length(disout)) {
					stop(paste("distance price", i,
						"contains", length(disout), 
						"asset(s) not in the universe:",
						paste(disout, collapse=", ")))
				}
				dismis <- setdiff(assetnam, names(this.dist))
				if(do.warn["dist.prices"] && length(dismis)) {
					warning(paste("'dist.prices'", i,
						"is missing", length(dismis),
					 	"asset(s) from the universe",
					 	"-- setting them to zero",
						"('do.warn' suppression is",
						"'dist.prices')"))
				}
				distcoef[names(this.dist), i] <- 
					this.dist
			  }
			  distcoefloc[distcuststy] <- seq(0, length=dist.custnum)
			}
			if(any(distcoefloc >= dist.custnum)) {
				stop("problem with specifying custom distance")
			}
		} else {
			if(length(dist.prices)) {
				warning(paste(
					"'dist.prices' given but not used"))
			}
			distcoef <- 0
		}

		distcenter <- array(0, c(nassets, distnum),
			list(assetnam, NULL))
		for(i in 1:distnum) {
			this.dist <- dist.center[[i]]
			if(!is.numeric(this.dist) || 
					!length(names(this.dist))) {
				stop(paste("distance center", i, 
					"is not a named numeric vector",
					"-- it has mode", 
					mode(this.dist), "and length",
					length(this.dist)))
			}
			disout <- setdiff(names(this.dist), assetnam)
			if(length(disout) > 6) {
				stop(paste("distance center", i,
					"contains", length(disout), 
					"assets not in the universe",
					"-- the first few are:",
					paste(disout[1:6], 
					collapse=", ")))
			} else if(length(disout)) {
				stop(paste("distance center", i,
					"contains", length(disout), 
					"asset(s) not in the universe:",
					paste(disout, collapse=", ")))
			}
			distcenter[names(this.dist), i] <- this.dist
			if(do.warn["dist.style"] && !dist.trade[i]) {
			 switch(dist.style[i],
			  value={
				dv <- sum(abs(this.dist))
				if(dv < gross.value[1] * .999 || dv >
						gross.value[2] * 1.001){
					dss <- sum(abs(this.dist * prices[
						names(this.dist)]))
					warning(paste("the value for",
					  "distance", i, "is", dv, 
					  "which is outside the gross value",
					  "range -- perhaps you meant a",
					  "'dist.style' of 'shares' rather",
					  "than 'value' in which case the",
					  "value would be", dss,
					  "('do.warn' suppression is",
					  "'dist.style')"))
				 }
			  },
			  shares={
				dss <- sum(abs(this.dist * prices[
					names(this.dist)]))
				if(dss < gross.value[1] * .999 || dss >
						gross.value[2] * 1.001){
					dv <- sum(abs(this.dist))
					warning(paste("the value for",
					  "distance", i, "is", dss, 
					  "which is outside the gross value",
					  "range -- perhaps you meant a",
					  "'dist.style' of 'value' rather",
					  "than 'shares' in which case the",
					  "value would be", dv,
					  "('do.warn' suppression is",
					  "'dist.style')"))
				}
			   }
			 )
			}
			if(do.warn["dist.zero"] && distcoefloc[i] >= 0) {
			 	dcn <- names(this.dist)[this.dist != 0]
				dct <- distcoef[, distcoefloc[i] + 1]
				dcnout <- intersect(dcn, names(dct)[dct == 0])
				if(length(dcnout)) {
					warning(paste(length(dcnout),
					   "value(s) in component", i,
					   "of 'dist.center' are non-zero",
					   "but with 'dist.prices' value(s)",
					   "zero ('do.warn' suppression is",
					   "'dist.zero')"))
				}
			}
		}
		distcsum <- colSums(abs(distcenter))
		if(any(is.na(distcsum))) {
			stop(paste("missing values in", sum(is.na(distcsum)), 
				"components of 'dist.center'"))
		}

		distwt <- dist.style == "weight" | dist.style == 
			"customweight" | dist.style == "sumsqwi" | 
			dist.style == "customsumsqwi"
		distscale <- rep(1/gross.value[2], distnum)
		distscale[distwt] <- 1
		if(any(distwt)) {
			distwout <- rep(FALSE, distnum)
			distwout[distwt][abs(distcsum[distwt] - 1) > 5e-3] <- 
				TRUE
			if(any(distwout)) {
				warning(paste(sum(distwout), "component(s) of",
					"'dist.center' are for weights but",
					"do not sum (in absolute value) to 1,",
					"being adjusted --",
					"these are component(s):",
					paste(which(distwout), collapse=", "),
					"with sum abs wt:",
					paste(distcsum[distwout], 
					collapse=", ")))
			}
			for(i in 1:distnum) {
				if(!distwt[i] || distcsum[i] == 1) next
				distcenter[, i] <- distcenter[, i] / distcsum[i]
			}
		}
	} else {
		# length zero dist.center
		if(!is.null(dist.center)) {
			stop(paste("bad value for 'dist.center'",
				"-- must be NULL if of zero length",
				"-- given has mode:", mode(dist.center)))
		}
		if(length(dist.bounds)) {
			warning(paste("'dist.bounds' given but not",
				"'dist.center' -- no distance constraints",
				"performed"))
		}
		distsizes["distnum"] <- distnum <- 0
		distsizes["distconnum"] <- 0
		distcenter <- distbounds <- dist.stynum <- dist.usenum <- 0
		distcoef <- distcoefloc <- distscale <- 0
	}

	if(distnum) {
                distnam <- unique(c(unlist(lapply(dist.center, names)),
                        unlist(lapply(dist.prices, names))))
        } else {
                distnam <- NULL
        }

	distpack <- NULL
	if(distnum) {
		if(length(unique(dist.style)) == 1) {
			distpack$dist.style <- dist.style[1]
		} else {
			distpack$dist.style <- dist.style
		}
		if(length(unique(dist.trade)) == 1) {
			distpack$dist.trade <- dist.trade[1]
		} else {
			distpack$dist.trade <- dist.trade
		}
		if(length(unique(dist.utility)) == 1) {
			distpack$dist.utility <- dist.utility[1]
		} else {
			distpack$dist.utility <- dist.utility
		}
		distpack$dist.center <- dist.center
		if(is.matrix(distbounds)) {
			outdistbounds <- distbounds
			dimnames(outdistbounds) <- list(paste("dist", 
				1:nrow(outdistbounds)), c("lower", "upper"))
			outdistbounds[outdistbounds < -big * .99] <- -Inf
			outdistbounds[outdistbounds > big * 1.01] <- Inf
			distpack$dist.bounds <- outdistbounds
		} else {
			distpack$dist.bounds <- distbounds
		}
		distpack$dist.prices <- dist.prices
	}

	list( distcenter=as.double(distcenter),
		distbounds=as.double(distbounds),
		diststynum=as.integer(dist.stynum - 1),
		distusenum=as.integer(dist.usenum),
		distcoef=as.double(distcoef),
		distscale=as.double(distscale),
		distcoefloc=as.integer(distcoefloc),
		dist.utility=dist.utility,
		distpack=distpack, distnam=distnam, distsizes=distsizes)
}

".tradeopt.presumwt" <-
function(sum.weight) {
	fun.copyright <- "Copyright 2011-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.presumwt 002"

	sumwtsizes <- c(nsumwtcon=0, minsumwt=0)
	implied.min.port.size <- 0
	if(length(sum.weight)) {
		swd <- dim(sum.weight)
		lswd <- length(swd)
		if(lswd == 2) sum.weight <- as.matrix(sum.weight)

		if(!is.numeric(sum.weight)) {
			stop(paste("'sum.weight' must be numeric, not",
				mode(sum.weight)))
		}
		if(any(is.na(sum.weight))) 
			stop("at least one missing value in 'sum.weight'")
		if((lswd != 0 && lswd != 2) || (lswd == 2 && swd[2] != 2)) {
			stop(paste("'sum.weight' must be either a numeric",
				"vector or a numeric matrix with 2 columns"))
		}
		if(lswd) {
			sumwtid.nam <-dimnames(sum.weight)[[1]]
			if(any(sum.weight[,1] > 0)) {
				sumwtsizes["minsumwt"] <- 1
			} else {
				sumwtsizes["minsumwt"] <- 0
			}
		} else {
			sumwtid.nam <- names(sum.weight)
			sum.weight <- cbind(0, as.matrix(sum.weight))
			sumwtsizes["minsumwt"] <- 0
		}
		sumwtid.raw <- as.numeric(sumwtid.nam)
		sumwtid <- round(sumwtid.raw)
		if(!length(sumwtid) || any(is.na(sumwtid)) || 
				any(abs(sumwtid - sumwtid.raw) > 1e-6) ||
				any(sumwtid < 1)){
			stop(paste("'sum.weight' must have names that",
				"coerce to positive integers"))
		}
		if(any(duplicated(sumwtid))) {
			stop(paste(sum(duplicated(sumwtid)), "name(s) of",
				"'sum.weight' are (effectively) duplicated",
				"-- the names to be used are:",
				paste(sumwtid, collapse=", ")))
		}
		if(any(sum.weight[,2] > 1)) {
			stop(paste(sum(sum.weight[,2] > 1), "value(s) in",
				"'sum.weight' are greater than one",
				"-- the names for these are:",
				paste(sumwtid.nam[sum.weight[,2] > 1],
				collapse=", ")))
		}
		if(any(sum.weight[,2] <= 0)) {
			stop(paste(sum(sum.weight[,2] <= 0), "value(s) in max",
				"'sum.weight' are less than or equal to zero",
				"-- the names for these are:",
				paste(sumwtid.nam[sum.weight[,2] <= 0],
				collapse=", ")))
		}
		if(any(sum.weight[,2] < sum.weight[,1])) {
			stop(paste(sum(sum.weight[,2] < sum.weight[,1]), 
				"maximum value(s) in",
				"'sum.weight' are less than the corresponding",
				"minimum values -- the names for these are:",
				paste(sumwtid.nam[sum.weight[,2] < 
				sum.weight[,1]], collapse=", ")))
		}
		if(any(sum.weight[,1] > 0)) {
			imp.maxwt <- sum.weight / sumwtid
			if(max(imp.maxwt[,1]) > min(imp.maxwt[,2])) {
				stop(paste("inconsistent constraints imposed",
					"with 'sum.weight' -- at least one",
					"minimum constraint is too large",
					"given the maximum constraints"))
			}
		}
		sum.weight <- sum.weight[order(sumwtid), , drop=FALSE]
		sumwtid <- sort(sumwtid)
		sumwtsizes["nsumwtcon"] <- length(sumwtid)
		implied.min.port.size <- max(ceiling(sumwtid / sum.weight[,2]))
	} else {
		# no sum.weight length
		sumwtid <- NULL
	}
	list(sum.weight=sum.weight, sumwtid=sumwtid, 
		implied.min.port.size=implied.min.port.size, 
		sumwtsizes=sumwtsizes)
}

".tradeopt.riskfrac2" <-
function (rfracactive, rfloc, rfstynum, vartype, vtable, nassets, assetnam,
	lin.stylenum, lin.rfloc, rf.stylemenu, dumpfile, Mc)
{
	fun.copyright <- "Copyright 2011-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- ".tradeopt.riskfrac2 002"

	sizesrfnam <- c("riskfrac", "nvarrf", "nbenrf", "nvarbenrf",
		"totriskfrac", "invvol")
	sizesrf <- rep(0, length(sizesrfnam))
	names(sizesrf) <- sizesrfnam
	sizesrf["riskfrac"] <- length(rfloc)
	bwreq <- NULL
	benchwtid <- -1
	lin.rfmap <- lin.rfloc
	NONrisknum <- 3

	if(sizesrf["riskfrac"]) {
		if(!all(vartype == 0)) {
		   stop(paste("risk fraction constraints not implemented for",
			"variances other than full -- if you need this, then",
			"email support@portfolioprobe.com with a request to",
			"implement it"))
		}
		if(length(rfloc) != length(rfstynum)) {
                	if(nchar(dumpfile)) {
                        	writedump.BurSt(Mc, dumpfile)
                	}
                	stop(paste("trouble creating risk.fraction constraints",
                        	"please send a report to",
				"support@portfolioprobe.com"))
        	}
		# next 2 lines here for benchwtid def
		rfben <- unique(vtable[2, rfloc+1])
		benchwtid <- rfben[rfben >= 0]

		rftab <- rbind(vtable[1, rfloc+1], # variances used
			match(vtable[2, rfloc+1], benchwtid, nomatch=0) - 1,
				# locations within rf benchmarks
			vtable[2, rfloc+1] * nassets, # benchmarks in full var
			rfloc, # columns of vtable
			rfstynum, # rf style
			-1) # compute code
	} else {
		# no risk.fraction constraints
		rftab <- rfvarid <- 0
	}

	if(all(lin.stylenum <= NONrisknum)) lin.rfloc <- -1
	if(any(lin.rfloc >= 0)) {
		if(!all(vartype == 0)) {
		   stop(paste("risk fraction constraints not implemented for",
			"variances other than full -- if you need this, then",
			"email support@portfolioprobe.com with a request to",
			"implement it"))
		}
		if(length(lin.rfloc) != length(lin.stylenum)) {
                	if(nchar(dumpfile)) {
                        	writedump.BurSt(Mc, dumpfile)
                	}
                	stop(paste("trouble creating linear risk fraction",
				"constraints -- please send a report to",
				"support@portfolioprobe.com"))
        	}
		# extra insurance, should be true already
		lin.rfloc[lin.stylenum <= NONrisknum] <- -1

		lsty <- lin.stylenum[lin.rfloc >= 0] - (NONrisknum + 1)
		ldofull <- paste(lsty, lin.rfloc[lin.rfloc >= 0], sep="@")
		ldo <- unique(ldofull)
		ldl <- match(ldo, ldofull)
		ls.rfloc <- lin.rfloc[lin.rfloc >= 0][ldl]
		# next 2 lines here for benchwtid def
		rfben <- unique(vtable[2, c(ls.rfloc, rfloc)+1])
		benchwtid <- rfben[rfben >= 0]

		lintab <- rbind(vtable[1, ls.rfloc+1], # variances used
			match(vtable[2, ls.rfloc+1], benchwtid, nomatch=0) - 1,
				# locations within rf benchmarks
			vtable[2, ls.rfloc+1] * nassets, # bnmarks in full var
			ls.rfloc, # columns of vtable
			lsty[ldl], # rf style
			-1) # compute code
		lintab[5, lintab[5,] == 4] <- 5
		if(length(rftab) > 1) {
			# both linear and risk.fraction
			smap <- match(ldofull, ldo) 
			nrf <- ncol(rftab)
			eqm <- outer(apply(rftab, 2, paste, collapse="="),
				apply(lintab, 2, paste, collapse="="), "==")
			if(!any(eqm)) {
				rftab <- cbind(rftab, lintab)
				smapm <- smap + nrf - 1
			} else {
				flateq <- apply(eqm, 2, any)
				rftab <- cbind(rftab, lintab[, !flateq])
				stran <- nrf + cumsum(!flateq)
				smapm <- stran[smap]
				for(i in which(flateq)) {
					smapm[smap == i] <- which(eqm[,i])
				}
				smapm <- smapm - 1
			}
		} else {
			# just linear, no risk.fraction
			rftab <- lintab
			smapm <- match(ldofull, ldo) - 1
		}
		lin.rfmap[lin.rfloc >= 0] <- smapm
		if(max(smapm) >= ncol(rftab) || min(smapm) < 0) {
			# another impossible thing before breakfast
			stop(paste("trouble organizing 'risk.fraction' and",
				"linear variance constraints -- please",
				"email a report to support@portfolioprobe.com"))
		}
	}

	if(length(rftab) > 1) {
 		# needed for risk.fraction computation
		sizesrf <- c(sizesrf, shortcut=1)

		sizesrf["totriskfrac"] <- ncol(rftab)

		# efficiency but leave out corport
		out <- rftab[5,] %in% 4:5
		rftabsmall <- rftab[, !out, drop=FALSE]
		ld <- duplicated(rfloc <- rftabsmall[4,])
		if(any(ld)) {
			ldu <- unique(rfloc[ld])
			for(i in ldu) {
				allm <- which(rfloc == i)
				fm <- allm[1]
				rftabsmall[6, allm[-1] ] <- fm - 1
				rftabsmall[6, fm] <- -2
			}
			rftab[, !out] <- rftabsmall
		}
		rftab[6, rftab[6,] == -2 & (rftab[5,] %in% c(1,5))] <- -1

		if(any(rftab[5,] %in% 2:3 & rftab[2,] < 0)) {
			warning(paste(sum(rftab[5,] %in% 2:3 & rftab[2,] < 0), 
				"instance(s) of a marginal benchmark",
				"in 'rf.style' or 'lin.style' but no",
				"benchmark in the instance"))
		}
		rfvarid <- unique(rftab[1,])
		sizesrf["nvarrf"] <- length(rfvarid)

		if(any(is.na(rftab))) {
			# in theory never happens, but best to check
			if(nchar(dumpfile)) {
                        	writedump.BurSt(Mc, dumpfile)
			}
			stop(paste("corruption computing risk.fraction table",
				"please email a report to",
				"support@portfolioprobe.com"))

		}
		rfben <- unique(vtable[2, rfloc+1])
		rfben <- length(benchwtid <- rfben[rfben >= 0])
		sizesrf["nbenrf"] <- rfben
		if(rfben) {
			rfvtabben <- rftab[1:2, rftab[2,] >= 0, drop=FALSE]
			sizesrf["nvarbenrf"] <- length(unique(apply(rfvtabben, 2, 
				paste, collapse=" -- ")))
			bwreq <- assetnam[benchwtid + 1]
		} else {
			sizesrf["nvarbenrf"] <- 0
		}
		rf.style <- rf.stylemenu[rftab[5,]+1]
		if(any(rftab[5,] %in% 4:5)) sizesrf["invvol"] <- 1
	} else {
		rf.style <- NULL
	}
	list(rftab=rftab, rfvarid=rfvarid, sizesrf=sizesrf, bwreq=bwreq,
		benchwtid=benchwtid, linrfmap=lin.rfmap, rf.style=rf.style)
}

"threeDarr" <-
function (..., rep=1, union=TRUE, slicenames=NULL) 
{
	fun.copyright <- "Placed in the public domain 2011-2012 by Burns Statistics Ltd."
        fun.version <- "threeDarr 002"

	dots <- list(...)
	ndot <- length(dots)
	if(ndot == 1 && rep <= 1) {
		stop(paste("expecting at least 2 inputs when 'rep'",
			"is not greater than 1"))
	} else if(ndot == 0) {
		stop("no inputs given")
	}
	ddims <- lapply(dots, dim)
	if(any(unlist(lapply(ddims, length)) != 2)) {
		stop(paste(sum(unlist(lapply(ddims, length)) != 2),
			"input(s) do not have length 2 dim"))
	}
	ddimnam <- lapply(dots, dimnames)
	if(ndot == 1) {
		rnam <- ddimnam[[1]][[1]]
		cnam <- ddimnam[[1]][[2]]
		rnc <- nchar(rnam)
		cnc <- nchar(cnam)
		if(any(rnc == 0)) {
			rnsub <- paste("R", 1:length(rnam), sep="")
			rnam[rnc == 0] <- rnsub[rnc == 0]
			dimnames(dots[[1]])[[1]] <- rnam
		}
		if(any(cnc == 0)) {
			cnsub <- paste("C", 1:length(cnam), sep="")
			cnam[cnc == 0] <- cnsub[cnc == 0]
			dimnames(dots[[1]])[[2]] <- cnam
		}
	} else if(union) {
		rnam <- unique(unlist(lapply(ddimnam, function(x) x[[1]])))
		cnam <- unique(unlist(lapply(ddimnam, function(x) x[[2]])))
	} else {
		rnam <- ddimnam[[1]][[1]]
		cnam <- ddimnam[[1]][[2]]
		if(ndot > 1) {
			for(i in 2:ndot) {
				rnam <- intersect(rnam, ddimnam[[i]][[1]])
				cnam <- intersect(cnam, ddimnam[[i]][[2]])
			}
		}
	}
	if(any(nchar(rnam) == 0) || any(duplicated(rnam))) {
		stop("when row names exist, all rows must have unique names")
	}
	if(any(nchar(cnam) == 0) || any(duplicated(cnam))) {
		stop("when column names exist, all columns must have unique names")
	}
	if(!length(rnam)) {
		nr <- unlist(lapply(ddims, function(x) x[1]))
		if(diff(range(nr))) {
			stop(paste("no (suitable) row names and variable",
				"number of rows in inputs"))
		}
		nr <- nr[1]
	} else {
		nr <- length(rnam)
	}
	if(!length(cnam)) {
		nc <- unlist(lapply(ddims, function(x) x[2]))
		if(diff(range(nc))) {
			stop(paste("no (suitable) column names and variable",
				"number of columns in inputs"))
		}
		nc <- nc[1]
	} else {
		nc <- length(cnam)
	}
	if(length(slicenames)) {
		if(length(slicenames) != ndot * rep) {
			stop(paste("length of 'slicenames' is", 
				length(slicenames), "-- should be", 
				ndot * rep))
		}
		snam <- slicenames
	} else {
		snam <- names(dots)
		if(length(snam) && rep > 1) {
			snam <- paste(snam, rep(1:rep, each=ndot), sep=".")
		}
	}
	ans <- array(NA, c(nr, nc, ndot * rep), list(rnam, cnam, snam))
	ncode <- paste(if(length(rnam)) "R" else "N", 
		if(length(cnam)) "C" else "N", sep="")
	switch(ncode,
	  RC={
		for(i in 1:ndot) {
			thismat <- as.matrix(dots[[i]])
			thisr <- intersect(dimnames(thismat)[[1]], rnam)
			thisc <- intersect(dimnames(thismat)[[2]], cnam)
			ans[thisr, thisc, i] <- thismat[thisr, thisc]
		}
	  },
	  RN={
		for(i in 1:ndot) {
			thismat <- as.matrix(dots[[i]])
			thisr <- intersect(dimnames(thismat)[[1]], rnam)
			ans[thisr,, i] <- thismat[thisr,]
		}
	  },
	  NC={
		for(i in 1:ndot) {
			thismat <- as.matrix(dots[[i]])
			thisc <- intersect(dimnames(thismat)[[2]], cnam)
			ans[,thisc, i] <- thismat[,thisc]
		}
	  },
	  NN={
		for(i in 1:ndot) {
			ans[,,i] <- as.matrix(dots[[i]])
		}
	  }
	)
	if(rep > 1) {
		orig <- ans[,,1:ndot]
		for(i in 2:rep) {
			ans[,, 1:ndot + (i-1)*ndot] <- orig
		}
	}
	ans
}

"writedump.BurSt" <-
function (Mc, dumpfile) 
{
	fun.copyright <- "Copyright 2011-2012 Burns Statistics Ltd.  All rights reserved."
	fun.version <- "writedump.BurSt 002"

	if(!length(dumpfile) || !nchar(dumpfile)) {
		warning("'dumpfile' has no characters -- no dump created")
		return()
	}
	vars <- character(length(Mc))
	for(i in 2:length(Mc)) {
		tv <- Mc[[i]]
		if(is.name(tv)) vars[i] <- as.character(tv)
	}
	vars[1] <- "Mc"
	vars <- vars[nchar(vars) > 0]
	save(list=vars, file=dumpfile)
	cat("\nWrote dumpfile to:", dumpfile, "\n\n")
}