.packageName <- "PortfolioProbe"
#line 1 "E:/incoming/PortfolioProbe/R/Cfrag.list.q"
"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)
	}
}

#line 1 "E:/incoming/PortfolioProbe/R/Dot_standard.seed.BurSt.q"
".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)
#line 1 "E:/incoming/PortfolioProbe/R/build.constraints.q"
"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)
}

#line 1 "E:/incoming/PortfolioProbe/R/constraint.bnames.q"
"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
}

#line 1 "E:/incoming/PortfolioProbe/R/constraints.realized.q"
"constraints.realized" <-
function (portfol, lin.constraints, prices=portfol$prices,
	lin.bounds=portfol$lin.realized[, c("lower", "upper"),
	drop=FALSE], lin.trade=portfol$lin.trade,
	lin.abs=portfol$lin.abs, lin.style=portfol$lin.style,
	lin.direction=portfol$lin.direction, exclude.inf=FALSE)
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "constraints.realized 004"

	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(FALSE, ncol(lin.constraints))
	} 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 {
		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")
	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
	}

	use.nam <- unique(c(names(trade), names(position)))
	ipu.nam <- intersect(use.nam, names(prices))
	imu.nam <- intersect(use.nam, dimnames(lin.constraints)[[1]])
	nassets <- length(use.nam)

	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]
	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
	} else {
		this.bounds <- build.constraints(lin.constraints)$bounds
		bint <- intersect(dimnames(lin.bounds)[[1]], 
			dimnames(this.bounds)[[1]])
		if(length(bint)) {
			this.bounds[bint, ] <- lin.bounds[bint, ]
		}
		lin.bounds <- this.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

	styledir <- paste(lin.style, 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)
				}
			  }
			)
			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.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
}

#line 1 "E:/incoming/PortfolioProbe/R/deport.portfolBurSt.q"
"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
}

#line 1 "E:/incoming/PortfolioProbe/R/deport.q"
"deport" <-
function(x, ...) UseMethod("deport")
#line 1 "E:/incoming/PortfolioProbe/R/deport.randportBurSt.q"
"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
}

#line 1 "E:/incoming/PortfolioProbe/R/head.randportBurSt.q"
"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)
	attributes(ans) <- xat
	ans
}

#line 1 "E:/incoming/PortfolioProbe/R/pprobe.checkinput.q"
"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))
}

#line 1 "E:/incoming/PortfolioProbe/R/pprobe.verify.q"
"pprobe.verify" <-
function () 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "pprobe.verify 017"

	objnams <- c(".standard.seed.BurSt", "build.constraints", 
		"Cfrag.list", "constraint.bnames", "constraints.realized", 
		"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", "update.randportBurSt", 
		"valuation", "valuation.default", "valuation.portfolBurSt", 
		"valuation.randportBurSt")
	okay <- TRUE

	cat("Portfolio Probe version 1.00 (2009 December 30)\n")
	cat("Copyright 2003-2009 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)
}

#line 1 "E:/incoming/PortfolioProbe/R/print.portfolBurSt.q"
"print.portfolBurSt" <-
function (x, ...) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "print.portfolBurSt 006"

	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$lin.realized <- NULL
	y$lin.style <- NULL
	y$lin.direction <- NULL
	y$optim.mumbo.jumbo <- NULL
	y$checkinput <- NULL

	# following are so obsolete objects print better
	y$dcontrol <- NULL
	y$icontrol <- NULL
	y$alpha.table <- NULL
	y$var.table <- NULL
	y$util.table <- NULL
	# back to regular service

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

#line 1 "E:/incoming/PortfolioProbe/R/print.randportBurSt.q"
"print.randportBurSt" <-
function (x, ...) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "print.randportBurSt 004"

	seed <- attr(x, "seed")
	y <- x
	attr(y, "seed") <- NULL
	attr(y, "version") <- NULL
	attr(y, "checkinput") <- NULL
	attr(y, "funevals") <- NULL
	print.default(y, ...)
	cat("seed attribute begins:", seed[1:4], "\n")
	invisible(x)
}

#line 1 "E:/incoming/PortfolioProbe/R/random.portfolio.control.q"
"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=FALSE, 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, ...)
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "random.portfolio.control 010"

	big <- 1e100
	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=1e9, 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=12, icon57=16,
		icon58=90, icon59=11, icon60=2, icon61=0, icon62=9, icon63=1,
		icon64=2, icon65=20000, icon66=0, icon67=10, icon68=1,
		icon69=20, icon70=18, icon71=45, icon72=5, icon73=15,
		icon74=3, icon75=3, icon76=3, icon77=6300, icon78=800,
		icon79=1300, icon80=900, icon81=6, icon82=22, icon83=17,
		icon84=7, icon85=0, icon86=7, icon87=18, icon88=450,
		icon89=28, icon90=50, icon91=40, icon92=4500,
		icon93=1200, icon94=500, icon95=750, icon96=5000,
		icon97=1400, icon98=1000, icon99=650, icon100=17000,
		icon101=1700, icon102=800, icon103=450, icon104=8,
		icon105=600, icon106=6500, icon107=3000, icon108=400,
		icon109=1500, icon110=2, icon111=30, icon112=50, icon113=100,
		icon114=3, icon115=3, icon116=10, icon117=5, icon118=20,
		icon119=30, icon120=15, icon121=1, icon122=0, icon123=5,
		icon124=4, icon125=3, icon126=500, icon127=8, icon128=20,
		icon129=4, icon130=1, icon131=26, icon132=1, icon133=65,
		icon134=35, icon135=21, icon136=14, icon137=150, icon138=1000,
		icon139=10, icon140=100, icon141=70, icon142=800, icon143=0,
		icon144=1000, icon145=600, icon146=20, icon147=34, icon148=10,
		icon149=2, icon150=14, icon151=1000, 
		icon152=7000, icon153=1500,
		icon154=350, icon155=2, icon156=2, icon157=1, icon158=14,
		icon159=450, icon160=200, icon161=2000, icon162=3000, 
		icon163=60, icon164=650, icon165=1, icon166=6, icon167=12,
		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=5, icon182=10,
		icon183=3, icon184=1, icon185=0, icon186=10, icon187=20,
		icon188=4, icon189=3, icon190=500, icon191=50, icon192=5000,
		icon193=1000, icon194=2000, icon195=4000, icon196=50,
		icon197=100, icon198=500, icon199=1000, icon200=3000,
		icon201=7000, icon202=2700, icon203=1400, icon204=5500,
		icon205=2000, icon206=2500, icon207=4500, icon208=1900,
		icon209=3000, icon210=3500, icon211=1800, icon212=3300,
		icon213=8, icon214=20, icon215=50, icon216=4000, icon217=500,
		icon218=3, icon219=3, icon220=500, icon221=1000, icon222=3,
		icon223=3, icon224=4000, icon225=2000, icon226=2000, 
		icon227=3000, icon228=6, icon229=5, icon230=10, icon231=10,
		icon232=10, icon233=4, icon234=0, icon235=0, icon236=3,
		icon237=4, icon238=4000, icon239=2000, icon240=3000, 
		icon241=2000, icon242=1000, icon243=3000, icon244=400,
		icon245=160, icon246=1, icon247=21, icon248=4, icon249=5,
		icon250=50, 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=3,
		icon275=100, icon276=100, icon277=100, icon278=100,
		icon279=1000, icon280=2000, icon281=100, icon282=200,
		icon283=3, icon284=3, icon285=1000, icon286=2000,
		icon287=100, icon288=200, icon289=3, icon290=3, icon291=1,
		icon292=800, icon293=0, icon294=0, icon295=0, icon296=8,
		icon297=0, icon298=8, icon299=7, icon300=140, icon301=0,
		icon302=0, icon303=0, icon304=20, icon305=230, icon306=11,
		icon307=9, icon308=7, icon309=15, icon310=3, icon311=3,
		icon312=1, icon313=10, icon314=20000, icon315=5000, 
		icon316=10, icon317=20000, icon318=5000, icon319=1,
		icon320=65000, icon321=50, icon322=44, icon323=31000,
		icon324=700, icon325=3, icon326=6, icon327=4, icon328=0,
		icon329=1, icon330=35, icon331=6, icon332=3, icon333=2,
		icon334=6, icon335=3, icon336=2, icon337=2, icon338=100,
		icon339=15, icon340=700, icon341=50, icon342=8,
		icon343=700, icon344=22, icon345=600, icon346=230,
		icon347=2, icon348=20, icon349=25, icon350=29,
		icon351=15, icon352=9, icon353=3, icon354=75, 
		icon355=170, icon356=14, icon357=20, icon358=20, 
		icon359=25, icon360=2800, icon361=5, icon362=2700,
		icon363=16, icon364=2500, icon365=50, icon366=500,
		icon367=2000, icon368=0, icon369=10, icon370=2,
		icon371=5, icon372=2500, icon373=2500, icon374=3,
		icon375=5, icon376=3, icon377=20, icon378=1, icon379=1)
	dcon <- c(big=big, dcon01=0, dcon02=7.8, dcon03=.8, dcon04=.53,
		dcon05=1e-5, dcon06=.009, dcon07=.09, dcon08=0, 
		dcon09=0, dcon10=1, dcon11=0, dcon12=4.5e-4, dcon13=.015,
		eps=.Machine$double.eps, dcon15=0.37, dcon16=.03, 
		dcon17=0.65, dcon18=0.5, dcon19=0.15, dcon20=.3, dcon21=.5,
		dcon22=6.9, dcon23=1e18, dcon24=.36, dcon25=.1, dcon26=.8,
		dcon27=1.0, dcon28=4e-5, dcon29=.25, dcon30=3.4, dcon31=.4,
		dcon32=.08, dcon33=.32, dcon34=.69, dcon35=.44, dcon36=5.3,
		dcon37=1.5, dcon38=1.0, dcon39=2, dcon40=.5, dcon41=400,
		dcon42=.2, dcon43=.5, dcon44=2.7, dcon45=.7, dcon46=.5,
		dcon47=.55, dcon48=.3, dcon49=.3, dcon50=.8, dcon51=0.7,
		dcon52=1.8, dcon53=.6, dcon54=250, dcon55=.2, dcon56=7,
		dcon57=.65, dcon58=1.3, dcon59=.4, dcon60=2.4, dcon61=1.73,
		dcon62=1.75, dcon63=1.3, dcon64=.75, dcon65=.02, dcon66=.02,
		dcon67=.4, dcon68=1.3, dcon69=1.0, dcon70=.18, dcon71=.7,
		dcon72=.3, dcon73=1.3, dcon74=3, dcon75=.2, dcon76=.28,
		dcon77=.3, dcon78=6, dcon79=1e-3, dcon80=1e-5, dcon81=.67,
		dcon82=3e-5, dcon83=.2, dcon84=1e-5, dcon85=.01, dcon86=6,
		dcon87=10, dcon88=.3, dcon89=4e-5, dcon90=5.3, dcon91=.0065,
		dcon92=.7, dcon93=1.5, dcon94=.05, dcon95=1.5, dcon96=10,
		dcon97=.3, dcon98=5.3, dcon99=.35, dcon100=.5, dcon101=.22,
		dcon102=.5, dcon103=.6, dcon104=.9, dcon105=.1, dcon106=.12,
		dcon107=.5, dcon108=.2, dcon109=1.1, dcon110=.1, dcon111=.9, 
		dcon112=.9, dcon113=.3, dcon114=.2, dcon115=1.6, dcon116=1.0,
		dcon117=.9, dcon118=.45, dcon119=1.4, dcon120=.35, dcon121=1.0,
		dcon122=.22, dcon123=.6, dcon124=8.0, dcon125=.8, dcon126=0.5,
		dcon127=1.5, dcon128=.5, dcon129=.5, dcon130=.45, dcon131=.7,
		dcon132=.2, dcon133=.008, dcon134=.37, dcon135=.1, dcon136=.4,
		dcon137=.05, dcon138=.35, dcon139=.05, dcon140=1, dcon141=1.5,
		dcon142=.35, dcon143=4.3, dcon144=2.7, dcon145=6, dcon146=.13,
		dcon147=.85, dcon148=2.3, dcon149=6, dcon150=50, dcon151=2.5,
		dcon152=120, dcon153=6, dcon154=100, dcon155=1e-10, dcon156=2,
		dcon157=2e-4, dcon158=1000, dcon159=10, dcon160=2.5,
		dcon161=10.5, dcon162=.4, dcon163=6, dcon164=.035, dcon165=.65,
		dcon166=.07, dcon167=4, dcon168=2.5, dcon169=16, dcon170=30,
		dcon171=12, dcon172=100, dcon173=.05, dcon174=.2,
		dcon175=.1, dcon176=1, dcon177=0, dcon178=.05, dcon179=.25,
		dcon180=1, dcon181=.7, dcon182=1, dcon183=.6, dcon184=.2,
		dcon185=.7, dcon186=.4, dcon187=.4, dcon188=.35, dcon189=.2,
		dcon190=.55, dcon191=2, dcon192=1.05, dcon193=.9, dcon194=1.00,
		dcon195=.15, dcon196=1.2e-5, dcon197=1.6, dcon198=.001,
		dcon199=.5, dcon200=6, dcon201=1.5, dcon202=2.0, dcon203=6,
		dcon204=.4, dcon205=830, dcon206=6e-5, dcon207=.25,
		dcon208=3, dcon209=.35, dcon210=7e-5, dcon211=3e-4,
		dcon212=10, dcon213=.65, dcon214=.12, dcon215=.2,
		dcon216=.9, dcon217=.1, dcon218=1e-10, dcon219=.25,
		dcon220=.15, dcon221=.15, dcon222=.35, dcon223=1.7, 
		dcon224=10, dcon225=9, dcon226=.07, dcon227=.95, dcon228=.5,
		dcon229=.45, dcon230=0.02, dcon231=0, dcon232=0.8, 
		dcon233=0.5,
		dcon234=.25, dcon235=.6, dcon236=.2, dcon237=.5, dcon238=0.2,
		dcon239=0.4, dcon240=0.1, dcon241=0.2, dcon242=.2, dcon243=.1,
		dcon244=.1, dcon245=.1, dcon246=.85, dcon247=.3, dcon248=.1,
		dcon249=.06, dcon250=.25, dcon251=.05, dcon252=.3, dcon253=.28,
		dcon254=.2, dcon255=.3, dcon256=.1, dcon257=.3, dcon258=.6,
                dcon259=.1, dcon260=.8, dcon261=.75, dcon262=.7, dcon263=.1,
                dcon264=.5, dcon265=.2, dcon266=.3, dcon267=.8, dcon268=.8,
                dcon269=.3, dcon270=.1, dcon271=.3, dcon272=.7, dcon273=.3,
                dcon274=0, dcon275=0, dcon276=.04, dcon277=0, dcon278=.6,
                dcon279=.1, dcon280=.1, dcon281=.1, dcon282=.1, dcon283=.1,
                dcon284=.5, dcon285=.1, dcon286=.3, dcon287=.35, dcon288=.8,
                dcon289=.6)
	aux <- c(adjust=1, sharetol=1e-5, 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)

	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) != 8)
                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)
}

#line 1 "E:/incoming/PortfolioProbe/R/random.portfolio.q"
"random.portfolio" <-
function (number.rand=1, prices, variance=NULL, expected.return=NULL, ..., 
	out.trade=FALSE, intermediate=NULL)
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "random.portfolio 009"

        subf.unpack.violcode <- function(violcode) {
                ans <- NULL
                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
        }
        #
        # start of main function
        #

	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)

	nsize <- 43; ndval <- 10

	if(is.list(intermediate)) {
		intnam <- names(intermediate)
		correctnam <- c("assetnam", "dowarn", "checkinput",
			"existid", "existing",
 			"prices", "tradeuniv", "lowupp", "variance",
			"vartype", "varoffset", "nvarfactors", "expecret",
			"benchid", "cost", "cost.par", "threshold",
			"constrainvec", "constrainlevels", "lowconstrain",
			"highconstrain", "penalty.constraint", "constraintype",
			"destwt", "sizecontrol", "startid", "start.sol",
			"forced.id", "forced.trade", "utiltabint", 
			"alphatable", "vartable", "utiltabdoub", "dvalcontrol",
			"seed", "ezlicense", "auxcontrol")
		nammatch <- match(correctnam, intnam, nomatch=NA)
		if(any(is.na(nammatch))) {
			stop("list given as 'intermediate' does not have all necessary components")
		}
		setup <- intermediate
		intermediate <- NULL
	} else {
		setup <- trade.optimizer(intermediate="Clist", 
			calling='random.portfolio', prices=prices,
			variance=variance, expected.return=expected.return, 
			...)
	}
	ntrade <- setup$sizecontrol[15 + 1]
	if(any(duplicated(setup$assetnam)))
		stop("duplicate asset names not allowed")
	if(ntrade < 2) stop("ntrade needs to be at least 2")
	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
	utint <- setup$utiltabint
	utint[seq(3, to=length(utint)-1, by=4)] <- -1
	setup$utiltabint <- as.integer(c(utint, -1, -1, 0, 0))
	setup$utiltabdoub <- as.double(c(setup$utiltabdoub, 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

	if(length(intermediate) != 1 || !is.character(intermediate)) {
                intermediate <- NULL
        } else {
                intermediate.menu <- "Clist"
                intermediate.num <- pmatch(intermediate, intermediate.menu,
                        nomatch=0)
                if(intermediate.num) {
                        intermediate <- intermediate.menu[intermediate.num]
                } else {
                        intermediate <- NULL
                }
        }
	
	if(length(intermediate) && intermediate == "Clist") {
		return(setup)
	}

	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),
                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),
                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]) {
				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("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,", " violated:",
				paste(subf.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",
				"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
                	stop("duplicates in trade (bug in C code) please email a report to patrick@burns-stat.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
                	stop("missing values in result (bug in C code) please email a report to patrick@burns-stat.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, "timestamp") <- date()
	attr(ans, "seed") <- setup$seed
	attr(ans, "version") <- c(C.code=out$version, 
		S.code=fun.version)
	attr(ans, "checkinput") <- setup$checkinput
	attr(ans, "funevals") <- out$doutput[6]
	class(ans) <- "randportBurSt"
	ans
}

#line 1 "E:/incoming/PortfolioProbe/R/random.portfolio.utility.q"
"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
}

#line 1 "E:/incoming/PortfolioProbe/R/randport.eval.q"
"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-2009  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "randport.eval 003"

	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
	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) {
		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
}

#line 1 "E:/incoming/PortfolioProbe/R/seed.BurSt.q"
"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)))
}

#line 1 "E:/incoming/PortfolioProbe/R/summary.portfolBurSt.q"
"summary.portfolBurSt" <-
function (object, prices=object$prices, ...) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "summary.portfolBurSt 007"

	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$lin.realized)) {
		ans$lin.trade <- object$lin.trade
		ans$lin.abs <- object$lin.abs
		ans$lin.style <- object$lin.style
		ans$lin.direction <- object$lin.direction
		ans$lin.realized <- object$lin.realized
	}
	ans
}

#line 1 "E:/incoming/PortfolioProbe/R/summary.randportBurSt.q"
"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)))))))
}
#line 1 "E:/incoming/PortfolioProbe/R/tail.randportBurSt.q"
"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)
	attributes(ans) <- xat
	ans
}

#line 1 "E:/incoming/PortfolioProbe/R/trade.distance.q"
"trade.distance" <-
function (x, y, price=NULL, scale=TRUE) 
{
	fun.copyright <- "Copyright 2008-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "trade.distance 003"

	if(!length(price)) {
		xprice <- x$price
		yprice <- y$price
		assetnam <- unique(c(names(xprice), names(yprice)))
		price <- rep(NA, length(assetnam))
		names(price) <- assetnam
		if(length(yprice)) {
			price[names(yprice)] <- yprice
		}
		if(length(xprice)) {
			price[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]) > 1e-6)) {
				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
	}
	xval <- xshares * price[names(xshares)]
	yval <- yshares * price[names(yshares)]
	allnam <- unique(c(names(xval), names(yval)))
	diffval <- rep(0, length(allnam))
	names(diffval) <- allnam
	if(scale == "weight") {
		xval <- xval / sum(abs(xval))
		yval <- yval / sum(abs(yval))
		diffval[names(xval)] <- xval
		diffval[names(yval)] <- diffval[names(yval)] - yval
		ans <- sum(abs(diffval))
		return(ans)
	}
	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
}

#line 1 "E:/incoming/PortfolioProbe/R/trade.optimizer.control.q"
"trade.optimizer.control" <-
function(iterations.max=20, fail.iter=0, funeval.max=.Machine$integer.max, 
	trace=0, exit.obj=-big, doubleconst=FALSE, 
	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, ...)
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "trade.optimizer.control 010"

	big <- 1e100
	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=1.5e5, 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=.06, dcon04=.6,
		dcon05=1e-5, dcon06=.001, dcon07=.09, exit.obj=exit.obj, 
		dcon09=0, dcon10=1, dcon11=0, dcon12=.009, dcon13=.054,
		eps=.Machine$double.eps, dcon15=0.4, dcon16=.2, 
		dcon17=0.5, dcon18=0.12, dcon19=0.15, dcon20=.3, dcon21=.5,
		dcon22=45000, dcon23=1e17, dcon24=.1, dcon25=.35, dcon26=.8,
		dcon27=1.2, dcon28=3e-5, dcon29=.01, dcon30=2.2, dcon31=.25,
		dcon32=1.0, dcon33=1.4, dcon34=.76, dcon35=.75, dcon36=8.0,
		dcon37=1.6, dcon38=2.8, dcon39=6.0, dcon40=.75, dcon41=1300, 
		dcon42=.13, dcon43=.74, dcon44=2.0, dcon45=.4, dcon46=.3,
		dcon47=.5, dcon48=.5, dcon49=.6, dcon50=.65, dcon51=1.5,
		dcon52=2.4, dcon53=.8, dcon54=440, dcon55=.43, dcon56=6,
		dcon57=.5, dcon58=1.0, dcon59=.55, dcon60=3, dcon61=.5,
		dcon62=1.0, dcon63=5.0, dcon64=.45, dcon65=.62, dcon66=.15,
		dcon67=.75, dcon68=0.5, dcon69=0.8, dcon70=.2, dcon71=.5,
		dcon72=.2, dcon73=1.3, dcon74=8, dcon75=.2, dcon76=.4,
		dcon77=.8, dcon78=8, dcon79=.0005, dcon80=5e-5, dcon81=.4,
		dcon82=4e-5, dcon83=.1, dcon84=1e-5, dcon85=.2, dcon86=6,
		dcon87=6, dcon88=.004, dcon89=5e-5, dcon90=10.0, dcon91=.005,
		dcon92=.1, dcon93=1.7, dcon94=.09, dcon95=1.5, dcon96=8,
		dcon97=.45, dcon98=4.0, dcon99=.2, dcon100=.4, dcon101=.1,
		dcon102=.7, dcon103=1.2, dcon104=1.5, dcon105=1.7, dcon106=.6,
		dcon107=.4, dcon108=.2, dcon109=1.5, dcon110=.4, dcon111=1.1, 
		dcon112=.3, dcon113=.7, dcon114=.77, dcon115=4, dcon116=1.0,
		dcon117=.9, dcon118=1.1, dcon119=1.1, dcon120=.7, dcon121=2.6,
		dcon122=.12, dcon123=.55, dcon124=5.7, dcon125=.5, dcon126=2.4,
		dcon127=.5, dcon128=.6, dcon129=.5, dcon130=.57, dcon131=.2,
		dcon132=.65, dcon133=.25, dcon134=.34, 
		dcon135=.35, dcon136=.55,
		dcon137=.2, dcon138=.8, dcon139=.2, dcon140=15, dcon141=2.0,
		dcon142=.6, dcon143=13, dcon144=14, dcon145=13, dcon146=.6,
		dcon147=.9, dcon148=2.0, dcon149=18, dcon150=60, dcon151=4.5,
		dcon152=60, dcon153=2.0, dcon154=60, dcon155=7e-5, dcon156=3.0,
		dcon157=.04, dcon158=1.8e6, dcon159=12.5, dcon160=9.7,
		dcon161=11, dcon162=.6, dcon163=2, dcon164=2e-4, dcon165=.05,
		dcon166=.05, dcon167=1, dcon168=2, dcon169=.9, dcon170=10,
		dcon171=2.5, dcon172=10.5, dcon173=.2, dcon174=.2,
		dcon175=.1, dcon176=57, dcon177=0.6, dcon178=.7, dcon179=.5,
		dcon180=2, dcon181=.5, dcon182=1.5, dcon183=.12, dcon184=.2,
		dcon185=.6, dcon186=.6, dcon187=.8, dcon188=1.2, dcon189=.25,
		dcon190=2.8, dcon191=5.7, dcon192=.99, dcon193=.9, dcon194=.9,
		dcon195=.01, dcon196=1e-10, dcon197=1.6, dcon198=.0005,
		dcon199=.6, dcon200=5, dcon201=1, dcon202=1.5, dcon203=5,
		dcon204=.5, dcon205=2500, dcon206=3e-5, dcon207=.35,
		dcon208=5.8, dcon209=.5, dcon210=3e-5, dcon211=.2, 
		dcon212=3.5, dcon213=.25, dcon214=.25, dcon215=.55,
		dcon216=.4, dcon217=.6, dcon218=5e-3, dcon219=.2,
		dcon220=.3, dcon221=.27, dcon222=.7, dcon223=1.1,
		dcon224=14, dcon225=28, dcon226=.02, dcon227=.3, dcon228=.5,
		dcon229=.05, dcon230=0.05, dcon231=0.2, 
		dcon232=0.75, dcon233=0.34,
		dcon234=.3, dcon235=.5, dcon236=.6, dcon237=.5, dcon238=0.3,
		dcon239=0.2, dcon240=0.2, dcon241=0.3, dcon242=.8, dcon243=.6,
		dcon244=.1, dcon245=.9, dcon246=.8, dcon247=.38, dcon248=.5,
		dcon249=.6, dcon250=.6, dcon251=.1, dcon252=.35, dcon253=.3,
		dcon254=.9, dcon255=.3, dcon256=.5, dcon257=.15, dcon258=.2,
		dcon259=.25, dcon260=.65, dcon261=.55, dcon262=.3, dcon263=.4,
		dcon264=.4, dcon265=.1, dcon266=.8, dcon267=.5, dcon268=.25,
		dcon269=.8, dcon270=.2, dcon271=.7, dcon272=.75, dcon273=.4,
		dcon274=.5, dcon275=.1, dcon276=.1, dcon277=.1, dcon278=.6,
		dcon279=.4, dcon280=.3, dcon281=.2, dcon282=.5, dcon283=.4,
		dcon284=.5, dcon285=.6, dcon286=.1, dcon287=.1, dcon288=.5,
		dcon289=.1)
	aux <- c(adjust=1, sharetol=1e-5, single.search=5000, 
		doubleconst=doubleconst, force.risk.aver=force.risk.aver, 
		enforce.max.weight=enforce.max.weight,
		save.iterhistory=save.iterhistory, throw.error=TRUE)
		# throw.error only to match random.portfolio.control

	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) != 8)
                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)
}

#line 1 "E:/incoming/PortfolioProbe/R/trade.optimizer.q"
"trade.optimizer" <-
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, 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=FALSE, 
	lin.style="weight", lin.direction=0, 
	alpha.constraint=NULL, var.constraint=NULL, bench.constraint=NULL, 
	sum.weight=NULL, limit.cost=NULL, close.number=NULL, 
	utility="information ratio", risk.aversion=1, 
	benchmark=NULL, bench.trade=FALSE, 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, 
	seed = if(calling=="random.portfolio") NULL else .standard.seed.BurSt,
	control=if(calling=="random.portfolio") random.portfolio.control(...) 
	else trade.optimizer.control(...), penalty.constraint=1000,
	quantile=0.5, dest.wt=NULL, utable=NULL, atable=NULL, vtable=NULL, 
	intermediate=NULL, calling="trade.optimizer", ...) 
{
	fun.copyright <- "Copyright 2003-2009 Burns Statistics Ltd.  All rights reserved."
	fun.version <- "trade.optimizer 022"

	#
	# subfunctions
	#
		subf.rectify.start <- function(start.sol, ntrade, assetnam, 
				trade.univ, sharetol) {
			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])
		}
	}

	subf.unpack.violcode <- function(violcode) {
		ans <- character(0)
		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
	}
	#
	# start of main function
	#
	if(length(calling) != 1 || mode(calling) != "character" ||
			(calling != "trade.optimizer" && calling != 
			"random.portfolio")) {
		stop(paste("'calling' must be a single string that is either",
			"'trade.optimizer' or 'random.portfolio'",
			"-- given has mode", mode(calling), "and length",
			length(calling)))
	}
	if(!length(seed)) {
		seed <- seed.BurSt()
	}
	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)))
	}
	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")
	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'",
				"-- possible choices are:",
				paste(do.warn.menu, 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(length(intermediate) != 1 || !is.character(intermediate)) {
		intermediate <- NULL
	} else {
		intermediate.menu <- "Clist"
		intermediate.num <- pmatch(intermediate, intermediate.menu, 
			nomatch=0)
		if(intermediate.num) {
			intermediate <- intermediate.menu[intermediate.num]
		} else {
			intermediate <- NULL
		}
	}
	if(is.character(control)) control <- get(control)
	if(is.function(control)) {
		control <- control(...)
	}
	conlen <- c(icon=380, dcon=290, aux=8)
	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"]

	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'"))
	}

	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))
		stop("'long.only' must be a single logical value")
	if(is.na(long.only)) stop("missing value for 'long.only'")
	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 < 9) {
			stop(paste("(apparently)", an.dup.sum,
				"duplicate name(s) in 'prices':",
				paste(assetnam[an.dup], collapse=", ")))
		} else {
			stop(paste("(apparently)", an.dup.sum,
				"duplicate names in 'prices'. ",
				"First few are:",
				paste(assetnam[an.dup][1:5], collapse=", ")))
		}
	}

	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'")
		}
		if(calling == "trade.optimizer" && 
				do.warn["novariance.optim"]) {
			warning("performing optimization with no variance ('do.warn' suppression is 'novariance.optim')")
		}
		nvar <- 0
		vartype <- 0
		varoffset <- 0
		nvarfactors <- 0
	} else {
		dv <- dim(variance)
		ldv <- length(dv)
		if(ldv != 2 && ldv != 3)
			stop("'variance' must be a matrix or 3-D array")
		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(length(dnv) && (length(dnv) != nassets || 
				!all(dnv == assetnam))) {
                        if(length(intersect(assetnam, dnv)) < nassets) {
                        	if(length(intersect(assetnam, c(dnv, allben))) 
						== nassets) {
					stop(paste("'variance' does not hold all the benchmarks:",
						paste(setdiff(allben, dnv),
						collapse=", ")))
				} 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("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(any(is.na(variance))) {
			stop(paste(sum(is.na(variance)), 
				"missing value(s) in 'variance'"))
		}
		if(ldv == 2) dv <- c(dv, 1)
		nvar <- dv[3]
		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'"))
	}
	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 {
		# if(any(lin.trade)) 
			# stop("lin.trade no existing portfolio")
		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 number",
			"-- given has mode", mode(allowance), "and length",
			length(allowance)))
	}
	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("'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)
			turnover[1] <- max(0, turnover[1])
			if(turnover[2] <= 0) {
				if(norig == 0) {
					stop("'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("'bench.trade' must be a single logical value")
	}
	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("'max.weight' is not a numeric vector (with values)")
	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
	}


	sizes <- integer(43)
	names(sizes) <- c("nassets", "nvariances", "nalphas", "nutil", "ndest",
		"turnover.constraint", "lbo", "lso", "sbo", "sso", "cost.type", 
		"nodoubleconst", "long.only", "nbenchmarks", "norig", "npar", 
		"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")

	sizes["nsumwtcon"] <- length(sum.weight)
	implied.min.port.size <- 0
	if(length(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'")
		sumwtid.raw <- as.numeric(names(sum.weight))
		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 > 1)) {
			stop(paste(sum(sum.weight > 1), "value(s) in",
				"'sum.weight' are greater than one",
				"-- the names for these are:",
				paste(names(sum.weight)[sum.weight > 1],
				collapse=", ")))
		}
		if(any(sum.weight <= 0)) {
			stop(paste(sum(sum.weight <= 0), "value(s) in",
				"'sum.weight' are less than or equal to zero",
				"-- the names for these are:",
				paste(names(sum.weight)[sum.weight <= 0],
				collapse=", ")))
		}
		sum.weight <- sum.weight[order(sumwtid)]
		sumwtid <- sort(sumwtid)
		implied.min.port.size <- max(ceiling(sumwtid / sum.weight))
	} else {
		sumwtid <- NULL
	}
	if(length(sum.weight)) {
		t.upper <- gross.value[2] * pmin(max.weight, sum.weight[1]) / 
			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]) / 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
	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 && all(apply(positions, 2,
					function(z) diff(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)
		} else {
			pos.notrade <- 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
		}
	} else {
		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
		}
	} else {
		lower.trade <- rep(-Inf, nassets)
		names(lower.trade) <- assetnam
	}
	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=', ')))
	}

	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 > 
				auxcontrol["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]
	} else {
		force.neg <- force.pos <- NULL
	}

	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("'ntrade' must have length 1 or 2")
	}
	if(!is.numeric(ntrade) || any(is.na(ntrade)) || any(ntrade < 0)) {
		stop("'ntrade' must be 1 or 2 non-negative integers or NULL")
	}
	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) {
		ntrade <- sort(ntrade)
		# if(ntrade[2] <= 0) stop("'ntrade' says no assets are to trade")
		min.ntrade <- ntrade[1]
		ntrade <- ntrade[2]
	} else {
		if(ntrade < 0) {
			stop(paste("'ntrade' must be non-negative,",
				"value given was:", ntrade))
		}
		min.ntrade <- 0
	}
	ntrade <- min(ntrade, sum(trade.univ > 0))

	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)) {
		stop(paste("'port.size' must be a numeric vector or NULL",
			"-- given is", mode(port.size)))
	}
	if(any(is.na(port.size))) stop("missing value in 'port.size'")
	if(implied.min.port.size > norig + ntrade) {
		stop(paste( "impossible portfolio size", implied.min.port.size,
			"implied by 'sum.weight'",
			"with 'ntrade' equal", ntrade))
	}
	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(port.size[1] > norig + ntrade) {
			stop(paste("impossible value for minimum 'port.size'",
				port.size[1], "with 'ntrade' equal", ntrade))
		}
	} 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, 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("'port.size' must have length 0, 1 or 2")
	}
	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]))
	}
	sizes["portsize.on"] <- port.size[1] > 0 || port.size[2] < nassets
	
	if(length(close.number)) {
		if(length(close.number) > 2) 
			stop("'close.number' must have length 0, 1, or 2")
		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'"))
		}
		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 ", min(max(port.size),
			nassets), ")", 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
		}
	} else {
		ntrade <- 1
	}
	icontrol["npar"] <- ntrade
	tradnams <- names(trade.univ)[trade.univ > 0]

	mwsum <- sum(rev(sort(max.weight[tradnams]))[1:max(min(max(port.size), 
		norig + ntrade, length(tradnams)), 2)])
	if(mwsum < 1.001 && length(tradnams) > 1 && ntrade + norig > 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("'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)) {
			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"))
			}
			if(do.warn["no.asset.names"]) {
				warning("no asset names for 'expected.return', assuming correct order ('do.warn' suppression is 'no.asset.names')")
			}
		}
		if(any(is.na(expected.return))) {
			stop(paste(sum(is.na(expected.return)),
				"missing 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
	}

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

     if(calling == "trade.optimizer") {
	if(!length(utility)) utility <- "information ratio"
	if(length(utility) != 1) stop("'utility' must be a single string")
	utility.num <- pmatch(utility, utility.menu, nomatch=0)
	if(utility.num == 0) {
		stop(paste("unknown or ambiguous value for 'utility'",
			"possible choices are:", paste(utility.menu,
			collapse=", ")))
	}
	utility <- utility.menu[utility.num]
	if(utility.num == 4) {
		if(nvar == 0 && calling == "trade.optimizer") {
			stop("minimum variance utility but NULL variance")
		}
	} else if(utility.num == 2 || utility.num == 3) {
		if(nret == 0) {
			if(nvar == 0 && calling == "trade.optimizer") {
				stop(paste("neither 'variance' nor",
					"'expected.return' given",
					"to the optimizer"))
			}
			utility.num <- 4
			if(do.warn["utility.switch"] && calling != 
					"random.portfolio") {
				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"] && calling !=
					"random.portfolio") {
				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"] && calling !=
					"random.portfolio") {
				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)) {
			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 && calling == "trade.optimizer") {
				stop(paste("neither 'variance' nor",
					"'expected.return' given",
					"and optimizing"))
			}
			if(do.warn["utility.switch"] && calling !=
					"random.portfolio") {
				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"] && calling !=
					"random.portfolio") {
				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 && calling == "trade.optimizer") {
			stop("maximum return utility but no expected returns")
		}
	}
	# don't make trouble when risk.aversion not used
	if(any(!is.finite(risk.aversion))) risk.aversion <- 1
     } else {
	utility.num <- 2
     } # end calling trade.opt

	sizes[c("nassets", "npar", "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")
	}
	if(length(start.sol)) {
		if(calling == "random.portfolio" && do.warn["random.start"]) {
			warning("'start.sol' (suggested trade) ignored in 'random.portfolio', did you mean to use 'existing' (current portfolio)? ('do.warn' suppression is 'random.start')")
		}
		if(calling != "random.portfolio" && !norig &&
				icontrol["funeval.max"] > 1 &&
				do.warn["start.noexist"]) {
			warning("'start.sol' (suggested trade) but not 'existing' (current portfolio), did you mean to use 'existing'? ('do.warn' suppression is 'start.noexist')")
		}
		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 <- subf.rectify.start(start.sol, ntrade, assetnam,
			trade.univ, auxcontrol["sharetol"])
		start.sol <- start.rec$shares
		start.id <- start.rec$id
		popgiven <- ncol(start.sol)
		if(!length(popgiven)) popgiven <- 0
		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)
	}

	bc.id <- bc.loc <- bc.lval <- bc.uval <- NULL
	bc.num <- 0
	if(length(vtable)) {
		if(length(bench.constraint)) 
			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(length(utable)) {
		if(length(bench.constraint)) {
			stop("'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'")
		if(any(utable[1,] > nalcomben - 1)) {
			stop(paste("improper 1st row in 'utable'",
				"-- should not exceed", nalcomben - 1))
		}
		if(any(utable[2,] > nvarcomben - 1)) {
			stop(paste("improper 2nd row in 'utable'",
				"-- should not exceed", nvarcomben - 1))
		}
		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=", ")))
		}
		sizes["ndest"] <- ndest <- max(ut.d) + 1
		ut.o <- utable[4,]
		if(any(ut.o < 0 | ut.o > 5)) {
			stop(paste("improper utility (4th row) in 'utable'",
				"-- allowable values are: 0 through 5"))
		}
		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"] && calling !=
					"random.portfolio") {
				warning(paste(sum(utable[6,ut.d>=0] < 0),
					"negative weight(s)-in-destination",
					"in 'utable' ('do.warn' suppression",
					"is 'neg.dest.wt')"))
			}
		sizes["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 {
		sizes[c("nutil", "ndest")] <- nutil <- ndest <- nalcomben * 
			nvarcomben
		ut.a <- rep(1:nalcomben, nvarcomben)
		ut.v <- rep(1:nvarcomben, rep(nalcomben, nvarcomben))
		ut.o <- rep(utility.num, length=nalcomben * nvarcomben)
		ut.a[ut.o == 4] <- 0
		ut.v[ut.o == 5] <- 0
		if(length(bench.constraint)) {
			ut.d <- rep(0, nalcomben * nvarcomben)
			ut.d[match(ut.v, vtd, nomatch=0) > 0] <- 1:(nalcomben 
				* vtoc)
			sizes["ndest"] <- nalcomben * vtoc
		} else {
			ut.d <- 1:(nalcomben * nvarcomben)
		}
		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))
		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(ut.o < 0) || any(ut.o > 5) || 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",
			"-- the row is:", paste(ut.o, collapse=", ")))

	}
	if(!is.numeric(penalty.constraint)) {
		stop(paste("'penalty.constraint' must be numeric, not",
			mode(penalty.constraint)))
	}
	if(any(is.na(penalty.constraint))) 
		stop("missing value(s) in 'penalty.constraint'")
	if(!length(penalty.constraint)) 
		stop("'penalty.constraint' is length zero")
	if(any(penalty.constraint < 0)) 
		stop("negative value(s) in 'penalty.constraint'")
	if(any(ut.o == 0 | ut.o == 5)) {
		if(any(ut.r[ut.o == 0 | ut.o == 5] < 0) && 
				do.warn["neg.risk.aversion"] &&
				calling != "random.portfolio") {
			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) && 
				calling != "random.portfolio") {
			warning("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(length(lin.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("no row names on 'lin.constraints', assuming correct order ('do.warn' suppression is 'no.asset.names')")
			}
			dimnames(lin.constraints)[[1]] <- assetnam
		}
		sizes["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
		sizes["maxconlev"] <- max(constrain.levels)
		sizes["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'")
		lin.trade <- rep(lin.trade, length=nconsmain)
		lin.abs <- rep(lin.abs, length=nconsmain)
		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")
		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 <- 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.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'")
		}
		lin.direction <- rep(lin.direction, length=nconsmain)

		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]
			sizes["nconsmain"] <- nconsmain
			sizes["nconsub"] <- nrow(lin.bounds)
			if(nconsmain == 0) {
				constrainvec <- 0
				lin.style <- lin.style[-lbcallout]
				lin.stylenum <- 0
				lin.trade <- FALSE
				lin.abs <- FALSE
				lin.direction <- 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]
				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
		low.constraint <- lin.bounds[,1]
		up.constraint <- lin.bounds[,2]
	} else {
		if(!is.null(lin.constraints)) {
			stop(paste("bad value for 'lin.constraints'",
				"-- must be NULL if of zero length"))
		}
		if(length(lin.bounds)) {
			warning(paste("'lin.bounds' given but not",
				"'lin.constraints' -- no linear constraints",
				"performed"))
		}
		sizes[c("nconsmain", "maxconlev", "nconsub")] <- 0
		constrain.levels <- NULL
		nconsmain <- 0
		constrainvec <- 0
		lin.stylenum <- 0
		lin.direction <- 0
		linconstnames <- NULL
		low.constraint <- up.constraint <- NULL
	}
	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) {
			warning(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 + 13 + 
		sizes["nvarcon"] + sizes["nalphacon"])
	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)
	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
	}
	up.constraint <- c(up.constraint, vc.up, bc.uval, 
		ac.up, sum.weight)
	low.constraint <- c(low.constraint, vc.lo, bc.lval,
		ac.lo, rep(0, length(sum.weight)))
	constrain.levels <- c(constrain.levels, varconid, bc.loc, alphaconid, 
		sumwtid, 0)

	dvalues <- double(10)
	dvalnam <- c("", "turnover", "sharetol", "", "", "gross.trade", 
		"net.trade", "new.trade.avetol", "quantile", "qwt.sum")
	names(dvalues) <- dvalnam

	dvalues["sharetol"] <- sharetol <- auxcontrol["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]
		}
	} else {
		dvalues["gross.trade"] <- gross.value[2]
	}
	if(is.finite(turnover[2])) {
		# dvalues["turnover"] <- 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
	}

	cost.intercept <- FALSE
	usecost <- length(long.buy.cost) + length(long.sell.cost) + 
		length(short.buy.cost) + length(short.sell.cost) 
	if(calling == "random.portfolio" && !length(limit.cost)) usecost <- 0
	if(usecost) {
		# above condition triggers eval of cost arguments
		# so the default long.buy.cost can be changed
		if(length(cost.par)) {
			if(!is.numeric(cost.par)) {
				stop(paste("'cost.par' must be numeric",
					"-- given has mode", mode(cost.par)))
			}
			if(any(is.na(cost.par)))
				stop("missing value(s) in 'cost.par'")
			sizes["cost.type"] <- 2
		} else {
			sizes["cost.type"] <- 1
			cost.par <- 0
		}
		if(length(limit.cost)) {
			if(length(limit.cost) > 2) {
				stop(paste("length of 'limit.cost' must be",
					"0 or 2 -- given has length",
					length(limit.cost)))
			}
			if(!is.numeric(limit.cost)) {
				stop(paste("'limit.cost' must be numeric",
					"-- given has mode", mode(limit.cost)))
			}
			if(any(is.na(limit.cost))) 
				stop("missing value(s) in 'limit.cost'")
			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
			}
			sizes["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=", ")))
		}
		if(length(scale.cost) != 1) {
			stop(paste("'scale.cost' needs to have length",
				"equal to one -- given length is",
				length(scale.cost)))
		}
		scale.menu <- c("gross", "trade", "none")
		scale.num <- pmatch(scale.cost, scale.menu, nomatch=0)
		if(scale.num == 0) {
			stop(paste("unknown or ambiguous choice for",
				"'scale.cost' -- possible choices are:",
				paste(scale.menu, collapse=", ")))
		}
		scale.cost <- scale.menu[scale.num]
		sizes["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)) {
				stop(paste("'long.buy.cost' must be numeric",
					"-- given has mode", 
					mode(long.buy.cost)))
			}
			if(any(is.na(long.buy.cost))) {
				stop(paste(sum(is.na(long.buy.cost)),
					"missing 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("no asset names on 'long.buy.cost', assuming correct order ('do.warn' suppression is 'no.asset.names')")
				}
			}
			sizes["lbo"] <- ncol(long.buy.cost)
			if(sizes["lbo"] > 1 && any(abs(long.buy.cost[,1] > 
					1e-15))) {
				cost.intercept <- TRUE
			}
			sizes["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)))
			}
			sizes["lbo"] <- 0
			sizes["lsoff"] <- 0
			cost <- NULL
		}
		if(length(long.sell.cost)) {
			long.sell.cost <- as.matrix(long.sell.cost)
			if(!is.numeric(long.sell.cost)) {
				stop(paste("'long.sell.cost' must be numeric",
					"-- given has mode", 
					mode(long.sell.cost)))
			}
			if(any(is.na(long.sell.cost))) {
				stop(paste(sum(is.na(long.sell.cost)),
					"missing 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("no asset names on 'long.sell.cost', assuming correct order ('do.warn' suppression is 'no.asset.names')")
				}
			}

			cost <- c(cost, t(long.sell.cost))
			sizes["lso"] <- ncol(long.sell.cost)
			if(sizes["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)))
			}
			sizes["lso"] <- 0
		}
		sizes["sboff"] <- sizes["lsoff"] + length(long.sell.cost)
		if(length(short.buy.cost)) {
			if(!is.numeric(short.buy.cost)) {
				stop(paste("'short.buy.cost' must be numeric",
					"-- given has mode", 
					mode(short.buy.cost)))
			}
			short.buy.cost <- as.matrix(short.buy.cost)
			if(any(is.na(short.buy.cost))) {
				stop(paste(sum(is.na(short.buy.cost)),
					"missing 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("no asset names on 'short.buy.cost', assuming correct order ('do.warn' suppression is 'no.asset.names')")
				}
			}
			cost <- c(cost, t(short.buy.cost))
			sizes["sbo"] <- ncol(short.buy.cost)
			if(sizes["sbo"] > 1 && any(abs(short.buy.cost[,1] > 
					1e-15))) {
				cost.intercept <- TRUE
			}
		} else {
			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)))
			}
			sizes["sbo"] <- 0
		}
		sizes["ssoff"] <- sizes["sboff"] + length(short.buy.cost)
		if(length(short.sell.cost)) {
			if(!is.numeric(short.sell.cost)) {
				stop(paste("'short.sell.cost' must be numeric",
					"-- given has mode", 
					mode(short.sell.cost)))
			}
			short.sell.cost <- as.matrix(short.sell.cost)
			if(any(is.na(short.sell.cost))) {
				stop(paste(sum(is.na(short.sell.cost)),
					"missing 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("no asset names on 'short.sell.cost', assuming correct order ('do.warn' suppression is 'no.asset.names')")
				}
			}

			cost <- c(cost, t(short.sell.cost))
			sizes["sso"] <- ncol(short.sell.cost)
			if(sizes["sso"] > 1 && any(abs(short.sell.cost[,1] > 
					1e-15))) {
				cost.intercept <- TRUE
			}
		} else {
			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)))
			}
			sizes["sso"] <- 0
		}
		if(sizes["cost.type"] == 2) {
			lcp <- length(cost.par)
			dcp <- sizes[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",
						sizes["lbo"], 
						"and 'long.sell.cost' has",
						sizes["lso"]))
				}
			} else {
				if(any(dcp != 0)) {
					stop(paste("all costs must have",
						lcp,
						"column(s) to match 'cost.par'",
						"-- 'long.buy.cost' has",
						sizes["lbo"], 
						"'long.sell.cost' has",
						sizes["lso"],
						"'short.buy.cost' has",
						sizes["sbo"], 
						"'short.sell.cost' has",
						sizes["sso"]))
				}
			}
		}
		if(utility == "information ratio") {
			utility <- "information ratio (with costs)"
		}
	} else {
		cost <- 0
		sizes[c("lbo", "lso", "sbo", "sso", "cost.type", 
			"lsoff", "sboff", "ssoff", "limit.cost")] <- 0
		if(length(limit.cost)) {
			warning("'limit.cost' given but no costs given")
		}
		limit.cost <- c(-big, big)
		if(utility == "information ratio") {
			utility <- "information ratio (no costs)"
		}
	}
	if(length(cost.par) == 0) cost.par <- 0

	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"] && 
			length(cost.par) == 0)  {
		warning("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")
	}

	if(length(intermediate) && intermediate == "Clist") {
		Clist <- list(assetnam=assetnam, dowarn=do.warn,
			checkinput=checkinput, "existid"=as.integer(exist.id), 
			existing=as.double(existing), prices=as.double(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=as.double(penalty.constraint),
			constraintype=as.integer(lin.trade + 
			2*lin.abs), linstyle=as.integer(lin.stylenum),
			lindirection=as.integer(lin.direction),
			"destwt"=as.double(dest.wt),
			sizecontrol=as.integer(c(sizes, icontrol)), 
			"startid"=as.integer(start.id), 
			startsol=as.double(start.sol),
			forcedid=as.integer(forced.id),
			forcedtrade=as.double(forced.trade),
			"utiltabint"=as.integer(utiltab.int), 
			"alphatable"=as.integer(atable),
			"vartable"=as.integer(vtable),
			"utiltabdoub"=as.double(utiltab.doub),
			dvalcontrol=as.double(c(dvalues, dcontrol)), 
			seed = as.integer(seed), ezlicense=ezlicense,
			auxcontrol = auxcontrol)
		return(Clist)
	}

	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"]
	}
# browser()
	out <- .C("portgen_BurSt", as.integer(exist.id), as.double(existing),
		as.double(prices), as.integer(trade.univ),
		as.double(c(lower.trade, upper.trade)), as.double(variance),
		as.integer(vartype), as.integer(varoffset),
		as.integer(nvarfactors), as.double(expected.return),
		as.integer(bench.id), cost=as.double(cost), 
		cost.par=as.double(cost.par), trade.id=integer(ntradeplus), 
		trade.sh=double(ntradeplus), threshold=as.double(threshold),
		avu=double(nalcomben + nvarcomben + ndest), 
		constrainvec=as.double(constrainvec), 
		constrainlevels=as.integer(constrain.levels), 
		lowconstrain=as.double(low.constraint),
		highconstrain=as.double(up.constraint), 
		penalty.constraint=as.double(penalty.constraint),
		constraint.violation=double(length(penalty.constraint)),
		constraintype=as.integer(lin.trade + 2*lin.abs), 
		linstyle=as.integer(lin.stylenum), 
		lindirection=as.integer(lin.direction),
		dest.wt=as.double(dest.wt),
		as.integer(c(sizes, icontrol)), 
		as.integer(start.id), as.double(start.sol),
		as.integer(forced.id), as.double(forced.trade),
		utiltab.int=as.integer(utiltab.int), 
		atable=as.integer(atable),
		vtable=as.integer(vtable),
		utiltab.doub=as.double(utiltab.doub),
		as.double(c(dvalues, dcontrol)), seed = as.integer(seed),
		ioutput=integer(48), doutput=double(6), 
		version=character(1), 
		ezlicense=ezlicense, iterhistory=double(histlen))[
		c("trade.sh", "avu", "trade.id", "constraint.violation", 
		"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)",
			"1099" = "illegal final trade (can retry with new seed)",
				"unspecified error"), 
			" (error ", errnum, ")",
			" fun.evals ", out$ioutput[1],
			sep="")
		stop(errmsg)
	}
	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(?)"))
	}
	constraint.violation <- out$constraint.violation
	names(constraint.violation) <- names(penalty.constraint)
        if(results["penalty"] > 0) {
		violated <- subf.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)) {
                	warning(paste("non-zero penalty of", results["penalty"],
                       		" constraints not met are:",
				paste(violated, collapse=", "),
                        	"\nAre there inconsistent constraints?",
				if(any(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')"
				))
		}
		if(any(violated == "linear")) {
			attr(violated, "linear violations") <-
				names(constraint.violation[1:nconsmain])[
				constraint.violation[1:nconsmain] > 0]
		}
        } else {
		violated <- NULL
	}
	dimnames(utable) <- list(c("alpha.spot", "variance.spot", 
		"destination", "opt.utility", "risk.aversion", 
		"wt.in.destination"), NULL)
	nalcomben <- sizes["nalcomben"]
	nvarcomben <- sizes["nvarcomben"]

	alpha.values <- out$avu[1:nalcomben]
	var.values <- out$avu[nalcomben + 1:nvarcomben]
	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
		stop("missing values in trade (bug in C code) please email a report to patrick@burns-stat.com")
	}
	trade <- trade[abs(trade) > sharetol]
	if(any(duplicated(names(trade)))) {
		# in theory never happens, but best to check
		stop("duplicates in trade (bug in C code) please email a report to patrick@burns-stat.com")
	}
	if(norig) {
		posnam <- unique(c(existnam, names(trade)))
		position <- rep(0, length(posnam))
		names(position) <- posnam
		position[existnam] <- 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) {
			stop("short position in long-only portfolio please email a report to patrick@burns-stat.com")
		} else {
			stop("short position in long-only portfolio: probably bad 'start.sol'")
		}
	}
	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)
	}
	value.limits <- rbind(gross.value, net.value, long.value, short.value)
	dimnames(value.limits) <- list(c("gross", "net", "long", "short"),
		c("lower", "upper"))
	version <- c(C.code=out$version, S.code=fun.version)
	prices.small <- prices[unique(c(names(position), names(trade),
		existnam))]
	universe.size <- c(universe=nassets, tradable=length(tradnams),
		universe.trade=if(length(universe.trade)) length(universe.trade)
		else nassets, positions.notrade=pos.notrade)
	ans <- list(new.portfolio=position, trade=trade, results=results, 
		converged=converged, objective.utility=utility, 
		universe.size=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 = value.limits, prices=prices.small, 
		optim.mumbo.jumbo=optim.mumbo.jumbo, 
		existing = existing, violated = violated, seed = seed, 
		version=version, sizes=sizes)
	if(optim.mumbo.jumbo["fun evals"] == 0) {
		stop(paste("no evaluations done, problem seems to be seen",
			"as ridiculous"))
	}
	if(length(allben)) {
		allbenval <- match(allben, assetnam) - 1
		names(allbenval) <- allben
		ans$benchmarks <- allbenval
	}
	if(sizes["n.forced.trades"]) {
		ans$forced.explicit <- forced.given
		if(length(position.force)) {
			ans$positions.forced <- position.force
		}
		ans$all.forced <- forced.trade
	}
	if(length(positions.give)) {
		ans$positions <- positions.give
		ans$tol.positions <- tol.positions
	}
	if(icontrol["funeval.max"] <= 1 && turnover.type >= 0 && ntrade > 0) {
		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'")
		}
	}
	class(ans) <- "portfolBurSt"
	if(nconsmain) {
                if(length(unique(lin.trade)) == 1) {
                        lin.trade <- as.vector(unique(lin.trade))
                } else {
                        lin.trade <- rep(lin.trade, length=
                                nconsmain)
                        names(lin.trade) <- linconnam
                }
                if(length(unique(lin.abs)) == 1) {
                        lin.abs <- as.vector(unique(lin.abs))
                } else {
                        lin.abs <- rep(lin.abs, length=
                                nconsmain)
                        names(lin.abs) <- linconnam
                }
                if(length(unique(lin.style)) == 1) {
                        lin.style <- as.vector(unique(lin.style))
                } else {
                        lin.style <- rep(lin.style, length=
                                nconsmain)
                        names(lin.style) <- linconnam
                }
                if(length(unique(lin.direction)) == 1) {
                        lin.direction <- as.vector(unique(lin.direction))
                } else {
                        lin.direction <- rep(lin.direction, length=
                                nconsmain)
                        names(lin.direction) <- linconnam
                }
		ans$lin.trade <- lin.trade
		ans$lin.abs <- lin.abs
		ans$lin.style <- lin.style
		ans$lin.direction <- lin.direction
		ans$lin.realized <- constraints.realized(ans,
			lin.constraints, lin.bounds=bounds.infinite,
			lin.abs=lin.abs, lin.style=lin.style, 
			lin.direction=lin.direction)
	}
	if(auxcontrol["save.iterhistory"]) {
		ans$iterhistory <- out$iterhistory[ 1:(optim.mumbo.jumbo[
			"iterations done"] + 2) ]
	}
	ans$checkinput <- checkinput
	ans$timestamp <- date()
	ans$call <- match.call()
	ans
}

#line 1 "E:/incoming/PortfolioProbe/R/update.randportBurSt.q"
"update.randportBurSt" <-
function (object, ..., evaluate = TRUE, checkinput = TRUE) 
{
	fun.copyright <- "Copyright 2009  Burns Statistics Ltd.  All rights reserved."
        fun.version <- "update.randportBurSt 001"

	if(evaluate && checkinput) {
		ans <- update.default(list(call = attr(object, "call")), ..., 
			evaluate=TRUE)
		if(!length(ans) && !length(attr(ans, "checkinput"))) {
			return(ans)
		}
		chma <- pmatch(names(list(...)), names(attr(object, 
			"checkinput")), nomatch=0)
		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)
	}
}

#line 1 "E:/incoming/PortfolioProbe/R/valuation.default.q"
"valuation.default" <-
function (x, prices, weight=TRUE)
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "valuation.default 005"

	if(!length(prices)) stop("no prices")
	if(is.data.frame(prices)) prices <- as.matrix(prices)
	prices <- drop(prices)
	if(length(dim(prices))) {
		stop(paste("'prices' has non-trivial dim -- expecting",
			"a numeric vector with names, given has mode",
			mode(prices), "and dim:", paste(dim(prices),
			collapse = " ")))
	}
	if(!is.numeric(prices)) {
		stop(paste("'prices' is not numeric -- expecting",
			"a numeric vector with names, given has mode",
			mode(prices), "and length", length(prices)))
	}
	if(is.integer(prices)) mode(prices) <- "numeric"

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

	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
}

#line 1 "E:/incoming/PortfolioProbe/R/valuation.portfolBurSt.q"
"valuation.portfolBurSt" <-
function (x, prices=x$prices, trade=FALSE, weight=TRUE, ...) 
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "valuation.portfolBurSt 004"

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

	prices <- drop(prices)
	storage.mode(prices) <- "numeric"

	if(trade) {
		assets <- x$trade
	} else {
		assets <- x$new.portfolio
	}
	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
}

#line 1 "E:/incoming/PortfolioProbe/R/valuation.q"
"valuation" <-
function (x, ...) UseMethod("valuation")
#line 1 "E:/incoming/PortfolioProbe/R/valuation.randportBurSt.q"
"valuation.randportBurSt" <-
function (x, prices, weight=FALSE, collapse=FALSE, type="gross", cash=NULL)
{
        fun.copyright <- "Copyright 2003-2009  Burns Statistics Ltd.  All rights reserved."
	fun.version <- "valuation.randportBurSt 004"

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

	if(is.data.frame(prices)) prices <- as.matrix(prices)
	if(is.matrix(prices)) {
		pnams <- dimnames(prices)[[2]]
		ismat <- TRUE
		nrp <- dim(prices)[1]
	} else {
		pnams <- names(prices)
		ismat <- FALSE
	}

	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(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(ismat) {
		ans <- array(0, c(nrow(prices), length(x)), 
			list(dimnames(prices)[[1]], NULL))
	} 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(ismat) {
			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 {
			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(ismat) {
			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.gross <- FALSE
				} else if(is.null(cash)) {
					cash.is.gross <- 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.gross) {
						cash <- sum(abs(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 {
			# 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.gross <- FALSE
				} else if(is.null(cash)) {
					cash.is.gross <- 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.gross) {
						cash <- sum(abs(t.x) *
							prices[names(t.x)])
					}
					ans[i] <- sum(t.x * 
						prices[names(t.x)]) + cash
				}
			  }
			)
		}
	}
	x <- ans
	ansat <- attributes(ans)
     } else {
	# not collapse
	if(weight) {
		if(ismat) {
			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 {
		if(ismat) {
			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
}

#line 1 "E:/incoming/PortfolioProbe/R/zzz.R"
.First.lib <- function(lib, pkg) {
	#library.dynam("ezlic20", local=FALSE, pkg, lib)
	library.dynam("pop_BurSt", pkg, lib)
}
