"pp.TTR.multmacd" <-
function (x, ...) 
{
	# placed in the public domain by Burns Statistics 2010-2011

	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)
{
	# placed in the public domain by Burns Statistics 2010-2011

	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 -- the errant symbols are:",
			paste(symbols[fail], collapse=", ")))
	}
	ans <- xts(ans, order.by=index(init))
	attr(ans, "call") <- match.call()
	ans
}

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

	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,], ...)
		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.date.minvar" <-
function (dates, pricemat, vardir="Varshr", varprefix="varshr.", ...) 
{
	# placed in the public domain by Burns Statistics 2010-2011

	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, ...) 
{
	# placed in the public domain by Burns Statistics 2010-2011

	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)
{
	# placed in the public domain by Burns Statistics 2010-2011

	if(length(max.weight) != 1 || length(names(max.weight))) {
		stop(paste("this function demands that 'max.weight' is",
			"the same for all assets"))
	}
	# the following line will be wrong for xts and zoo objects
	# one solution is to coerce to matrix with 'as.matrix'
	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) 
{
	# placed in the public domain by Burns Statistics 2010-2011

	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) 
{
	# placed in the public domain by Burns Statistics 2010-2011

	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, ...)
{
	# placed in the public domain by Burns Statistics 2010-2011

	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.realvol" <-
function (pricemat, annualize=100*sqrt(252)) 
{
	# placed in the public domain by Burns Statistics 2010-2011

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

"pp.serial.opt" <-
function (init.port, pricemat, alphamat, frac.turnover=Inf, keep.port=FALSE,
	max.weight=1, ..., verbose=TRUE)
{
	# placed in the public domain by Burns Statistics 2010-2011

	if(length(max.weight) != 1 || length(names(max.weight))) {
		stop(paste("this function demands that 'max.weight' is",
			"the same for all assets"))
	}
	# the following line will be wrong for xts and zoo objects
	# one solution is to coerce to matrix with 'as.matrix'
	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.serial.rand" <-
function (number, init.port, pricemat, alphamat, frac.turnover=Inf, 
	bottom.turnover=.9, max.weight=1, ..., verbose=TRUE)
{
	# placed in the public domain by Burns Statistics 2010-2011

	if(length(max.weight) != 1 || length(names(max.weight))) {
		stop(paste("this function demands that 'max.weight' is",
			"the same for all assets"))
	}
	# the following line will be wrong for xts and zoo objects
	# one solution is to coerce to matrix with 'as.matrix'
	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.simpret" <-
function (x) 
{
	# placed in the public domain by Burns Statistics 2010-2011

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

"pp.smo.meanvarutil" <-
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.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
}