"pp.TTR.multmacd" <-
function (x, ...) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2012"
	fun.version <- "pp.TTR.multmacd 002"

	#testing status: not formally tested, used a bit

	require(TTR)
	ans <- x
	ans[] <- NA
	for(i in seq(length=ncol(x))) {
		ans[,i] <- MACD(x[,i], ...)[, "signal"]
	}
	attr(ans, "call") <- match.call()
	ans
}

"pp.TTR.multsymbol" <-
function(symbols, start, end, item="Close", adjust=TRUE, verbose=TRUE)
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2012"
	fun.version <- "pp.TTR.multsymbol 002"

	# testing status: not formally tested, used a bit

	if(!length(symbols) || !is.character(symbols)) {
		stop("'symbols' needs to be a non-empty vector of characters")
	}
	require(TTR)
	init <- getYahooData(symbols[1], start=start, end=end, quiet=TRUE,
		adjust=adjust)
	if(length(symbols) == 1) {
		ans <- xts(coredata(init)[, item], order.by=index(init))
		attr(ans, "call") <- match.call()
		return(ans)
	}
	nobs <- nrow(coredata(init))
	if(nobs == 0) {
		stop(paste("first symbol(", symbols[1], ") failed", sep=""))
	}
	ans <- array(NA, c(nobs, length(symbols)), list(NULL, symbols))
	ans[,1] <- coredata(init)[, "Close"]
	if(verbose) {
		 cat("done with:", symbols[1], " ")
		count <- 2
	}
	fail <- rep(FALSE, length(symbols))
	names(fail) <- symbols
	for(i in symbols[-1]) {
		this.c <- coredata(getYahooData(i, start=start, end=end, 
			quiet=TRUE, adjust=adjust))[, item]
		if(length(this.c) == nobs) {
			ans[, i] <- this.c
		} else {
			fail[i] <- TRUE
			# a careful implementation would put data in right spot
		}
		if(verbose) {
			count <- count + 1
			if(count %% 10 == 0) cat("\n")
			cat(i, " ")
		}
	}
	if(verbose) cat("\n")
	if(any(fail)) {
		warning(paste(sum(fail), 
			"symbols did not have the right number",
			"of observations (same as the first symbol) -- the",
			"errant symbols are:",
			paste(symbols[fail], collapse=", ")))
	}
	ans <- xts(ans, order.by=index(init))
	attr(ans, "call") <- match.call()
	ans
}

"pp.cacheVar" <-
function(cache, times, retmat, lookback=250, offset=0, prefix="var", 
	FUN=var.shrink.eqcor, verbose=TRUE, ...) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2012"
	fun.version <- "pp.cacheVar 002"
	
	# testing status: not formally tested

	if(!length(rownames(retmat))) {
		stop(paste("no rownames for 'retmat' -- perhaps you need",
			"to coerce to a matrix"))
	}
	rnm <- match(times, rownames(retmat), nomatch=NA)
	if(any(is.na(rnm))) {
		stop(paste(sum(is.na(rnm)), "date(s) not in the row names",
			"of 'retmat'"))
	}
	stopifnot(is.character(cache), length(cache) == 1, 
		is.numeric(lookback), length(lookback) == 1, 
		is.numeric(offset), length(offset) == 1)
	if(any(rnm < lookback + offset)) {
		stop(paste(sum(rnm < lookback + offset), "elements of",
			"'times' are too early for 'lookback' and 'offset'"))
	}
	if(is.character(FUN)) FUN <- get(FUN)
	if(!is.function(FUN)) stop("'FUN' is not a function")
	dseq <- seq(to=0, length=lookback)
	for(i in seq(along=times)) {
		id <- times[i]
		tnam <- paste(prefix, id, sep="")
		path <- paste(cache, "/", tnam, ".rda", sep="")
		tret <- retmat[dseq + rnm[i] - offset, , drop=FALSE]
		assign(tnam, FUN(tret, ...))
		save(list=tnam, file=path)
		rm(list=tnam)
		if(verbose) cat("Done with", i, "out of", length(times), "\n")
	}
	invisible()
}

"pp.date.meanvarutil" <-
function (dates, ahead, risk.aversion, pricemat, alphamat=NULL, vardir=NULL,
	varprefix="var", varconstraint=NULL, number.rand=200, 
	volatility.utility=FALSE, ...) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2012"
	fun.version <- "pp.date.meanvarutil 002"

	# testing status: not formally tested

	stopifnot(is.numeric(ahead), length(ahead) == 1, ahead >= 1, 
		is.numeric(risk.aversion), length(risk.aversion) == 1,
		is.numeric(number.rand), length(number.rand) == 1,
		is.character(dates), is.numeric(pricemat), 
		is.character(varprefix), length(varprefix) == 1)
	pdn <- match(dates, rownames(pricemat), nomatch=NA)
	if(any(is.na(pdn))) {
		stop(paste(sum(is.na(pdn)), "element(s) of 'dates' not",
			"found in row names of 'pricemat'"))
	}
	if(length(alphamat)) {
		adn <- match(dates, rownames(alphamat), nomatch=NA)
		if(any(is.na(adn))) {
			stop(paste(sum(is.na(adn)), "element(s) of 'dates' not",
				"found in row names of 'alphamat'"))
		}
		do.alpha <- TRUE
	} else {
		do.alpha <- FALSE
	}
	if(length(vardir)) {
		do.var <- TRUE
	} else {
		do.var <- FALSE
	}
	if(length(varconstraint)) {
		if(length(varconstraint) != length(dates)) {
			stop(paste("'varconstraints', when given, needs",
				"to be the same length as 'dates'"))
		}
		do.varcon <- TRUE
	} else {
		do.varcon <- FALSE
	}
	ans <- array(NA, c(length(dates), number.rand), list(dates, NULL))
	aseq <- seq(from=1, length=ahead)
	pnam <- dimnames(pricemat)[[1]]
	talpha <- this.varcon <- NULL
	for(i in seq(along=dates)) {
		this.date <- dates[i]
		if(do.alpha) {
			talpha <- alphamat[this.date,]
		}
		if(do.var) {
			this.varcon <- varconstraint[i]
		}
		if(do.var) {
			vnam <- paste(varprefix, this.date, sep="")
			attach(paste(vardir, "/", vnam, ".rda", sep=""))
			this.rand <- random.portfolio(number.rand=number.rand,
				price=pricemat[this.date,], variance=get(vnam),
				expected.return=talpha, 
				var.constraint=this.varcon, ...)
			detach()
		} else {
			this.rand <- random.portfolio(number.rand=number.rand,
				price=pricemat[this.date,], 
				expected.return=talpha, 
				var.constraint=this.varcon, ...)
		}
		ploc <- match(this.date, pnam)
		val <- valuation(this.rand, price=pricemat[ploc + aseq,],
			collapse=TRUE)
		if(volatility.utility) {
			ans[i,] <- pp.meanvolutil(val, risk.aversion)
		} else {
			ans[i,] <- pp.meanvarutil(val, risk.aversion)
		}
	}
	attr(ans, "call") <- match.call()
	ans
}

"pp.date.minvar" <-
function (dates, pricemat, vardir="Varshr", varprefix="varshr.", ...) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2011"
	fun.version <- "pp.date.minvar 001"

	# testing status: not formally tested

	ans <- rep(NA, length(dates))
	names(ans) <- dates
	for(i in seq(along=dates)) {
		this.date <- dates[i]
		vnam <- paste(varprefix, this.date, sep="")
		attach(paste(vardir, "/", vnam, ".rda", sep=""))
		this.opt <- trade.optimizer( price=pricemat[this.date,], 
			variance=get(vnam), utility="minimum var", ...)
		detach()
		ans[i] <- this.opt$var.values
	}
	ans
}

"pp.date.var.meanvarutil" <-
function (dates, varcon, ahead, risk.aversion, pricemat, alphamat, 
	vardir="Varshr", varprefix="varshr.", number.rand=200, ...) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2011"
	fun.version <- "pp.date.var.meanvarutil 001"

	# testing status: not formally tested

	if(length(varcon) != length(dates)) {
		stop("'varcon' must have the same length as 'dates'")
	}
	if(length(ahead) != 1 || ahead < 1) {
		stop("'ahead' must be a single positive number")
	}
	if(length(risk.aversion) != 1) {
		stop("'risk.aversion' must be a single number")
	}
	ans <- array(NA, c(length(dates), number.rand), list(dates, NULL))
	aseq <- seq(from=1, length=ahead)
	pnam <- dimnames(pricemat)[[1]]
	for(i in seq(along=dates)) {
		this.date <- dates[i]
		vnam <- paste(varprefix, this.date, sep="")
		attach(paste(vardir, "/", vnam, ".rda", sep=""))
		this.rand <- random.portfolio(number.rand=number.rand,
			price=pricemat[this.date,], variance=get(vnam),
			expected.return=alphamat[this.date,], 
			var.constraint=as.vector(varcon[i]), ...)
		detach()
		ploc <- match(this.date, pnam)
		val <- valuation(this.rand, price=pricemat[ploc + aseq,],
			collapse=TRUE)
		ans[i,] <- pp.meanvarutil(val, risk.aversion)
	}
	ans
}

"pp.evalstrat" <-
function (number, init.ports, pricemat, alphamat, frac.turnover=Inf, 
	bottom.turnover=.9, max.weight=1, ..., verbose=TRUE)
{
	fun.copyright <- " placed in the public domain by Burns Statistics 2010-2013"
	fun.version <- "pp.evalstrat 002"

	# testing status: not formally tested

	if(length(max.weight) != 1 || length(names(max.weight))) {
		stop(paste("this function demands that 'max.weight' is",
			"the same for all assets"))
	}

	if(inherits(pricemat, "zoo")) pricemat <- as.matrix(pricemat)
	if(inherits(alphamat, "zoo")) alphamat <- as.matrix(alphamat)

	ctime <- intersect(dimnames(pricemat)[[1]], dimnames(alphamat)[[1]])

	if(!length(ctime)) {
		stop("no common times for 'pricemat' and 'alphamat'")
	}
	cassets <- intersect(dimnames(pricemat)[[2]], dimnames(alphamat)[[2]])
	if(!length(cassets)) {
		stop("no common assets for 'pricemat' and 'alphamat'")
	}
	pricemat <- pricemat[ctime, cassets]
	alphamat <- alphamat[ctime, cassets]
	ntime <- nrow(pricemat)

	ptile <- array(NA, c(ntime, length(init.ports)), 
		list(dimnames(pricemat)[[1]], NULL))
	optreturn <- outperf <- ptile
	for(i in seq(along=init.ports)) {
		this.opt <- pp.serial.opt(init.ports[[i]], pricemat,
			alphamat, frac.turnover=frac.turnover,
			max.weight=max.weight, ..., verbose=verbose-1)
		if(verbose) cat("done with opt number", i, date(), "\n")
		this.rand <- pp.serial.rand(number, init.ports[i], pricemat,
			alphamat, frac.turnover=frac.turnover,
			bottom.turnover=bottom.turnover,
			max.weight=max.weight, ..., verbose=verbose-1)
		if(verbose) cat("done with rand number", i, date(), "\n")
		optret <- this.opt$value / this.opt$value[1] - 1
		randret <- this.rand$value / rep(this.rand$value[1,], 
			each=ntime) - 1
		ptile[,i] <- round(100 * rowMeans(randret > optret))
		outperf[, i] <- optret - rowMeans(randret)
		optreturn[,i] <- optret
	}

	ans <- list(percentile=ptile, outperform=outperf, optreturn=optreturn,
		call=match.call(), timestamp=date())
	ans
}

"pp.meanvarutil" <-
function (vals, risk.aversion) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2012"
	fun.version <- "pp.meanvarutil 002"

	# testing status: not formally tested

	nrv <- nrow(vals)
	if(!length(nrv)) stop("bad value for 'vals'")
	mret <- pp.simpret(vals[c(1, nrv),, drop=FALSE]) / nrv
	mvar <- sd(diff(log(vals)))^2
	ans <- mret - risk.aversion * mvar
	ans
}

"pp.meanvolutil" <-
function (vals, risk.aversion) 
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2011"
	fun.version <- "pp.meanvolutil 001"

	# testing status: not formally tested

	nrv <- nrow(vals)
	if(!length(nrv)) stop("bad value for 'vals'")
	mret <- pp.simpret(vals[c(1, nrv),, drop=FALSE]) / nrv
	mvol <- sd(diff(log(vals)))
	ans <- mret - risk.aversion * mvol
	ans
}

"pp.mult.meanvarutil" <-
function (rp, pricemat, start, end, risk.aversion, ...)
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2011"
	fun.version <- "pp.mult.meanvarutil 001"

	# testing status: not formally tested

	nstart <- length(start)
	if(nstart != length(end)) {
		stop("'start' and 'end' must have the same length")
	}
	if(length(risk.aversion) != 1) {
		stop("'risk.aversion' should be a single number")
	}
	ans <- array(NA, c(nstart, length(rp)))
	for(i in 1:nstart) {
		val <- valuation(rp, pricemat[start[i]:end[i], , drop=FALSE],
			collapse=TRUE, ...)
		ans[i,] <- pp.meanvarutil(val, risk.aversion)
	}
	ans
}

"pp.optim.sequence" <-
function (init.port, pricemat, alphamat, frac.turnover=Inf, keep.port=FALSE,
	max.weight=1, ..., verbose=TRUE)
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2013"
        fun.version <- "pp.optim.sequence 001"

        #test status: not formally tested

	if(length(max.weight) != 1 || length(names(max.weight))) {
		stop(paste("this function demands that 'max.weight' is",
			"the same for all assets"))
	}

	if(inherits(pricemat, "zoo")) pricemat <- as.matrix(pricemat)
	if(inherits(alphamat, "zoo")) alphamat <- as.matrix(alphamat)

	ctime <- intersect(dimnames(pricemat)[[1]], dimnames(alphamat)[[1]])

	if(!length(ctime)) {
		stop("no common times for 'pricemat' and 'alphamat'")
	}
	cassets <- intersect(dimnames(pricemat)[[2]], dimnames(alphamat)[[2]])
	if(!length(cassets)) {
		stop("no common assets for 'pricemat' and 'alphamat'")
	}
	pricemat <- pricemat[ctime, cassets]
	alphamat <- alphamat[ctime, cassets]
	value <- numeric(length(ctime))
	names(value) <- ctime
	weightviol <- tradevalue <- value
	if(keep.port) {
		portlist <- vector("list", length(ctime))
		names(portlist) <- ctime
	}
	for(i in 1:length(ctime)) {
		fullval <- valuation(init.port, pricemat[i,])
		value[i] <- fullval$total["gross"]
		weightout <- sum(pmax(0, fullval$weight - max.weight))
		weightviol[i] <- weightout
		if(verbose) {
			cat(date(), "starting", i, "of", length(ctime),
				"times, value is", value[i], "weightout is",
				round(weightout, 4), "port size is",
				if(is.list(init.port)) length(
				init.port$new.portfolio) else length(init.port),
				"\n")
		}
		if(weightout >= frac.turnover) {
			this.turnover <- value[i] * (0.1 * frac.turnover + 
				2 * weightout)
		} else {
			this.turnover <- value[i] * (frac.turnover + weightout)
		}
		# calculation of value in opt is more involved if not long-only
		cur.port <- trade.optimizer(pricemat[i,], existing=init.port,
			turnover=this.turnover, expected.return=alphamat[i,],
			long.only=TRUE, gross.value=value[i], 
			max.weight=max.weight, ...)
		if(verbose && length(cur.port$violated)) {
			cat("at time", i, "the violations are:",
				cur.port$violated, "\n")
		}
		if(any(cur.port$violated == "gross value")) {
			stop("gross value violation -- destroys return series")
		}
		tradevalue[i] <- valuation(cur.port, trade=TRUE)$total["gross"]
		if(keep.port) portlist[[i]] <- cur.port$new.portfolio
		init.port <- cur.port
	}
	ans <- list(value=value, tradevalue=tradevalue, weightviol=weightviol,
		portlist=if(keep.port) portlist, 
		call=match.call(), timestamp=date())
	ans
}

"pp.random.sequence" <-
function (number, init.port, pricemat, alphamat, frac.turnover=Inf, 
	bottom.turnover=.98, max.weight=1, ..., verbose=TRUE)
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2013"
	fun.version <- "pp.random.sequence 001"

	#test status: not formally tested

	if(length(max.weight) != 1 || length(names(max.weight))) {
		stop(paste("this function demands that 'max.weight' is",
			"the same for all assets"))
	}

	if(inherits(pricemat, "zoo")) pricemat <- as.matrix(pricemat)
	if(inherits(alphamat, "zoo")) alphamat <- as.matrix(alphamat)

	ctime <- intersect(dimnames(pricemat)[[1]], dimnames(alphamat)[[1]])

	if(!length(ctime)) {
		stop("no common times for 'pricemat' and 'alphamat'")
	}
	cassets <- intersect(dimnames(pricemat)[[2]], dimnames(alphamat)[[2]])
	if(!length(cassets)) {
		stop("no common assets for 'pricemat' and 'alphamat'")
	}
	pricemat <- pricemat[ctime, cassets]
	alphamat <- alphamat[ctime, cassets]
	if(inherits(init.port, "portfolBurSt")) {
		init.port <- list(init.port$new.portfolio)
	}
	if(!is.list(init.port) || length(init.port) != 1) {
		stop(paste("'init.port' must either be the result of",
			"'trade.optimizer' or a list of length one",
			"containing the initial portfolio"))
	}
	value <- array(NA, c(length(ctime), number), list(ctime, NULL))
	for(j in 1:number) {
	    this.init.port <- init.port
	    for(i in 1:length(ctime)) {
		fullval <- valuation(this.init.port[[1]], pricemat[i,])
		value[i, j] <- fullval$total["gross"]
		weightout <- sum(pmax(0, fullval$weight - max.weight))
		if(verbose > 1) {
			cat(date(), "starting", i, "of", length(ctime),
				"times, value is", value[i,j], "weightout is",
				round(weightout, 4), "port size is",
				length(this.init.port[[1]]), "\n")
		}
		if(weightout >= frac.turnover) {
			this.turnover <- value[i,j] * (0.1 * frac.turnover + 
				2 * weightout)
		} else {
			this.turnover <- value[i,j] * (frac.turnover + 
				weightout)
		}
		if(is.finite(this.turnover)) {
			this.turnover <- this.turnover * c(bottom.turnover, 1)
		}
		# calculation of value is more involved if not long-only
		cur.port <- random.portfolio(1, pricemat[i,], 
			existing=this.init.port[[1]],
			turnover=this.turnover, expected.return=alphamat[i,],
			long.only=TRUE, gross.value=value[i,j], 
			max.weight=max.weight, throw.error=FALSE, ...)
		if(!length(cur.port)) {
			if(verbose) cat("retrying for i =", i, "\n")
			for(k in 1:3) {
				this.turnover <- 1.5 * this.turnover
				cur.port <- random.portfolio(1, pricemat[i,], 
					existing=this.init.port[[1]],
					turnover=this.turnover, 
					expected.return=alphamat[i,],
					long.only=TRUE, 
					gross.value=value[i,j], 
					max.weight=max.weight, 
					throw.error=FALSE, ...)
				if(length(cur.port)) break
			}
			if(!length(cur.port)) {
				stop(paste("failed to find suitable random",
					 "trade at i =", i, " and j =", j))
			}
		}
		this.init.port <- cur.port
	    }
	    if(verbose) cat("done with run", j, "of", number, date(), "\n")
	}
	ans <- list(value=value, call=match.call(), timestamp=date())
	ans
}

"pp.smo.meanvarutil" <-
function (val, window, risk.aversion) 
{
	# placed in the public domain by Burns Statistics 2010-2011
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2011"
	fun.version <- "pp.smo.meanvarutil 001"

	# testing status: not formally tested

	if(length(window) != 1 || window < 1) {
		stop("'window' must be a single positive number")
	}
	if(length(risk.aversion) != 1) {
		stop("'risk.aversion' must be a single number")
	}
	nv <- nrow(val)
	if(!length(nv)) stop("bad input for 'val'")
	ans <- array(NA, c(nv - window + 1, ncol(val)))
	wseq <- seq(from=0, length=window)
	for(i in seq(length=nrow(ans))) {
		ans[i,] <- pp.meanvarutil(val[wseq+i,, drop=FALSE], 
			risk.aversion)
	}
	ans
}

"pp.smo.meanvolutil" <-
function (val, window, risk.aversion) 
{
	# placed in the public domain by Burns Statistics 2010-2011

	if(length(window) != 1 || window < 1) {
		stop("'window' must be a single positive number")
	}
	if(length(risk.aversion) != 1) {
		stop("'risk.aversion' must be a single number")
	}
	nv <- nrow(val)
	if(!length(nv)) stop("bad input for 'val'")
	ans <- array(NA, c(nv - window + 1, ncol(val)))
	wseq <- seq(from=0, length=window)
	for(i in seq(length=nrow(ans))) {
		ans[i,] <- pp.meanvolutil(val[wseq+i,, drop=FALSE], 
			risk.aversion)
	}
	ans
}

"pputil.fourmoments" <-
function (rp, scenarios, parameters, level=NULL, verbose=FALSE) 
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pputil.fourmoments 001"

	# testing status: in test suite, mildly tested

	sfun.4m <- function(x) {
		if(any(is.na(x))) return(-Inf)
		m <- sum(x)/length(x)
		s <- sd(x)
		xstan <- (x - m) / s
		sk <- mean(xstan^3)
		ku <- mean(xstan^4)
		m + sum(c(s * s, sk, ku) * parameters)
	}

	if(length(parameters) != 3 || !is.numeric(parameters)) {
		stop("'parameters' should be numeric of length 3")
	}
	rets <- valuation(rp, prices=scenarios, returns="log")
	utils <- apply(rets, 2:3, sfun.4m)
	if(length(level)) {
		fmu <- apply(utils, 1, quantile, probs=level)
	} else {
		fmu <- rowMeans(utils)
	}
	if(verbose) print(summary(fmu, digits=7))
	fmu
}

"pputil.meanvar" <-
function (rp, scenarios, risk.aversion=1, level=NULL, verbose=FALSE) 
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pputil.meanvar 001"

	# testing status: in test suite, mildly tested

	rets <- valuation(rp, prices=scenarios, returns="log")
	means <- colMeans(rets)
	vars <- apply(rets, 2:3, var)
	mvuall <- means - risk.aversion * vars
	if(length(level)) {
		mvu <- apply(mvuall, 1, quantile, probs=level)
	} else {
		mvu <- rowMeans(mvuall)
	}
	if(verbose) print(summary(mvu, digits=7))
	mvu
}

"pputil.multomega" <-
function (rp, scenarios, target, weights, simple=FALSE, verbose=FALSE)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
	fun.version <- "pputil.multomega 001"

	# testing status: in test suite, mildly tested

	sfun.omega <- function(x) {
		x[is.na(x)] <- -Inf
		num <- den <- x - target
		num[num < 0] <- 0
		den[den > 0] <- 0
		-sum(num)/sum(den)
	}
	if(dim(scenarios)[1] != length(weights) + 1) {
		stop(paste("expecting exactly", length(weights) + 1,
			"time points (one more than length of 'weights')",
			"in 'scenarios'"))
	}
	if(length(target) != 1) stop("'target' must be a single number")

	if(simple) {
		rets <- valuation(rp, prices=scenarios, returns="simple")
	} else {
		rets <- valuation(rp, prices=scenarios, returns="log")
	}
	ans <- drop(weights %*% apply(rets, 1:2, sfun.omega))

	if(verbose) print(summary(ans, digits=7))
	ans
}

"pputil.omega" <-
function (rp, scenarios, target, simple=FALSE, verbose=FALSE)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
	fun.version <- "pputil.omega 001"

	#testing status: in test suite, mildly tested

	sfun.omega <- function(x) {
		x[is.na(x)] <- -Inf
		num <- den <- x - target
		num[num < 0] <- 0
		den[den > 0] <- 0
		-sum(num)/sum(den)
	}
	if(dim(scenarios)[1] != 2) {
		stop("expecting exactly 2 time points in 'scenarios'")
	}
	if(length(target) != 1) stop("'target' must be a single number")

	if(simple) {
		rets <- valuation(rp, prices=scenarios, returns="simple")
	} else {
		rets <- valuation(rp, prices=scenarios, returns="log")
	}
	ans <- apply(rets, 2, sfun.omega)

	if(verbose) print(summary(ans, digits=7))
	ans
}

"pputil.value" <-
function (rp, scenarios, level=NULL, verbose=FALSE)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pputil.value 001"

	# testing status: in test suite, mildly tested

	if(dim(scenarios)[1] != 1) stop("expecting only one time point")
	val <- valuation(rp, prices=scenarios)
	if(length(level)) {
		ans <- apply(val, 2, quantile, probs=level)
	} else {
		ans <- drop(rowMeans(val, dims=2))
	}
	if(verbose) print(summary(ans, digits=7))
	ans
}

"pputil.valueWt" <-
function (rp, scenarios, sweights, level=NULL, verbose=FALSE)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pputil.valueWt 001"

	# testing status: in test suite, mildly tested

	sfun.wtquantile <- function(x, probs) {
		xo <- order(x)
		so <- cumsum(sweights[xo]) /sum(sweights)
		wh <- sum(so < probs) + 1
		if(wh > nscen) wh <- nscen
		x[xo][wh]
	}
	sfun.wtmean <- function(x) {
		sum(sweights * x) / sum(sweights)
	}

	if(dim(scenarios)[1] != 1) stop("expecting only one time point")
	nscen <- dim(scenarios)[3]
	if(length(sweights) != nscen) {
		stop(paste("length of 'sweights' (", length(sweights),
			") not equal to number of scenarios (",
			nscen, ")", sep=""))
	}

	val <- valuation(rp, prices=scenarios)
	if(length(level)) {
		ans <- apply(val, 2, sfun.wtquantile, probs=level)
	} else {
		ans <- apply(val, 2, sfun.wtmean)
	}
	if(verbose) print(summary(ans, digits=7))
	ans
}

"scenario.optimizer" <-
function (scenarios, utility, prices=NULL, existing=NULL, regulate=NULL, 
	extraArgs=NULL, maximize=TRUE, verbose=TRUE, start.sol=NULL, 
	checkPositive=TRUE, ...) 
{
	fun.copyright <- "Placed in the public domain 2013 by Burns Statistic"
	fun.version <- "scenario.optimizer 001"

	# testing status: in test suite, mildly tested

	# require(PortfolioProbe)
	starttime <- date()

	checkDist <- pmatch(names(list(...)), "dist.center", nomatch=0)
	if(any(checkDist > 0)) {
		stop("optimizations with distances not yet implemented")
	}
	sdim <- dim(scenarios)
	sdimlen <- length(sdim)
	if(sdimlen < 2 || sdimlen > 3) {
		stop("'scenario' must be a matrix or 3D array")
	}
	if(sdimlen == 2) {
		scenarios <- array(scenarios, c(1, sdim), c(list(NULL), 
			dimnames(scenarios)))
		sdim <- c(1, sdim)
	}
	scennam <- dimnames(scenarios)[[2]]
	if(!length(scennam)) {
		stop("need asset names in 'scenarios'")
	}
	if(any(is.na(scennam) | nchar(scennam) == 0)) {
		stop("asset names in 'scenarios' are invalid: ",
			sum(is.na(scennam)), " missing values and ",
			sum(nchar(scennam) == 0, na.rm=TRUE), 
			" are the empty string")
	}
	if(checkPositive) {
		if(any(is.na(scenarios)) || any(scenarios <= 0)) {
			stop(paste("missing values and/or non-positive",
				"values in 'scenarios'"))
		}
	}
	if(!length(prices)) {
		prices <- scenarios[1,,1]
	} else if(checkPositive) {
		if(any(is.na(prices)) || any(prices <= 0)) {
			stop(paste("missing values and/or non-positive",
				"values in 'prices'"))
		}
	}
	if(!is.numeric(prices) || !length(names(prices))) {
		stop("'prices' must be a named numeric vector -- ",
			"given has mode ", mode(prices), " and length ",
			length(prices))
	}
	assetnam <- names(prices)
	if(any(is.na(assetnam) | nchar(assetnam) == 0)) {
		stop("asset names in 'prices' are invalid: ",
			sum(is.na(assetnam)), " missing values and ",
			sum(nchar(assetnam) == 0, na.rm=TRUE), 
			" are the empty string")
	}
	if(any(!(assetnam %in% scennam))) {
		stop(sum(!(assetnam %in% scennam)), " asset names in 'prices'",
			" not in 'scenarios' (or in the proper location ",
			"therein)")
	}
	scenarios <- scenarios[, assetnam, , drop=FALSE]
	if(length(existing)) {
		if(!is.numeric(existing) || !length(names(existing))) {
			stop("'existing' must be a named numeric vector -- ",
				"given has mode ", mode(existing), 
				" and length ", length(existing))
		}
		existnam <- names(existing)
		if(any(is.na(existnam) | nchar(existnam) == 0)) {
			stop("asset names in 'existing' are invalid: ",
				sum(is.na(existnam)), " missing values and ",
				sum(nchar(existnam) == 0, na.rm=TRUE), 
				" are the empty string")
		}
		if(any(!(existnam %in% assetnam))) {
			stop(sum(!(existnam %in% assetnam)), 
				" asset names in 'existing' not in ",
				"'scenarios'")
		}
	}
	if(length(extraArgs) && !is.list(extraArgs)) {
		stop("'extraArgs' must be a list if it is given")
	}
	regulateUse <- c(initbitesize=2000, nbites=20, bitesize=500, 
		radius=.1, reduce=.5, minradius=.001, returnstart=FALSE)
	regulateNam <- names(regulateUse)
	if(length(regulate)) {
		if(is.logical(regulate)) mode(regulate) <- "numeric"
		if(!is.numeric(regulate) || !length(names(regulate))) {
			stop("'regulate' must be a named numeric vector -- ",
				"given has mode ", mode(regulate), 
				" and length ", length(regulate))
		}
		regNum <- pmatch(names(regulate), regulateNam, nomatch=0)
		if(any(regNum == 0)) {
			stop("unknown or ambiguous name given in 'regulate' ",
				"-- valid names are: ",
				paste(regulateNam, collapse=", "))
		}
		regulateUse[regNum] <- regulate
	}

	# start of actual optimization

	if(length(start.sol)) {
		if(is.list(start.sol) && length(start.sol$trade)) {
			start.sol <- start.sol$trade
		}
		ssp <- trade.optimizer(prices=prices, existing=existing, 
			..., start.sol=start.sol, funev=0, 
			dist.center=start.sol, dist.style="shares",
			utility="distance", do.warn=c(dist.style=FALSE))
		if(ssp$results["penalty"] != 0) {
			warning(paste("'start.sol' apparently does not",
				"satisfy the constraints",
				"-- violations are:", 
				paste(ssp$violated, collapse=", ")))
		}
	}
	if(regulateUse["returnstart"]) {
		if(!length(start.sol)) {
			stop(paste("'returnstart' in 'regulate' is TRUE but",
				"'start.sol' is not given"))
		}
		randp <- random.portfolio(number.rand=1,
			prices=prices, existing=existing, ..., out.trade=FALSE)
		randp[[1]] <- pp.getPortfolio(existing, start.sol)
		util <- do.call("utility", c(list(randp, scenarios=scenarios), 
			extraArgs))
		optim <- c(iterations.done=0, radius.final=NA)
		ans <- list(new.portfolio=pp.getPortfolio(existing, start.sol),
			trade=start.sol, existing=existing, 
			utility.value=util[[1]], optim=optim,
			violated=ssp$violated,
			timestamp=c(starttime, date()), call=match.call())
		return(ans)
	}
	randp <- random.portfolio(number.rand=regulateUse["initbitesize"], 
		prices=prices, existing=existing, ..., out.trade=FALSE)
	if(length(start.sol)) {
		if(ssp$results["penalty"] == 0) {
			randp[[1]] <- ssp$new.portfolio
		} 
	}
	util <- do.call("utility", c(list(randp, scenarios=scenarios), 
		extraArgs))
	if(maximize) {
		wu <- tail(order(util), 1)
	} else {
		wu <- head(order(util), 1)
	}
	current <- randp[[wu]]
	utilval <- util[wu]

	if(verbose) {
		cat("bite 0 utility value is", utilval, date(), "\n")
	}

	number.rand <- regulateUse["bitesize"]
	radius <- regulateUse["radius"]
	for(bite in seq(length=regulateUse["nbites"])) {
		curwt <- valuation(current, prices=prices, weight=TRUE)$weight
		randp <- random.portfolio(number.rand=number.rand, 
			prices=prices, existing=existing, dist.center=curwt,
			dist.style="weight", dist.bounds=radius, 
			dist.trade=FALSE, ...)
		util <- do.call("utility", c(list(randp, scenarios=scenarios), 
			extraArgs))
		if(maximize) {
			wu <- tail(order(util), 1)
		} else {
			wu <- head(order(util), 1)
		}
		newutil <- util[wu]
		if(maximize) {
			if(newutil > utilval) {
				utilval <- newutil
				current <- randp[[wu]]
			} else {
				radius <- radius * regulateUse["reduce"]
				if(radius < regulateUse["minradius"]) break
			}
		} else {
			if(newutil < utilval) {
				utilval <- newutil
				current <- randp[[wu]]
			} else {
				radius <- radius * regulateUse["reduce"]
				if(radius < regulateUse["minradius"]) break
			}
		}
		if(verbose) {
			cat("bite", bite, "utility value is", utilval, 
				"radius", radius, date(), "\n")
		}
	}
	optim <- c(iterations.done=bite, radius.final=unname(radius))
	ans <- list(new.portfolio=current, trade=pp.getTrade(current, existing),
		existing=existing, utility.value=utilval, optim=optim,
		timestamp=c(starttime, date()), call=match.call())
	ans
}

"pp.historyScenarios" <-
function (history, template, number=NULL, which=NULL, prices=NULL,
	replace=TRUE)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pp.historyScenarios 001"

	# testing status: in test suite, mildly tested

	if(any(is.na(history)) || any(history <= 0)) {
		stop(paste("'history' expected to be a matrix of prices",
			"-- that is, positive with no missing values"))
	}
	if(!length(dimnames(history)[[2]])) {
		stop("'history' needs asset (column) names")
	}
	if(length(number) && length(which)) {
		stop("only one of 'number' and 'which' may be given")
	}
	dh <- dim(history)
	if(length(prices)) {
		pricenam <- names(prices)
		if(length(setdiff(dimnames(history)[[2]], pricenam))) {
			out <- setdiff(dimnames(history)[[2]], pricenam)
			if(length(out) > 6) {
				stop(paste(length(out), "assets in 'prices'",
				  "not in 'history', first few are:", 
				  paste(head(out, 5), collapse=", ")))
			} else {
				stop(paste(length(out), "assets in 'prices'",
				  "not in 'history':", 
				  paste(out, collapse=", ")))
			}
		}
		history <- history[, pricenam, drop=FALSE]
	} else {
		prices <- history[dh[1], , drop=TRUE]
		pricenam <- names(prices)
	}
	if(!is.numeric(template) || length(template) <= 1 || 
			any(template < 0)){
		stop(paste("'template' should be a numeric vector with",
			"at least 2 elements that are all non-negative",
			"-- given has mode", mode(template), "length",
			length(template), "and minimum value", min(template)))
	}
	if(is.unsorted(template)) {
		warning("'template' is not always increasing")
	}

	tmax <- max(template)
	wlimit <- dh[1] - tmax
	if(length(which)) {
		if(any(which > wlimit)) {
			warning(paste(sum(which > wlimit), "values in",
				"'which' are too large -- being removed"))
			which <- which[which <= wlimit]
		}
		if(any(which < 1)) {
			warning(paste(sum(which < 1), "values in",
				"'which' are too small -- being removed"))
			which <- which[which >= 1]
		}
	} else {
		# generate 'number' random locations
		which <- sample(1:wlimit, number, replace=replace)
	}
	ans <- array(NA, c(length(template), length(prices), 
		length(which)), list(NULL, pricenam, NULL))
	for(i in seq(along=which)) {
		ans[,,i] <- history[which[i] + template,]
	}
	pp.priceScenarios(ans, prices)
}

"pp.normalScenarios" <-
function (prices, expected.return, variance, ntimes, nscenarios) 
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pp.normalScenarios 001"

        # testing status: in test suite, mildly tested

	require(MASS, quietly=TRUE)
	assetnams <- names(prices)
	if(!length(assetnams)) {
		stop("'prices' needs to have names to identify the assets")
	}
	if(length(names(expected.return))) {
		expected.return <- expected.return[assetnams]
	}
	if(length(dimnames(variance))) {
		variance <- variance[assetnams, assetnams]
	}
	if(any(is.na(prices)) || any(prices <= 0)) {
		stop(paste("'prices' must have no missing values and have",
			"postive values"))
	}
	if(any(is.na(expected.return)) || any(is.na(variance))) {
		stop(paste("missing values not allowed in 'expected.return'",
			"nor in 'variance'"))
	}
	ntimes <- round(ntimes)
	if(ntimes < 2) {
		stop("'ntimes' must be at least 2")
	}
	ans <- array(NA, c(ntimes, length(prices), nscenarios), 
		list(NULL, assetnams, NULL))
	for(i in seq(length=nscenarios)) {
		ret <- mvrnorm(ntimes, mu=expected.return,
			Sigma=variance)
		ret[1,] <- 0
		tpri <- exp(apply(ret, 2, cumsum)) * rep(prices, each=ntimes)
		ans[,,i] <- tpri
	}
	ans
}

"pp.priceScenarios" <-
function (scenarios, prices)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pp.priceScenario 001"

	# testing status: in test suite, mildly tested

	assetnam <- dimnames(scenarios)[[2]]
	out <- setdiff(assetnam, names(prices))
	if(length(out)) {
		stop(paste(length(out), "asset names in",
			"'scenarios' missing from 'prices'"))
	}
	prices <- prices[assetnam]

	if(length(dim(scenarios)) == 2) {
		scenarios * rep(prices / scenarios[1,], 
			each=dim(scenarios)[1])
	} else {
		ntimes <- dim(scenarios)[1]
		for(i in seq(length=dim(scenarios)[3])) {
			scenarios[,,i] <- scenarios[,,i] * rep(prices / 
				scenarios[1,, i], each=ntimes)
		}
		scenarios
	}
}

"pp.smallSelect" <-
function (prices, port.size, ..., sets=10, finalStringency=2)
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pp.smallSelect 001"

	# testing status: in test suite, mildly tested

	checkDist <- pmatch(names(list(...)), "lin.bounds", nomatch=0)
        if(any(checkDist > 0)) {
                stop("optimizations with linear constraints not implemented")
        }
	if(!is.numeric(sets) || length(sets) != 1) {
		stop(paste("'sets' must be a single number -- given has mode",
			mode(sets), "and length", length(sets)))
	}

	if(length(port.size) == 1) port.size <- c(port.size, port.size)
	init <- trade.optimizer(prices=prices, ..., port.size=port.size)
	assetnam <- names(prices)
	setcon <- array(FALSE, c(length(prices), sets), 
		list(assetnam, paste("set", 1:sets, sep="")))
	setcon[names(init$new.portfolio), 1] <- TRUE
	setbou <- rbind("set1 : TRUE"=c(-.5, port.size[2] - .5))
	for(i in 1:(sets-1)) {
		opt <- trade.optimizer(prices=prices, port.size=port.size, 
			lin.constraint=setcon[, 1:i, drop=FALSE],
			lin.bounds=setbou, lin.style="count", 
			do.warn=c(bounds.missing=FALSE, 
			infinite.bounds=FALSE), ...)
		setcon[names(opt$new.portfolio), i+1] <- TRUE
		setbou <- rbind(setbou, xxx=setbou[1,])
		rownames(setbou)[i+1] <- paste("set", i+1, " : TRUE", sep="")
	}
	best <- Inf
	setnames <- t(array(rep(assetnam, sets)[setcon], 
		c(port.size[1], sets)))
	for(i in 1:ncol(setcon)) {
		opt <- trade.optimizer(prices, port.size=port.size, 
			universe=setnames[i,], stringency=finalStringency, 
			...)
		if(opt$results["objective"] < best) {
			opans <- opt
			best <- opt$results["objective"]
		}
	}
	list(optimum=opans, sets=setnames, call=match.call())
}

"pp.simpret" <-
function (x)
{
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2013"
	fun.version <- "pp.simpret 003"

	# testing status: not formally tested

	dimx <- dim(x)
	if(dimx[1] != 2) stop("'x' must have exactly 2 rows")
	if(any(x <= 0, na.rm=TRUE)) {
		stop(paste(sum(x <= 0, na.rm=TRUE), 
			"non-positive value(s) in 'x'"))
	}
	x[2,] / x[1,] - 1
}

"pp.getPortfolio" <-
function (existing, trade) 
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pp.getPortfolio 001"

	# testing status: implicated in the test suite

	if(!length(existing)) return(trade)
	if(!length(trade)) return(existing)

	enam <- names(existing)
	tnam <- names(trade)
	nams <- unique(c(enam, tnam))
	ans <- rep(0, length(nams))
	names(ans) <- nams
	ans[enam] <- existing
	ans[tnam] <- ans[tnam] + trade
	ans[ans != 0]
}

"pp.getTrade" <-
function (new, old) 
{
	fun.copyright <- "placed in the public domain 2013 by Burns Statistics"
        fun.version <- "pp.getTrade 001"

	# testing status: implicated in the test suite

	if(!length(old)) return(new)
	if(!length(new)) return(-old)

	nnam <- names(new)
	onam <- names(old)
	com <- intersect(nnam, onam)
	nonly <- setdiff(nnam, onam)
	oonly <- setdiff(onam, nnam)
	ans <- c(-old[oonly], new[com] - old[com], new[nonly])
	ans[ans != 0]
}

"pp.realvol" <-
function (pricemat, annualize=100*sqrt(252)) 
{
	# placed in the public domain by Burns Statistics 2010-2011
	fun.copyright <- "placed in the public domain by Burns Statistics 2010-2011"
	fun.version <- "pp.realvol 001"

	# testing status: not formally tested, but it's kind of short

	annualize * sd(diff(log(pricemat)))
}