pp.createplots <- function (univclose, nback=7) { fun.copyright <- "Placed in the public domain 2012-2013 by Burns Statistics" univclose <- as.matrix(univclose) lret <- diff(log(univclose)) days <- as.character(as.Date(julian(Sys.Date()) - nback:0)) rdays <- rownames(univclose) usedays <- intersect(days, rdays) # wdays <- match(usedays, rdays) if(!length(usedays)) stop("no days in the window") sret <- exp(lret) - 1 weekn <- (julian(as.Date(tail(days, 1))) - julian(as.Date(head(rdays, 1)))) %/% 7 + 1 year <- substring(usedays[1], 1, 4) curdir <- paste(year, "wk", weekn, sep="") dir.create(curdir) for(i in seq(along=usedays)) { png(file=paste(curdir, "/", usedays[i], ".png", sep=""), width=512) pp.marketdistrib(100 * drop(sret[ usedays[i], ]), main=usedays[i], xlab="Return (%)", ident=list(as.list(1:4), as.list(1:4))) dev.off() } png(file=paste(curdir, "/wk", weekn, ".png", sep=""), width=512) pp.marketdistrib(100 * (exp(colSums(lret[usedays,])) - 1), main=paste("Week of", usedays[1], "through", tail(usedays, 1)), xlab="Return (%)", ident=list(as.list(1:4), as.list(1:4))) dev.off() png(file=paste(curdir, "/ytdwk", weekn, ".png", sep=""), width=512) pp.marketdistrib(100 * (exp(colSums(lret, na.rm=TRUE)) - 1), main=paste(year, " year to date", tail(usedays, 1)), xlab="Return (%)", ident=list(as.list(1:4), as.list(1:4))) dev.off() } pp.marketdistrib <- function (asset.rets, index.ret = NULL, xlab = "Return", ident = c(0, 0), fill = TRUE, ppositive=TRUE, iqr=TRUE, clwd = 3, height.id = seq(.05, by=.05, 19), ...) { fun.copyright <- "Placed in the public domain 2012 by Burns Statistics" dar <- density(asset.rets) plot(dar, yaxt = "n", type = "n", xlab = xlab, ...) if (fill) { dxn <- dar$x < 0 dxp <- dar$x > 0 if (sum(dxn)) { polygon(c(dar$x[dxn], max(dar$x[dxn])), c(dar$y[dxn], 0), col = "red", border = NA) } if (sum(dxp)) { polygon(c(dar$x[dxp], min(dar$x[dxp])), c(dar$y[dxp], 0), col = "green2", border = NA) } } else { if (any(dar$x < 0)) { lines(dar$x[dar$x < 0], dar$y[dar$x < 0], lwd = clwd, col = "red") } if (any(dar$x > 0)) { lines(dar$x[dar$x > 0], dar$y[dar$x > 0], lwd = clwd, col = "green2") } } if (length(ident) && any(unlist(ident) > 0)) { anam <- names(asset.rets) if (!length(anam)) { anam <- names(drop(asset.rets)) } if (!length(anam)) { warning("no asset names for identification") } else { asort <- sort(asset.rets) ytraw <- par("usr")[4] if (is.list(ident)) { if (length(ident) != 2) { stop("'ident' must have length 2 when a list") } if (!is.list(ident[[1]])) ident[[1]] <- list(ident[[1]]) for (i in seq(along = ident[[1]])) { items <- ident[[1]][[i]] if(!length(items)) next if (!is.numeric(items)) { stop("bad value for 'ident' -- when a ", "list must have length 2 and each ", "component must be a list of ", "numeric vectors") } low <- asort[items] text(low, ytraw * height.id[i], names(low)) } if (!is.list(ident[[2]])) ident[[2]] <- list(ident[[2]]) nassets <- length(asort) for (i in seq(along = ident[[2]])) { items <- ident[[2]][[i]] if (!is.numeric(items)) { stop("bad value for 'ident' -- when a ", "list must have length 2 and each ", "component must be a list of ", "numeric vectors") } high <- asort[nassets + 1 - items] text(high, ytraw * height.id[i], names(high)) } } else { if (ident[1] > 0) { low <- head(asort, ident[1]) text(low, ytraw * height.id[1], names(low)) } if (ident[2] > 0) { high <- tail(asort, ident[2]) text(high, ytraw * height.id[1], names(high)) } } } } if (length(index.ret)) { abline(v = index.ret) } if(ppositive) { fpos <- mean(asset.rets > 0) fneg <- mean(asset.rets < 0) usr <- par("usr") xlocn <- usr[1] + .05 * (usr[2] - usr[1]) xlocp <- usr[1] + .95 * (usr[2] - usr[1]) yloc <- usr[3] + .95 * (usr[4] - usr[3]) text(xlocn, yloc, paste(round(100 * fneg), "%", sep=""), col="red") text(xlocp, yloc, paste(round(100 * fpos), "%", sep=""), col="green4") } if(iqr) { quar <- quantile(asset.rets, c(.25, .75)) axis(1, at=quar, labels=FALSE, tck=.02, col="gold", lwd=3) title(sub=paste("interquartile range: ", signif(diff(quar), 3), sep="")) } } pp.TTR.multsymbol <- function(symbols, start, end, item="Close", adjust=TRUE, verbose=TRUE) { fun.copyright <- "Placed in the public domain 2010-2012 by Burns Statistics" 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.updateuniv <- function (univclose, overlap=5, backup=FALSE) { fun.copyright <- "Placed in the public domain 2012-2013 by Burns Statistics" require(BurStMisc) today <- gsub("-", "", Sys.Date()) if(backup) { save(univclose, file=paste("univclose_", today, ".rda", sep="")) } start <- tail(index(univclose), overlap)[1] start <- substring(gsub("-", "", start), 1, 8) newclose <- pp.TTR.multsymbol(colnames(univclose), as.numeric(start), as.numeric(today)) cc <- intersect(colnames(univclose), colnames(newclose)) if(nrow(univclose) < overlap) overlap <- nrow(univclose) ocom <- tail(univclose[, cc], overlap) ncom <- head(newclose[, cc], overlap) if(any(abs(ocom - ncom) / ocom > 1e-6)) { dif <- apply(abs(ocom - ncom) / ocom, 2, max) outnam <- cc[dif > 1e-6] replace <- pp.TTR.multsymbol(outnam, as.numeric(gsub("-", "", index(univclose)[1])), as.numeric(today)) } else { outnam <- NULL } if(length(cc) < ncol(univclose)) { stop("new has fewer assets") } ans <- rbind(univclose, tail(newclose, -overlap)) if(length(outnam)) { ans[, outnam] <- replace warning("changes to: ", paste(outnam, collapse=", ")) } print(cbind(corner(ans, 'bl', n=c(7,4)), corner(ans, 'br', n=c(7,4)))) ans }