Permalink
Browse files

Add stockPortfolio package

  • Loading branch information...
1 parent 9f1941b commit 82134cee83f599bc9f1babfb581f9bbfbb48557f @OpenIntroOrg committed Mar 29, 2015
Showing with 1,973 additions and 1 deletion.
  1. +1 −1 README.md
  2. +11 −0 stockPortfolio/DESCRIPTION
  3. +24 −0 stockPortfolio/NAMESPACE
  4. +42 −0 stockPortfolio/R/adjustBeta.R
  5. +36 −0 stockPortfolio/R/getCorr.R
  6. +120 −0 stockPortfolio/R/getReturns.R
  7. +21 −0 stockPortfolio/R/lines.stockReturns.R
  8. +12 −0 stockPortfolio/R/lines.testPort.R
  9. +214 −0 stockPortfolio/R/optimalPort.R
  10. +5 −0 stockPortfolio/R/pairs.stockReturns.R
  11. +25 −0 stockPortfolio/R/plot.optimalPortfolio.R
  12. +36 −0 stockPortfolio/R/plot.portReturn.R
  13. +23 −0 stockPortfolio/R/plot.stockModel.R
  14. +36 −0 stockPortfolio/R/plot.stockReturns.R
  15. +12 −0 stockPortfolio/R/plot.testPort.R
  16. +9 −0 stockPortfolio/R/points.optimalPortfolio.R
  17. +25 −0 stockPortfolio/R/points.portReturn.R
  18. +15 −0 stockPortfolio/R/points.stockModel.R
  19. +12 −0 stockPortfolio/R/points.testPort.R
  20. +67 −0 stockPortfolio/R/portCloud.R
  21. +72 −0 stockPortfolio/R/portPossCurve.R
  22. +15 −0 stockPortfolio/R/portReturn.R
  23. +20 −0 stockPortfolio/R/print.optimalPortfolio.R
  24. +12 −0 stockPortfolio/R/print.portReturn.R
  25. +25 −0 stockPortfolio/R/print.stockModel.R
  26. +7 −0 stockPortfolio/R/print.stockReturns.R
  27. +11 −0 stockPortfolio/R/print.testPort.R
  28. +213 −0 stockPortfolio/R/stockModel.R
  29. +18 −0 stockPortfolio/R/summary.optimalPortfolio.R
  30. +6 −0 stockPortfolio/R/summary.portReturn.R
  31. +10 −0 stockPortfolio/R/summary.stockModel.R
  32. +12 −0 stockPortfolio/R/summary.stockReturns.R
  33. +5 −0 stockPortfolio/R/summary.testPort.R
  34. +58 −0 stockPortfolio/R/testPort.R
  35. +23 −0 stockPortfolio/README.md
  36. BIN stockPortfolio/data/stock04.rda
  37. BIN stockPortfolio/data/stock94.rda
  38. BIN stockPortfolio/data/stock94Info.rda
  39. BIN stockPortfolio/data/stock99.rda
  40. +55 −0 stockPortfolio/man/adjustBeta.Rd
  41. +28 −0 stockPortfolio/man/getCorr.Rd
  42. +44 −0 stockPortfolio/man/getReturns.Rd
  43. +91 −0 stockPortfolio/man/optimalPort.Rd
  44. +43 −0 stockPortfolio/man/portCloud.Rd
  45. +41 −0 stockPortfolio/man/portPossCurve.Rd
  46. +45 −0 stockPortfolio/man/portReturn.Rd
  47. +27 −0 stockPortfolio/man/stock04.Rd
  48. +27 −0 stockPortfolio/man/stock94.Rd
  49. +24 −0 stockPortfolio/man/stock94Info.Rd
  50. +27 −0 stockPortfolio/man/stock99.Rd
  51. +111 −0 stockPortfolio/man/stockModel.Rd
  52. +85 −0 stockPortfolio/man/stockPortfolio-package.Rd
  53. +72 −0 stockPortfolio/man/testPort.Rd
View
@@ -16,7 +16,7 @@ This package was produced as part of the OpenIntro project. For the accompanying
To install the `OIsurv` package:
``` r
-# install.packages("OIsurv")
+# install.packages("devtools")
library(devtools)
install_github("OpenIntroOrg/openintro-r-package", subdir = "OIsurv")
```
@@ -0,0 +1,11 @@
+Package: stockPortfolio
+Type: Package
+Title: Build stock models and analyze stock portfolios.
+Version: 1.2
+Date: 2012-03-14
+Author: David Diez and Nicolas Christou
+Maintainer: David Diez <david.m.diez@gmail.com>
+Description: Download stock data, build single index, constant correlation, and multigroup models, and estimate optimal stock portfolios. Plotting functions for the portfolio possibilities curve and portfolio cloud are included. A function to test a portfolio on a data set is also provided.
+License: GPL (>= 2)
+LazyLoad: yes
+Depends: stats, graphics, grDevices, utils
@@ -0,0 +1,24 @@
+export(adjustBeta, getCorr, getReturns, optimalPort, portCloud, portPossCurve, portReturn, stockModel, testPort)
+
+S3method(lines, stockReturns)
+S3method(lines, testPort)
+S3method(pairs, stockReturns)
+S3method(plot, optimalPortfolio)
+S3method(plot, portReturn)
+S3method(plot, stockModel)
+S3method(plot, stockReturns)
+S3method(plot, testPort)
+S3method(points, optimalPortfolio)
+S3method(points, portReturn)
+S3method(points, stockModel)
+S3method(points, testPort)
+S3method(print, optimalPortfolio)
+S3method(print, portReturn)
+S3method(print, stockModel)
+S3method(print, stockReturns)
+S3method(print, testPort)
+S3method(summary, optimalPortfolio)
+S3method(summary, portReturn)
+S3method(summary, stockModel)
+S3method(summary, stockReturns)
+S3method(summary, testPort)
@@ -0,0 +1,42 @@
+`adjustBeta` <-
+function(model, model2=NULL, method=c('Blume', 'Vasicek')){
+ if(method[1] %in% c('B', 'b', 'Blume', 'blume', '1')){
+ if(is.null(model2)){
+ stop('The model for the second period must be provided.')
+ } else if(any(c(model$model, model2$model) != 'SIM')){
+ stop('The models must be from the single index model.')
+ }
+ if(model2$betaAdj){
+ stop('This model has already been adjusted.')
+ }
+ x <- model$beta
+ y <- model2$beta
+ g <- lm(y ~ x)
+ df <- data.frame(x = model2$beta)
+ newBeta <- predict(g, df)
+ newModel <- model2
+ } else {
+ if(model$betaAdj){
+ stop('This model has already been adjusted.')
+ }
+ beta <- model$beta
+ mBeta <- mean(beta)
+ vBetas <- var(beta)
+ newBeta <- rep(NA, length(beta))
+ p <- (model$vBeta) / (vBetas + model$vBeta)
+ newBeta <- p*mBeta + (1-p)*beta
+ newModel <- model
+ }
+ R <- newModel$alpha + newModel$beta*newModel$RM
+ COV <- matrix(newModel$VM, length(R), length(R))
+ COV <- t(COV * newBeta) * newBeta
+ diag(COV) <- diag(COV) + newModel$MSE
+ newModel$R <- R
+ newModel$COV <- COV
+ newModel$sigma <- sqrt(diag(COV))
+ newModel$beta <- newBeta
+ newModel$vBeta <- newModel$vBeta*NA
+ newModel$betaAdj <- TRUE
+ return(newModel)
+}
+
@@ -0,0 +1,36 @@
+`getCorr` <-
+function(V, industry=NULL){
+ C <- t(V / sqrt(diag(V)))/sqrt(diag(V))
+ if(dim(V)[1] < length(industry)){
+ industry <- industry[1:dim(V)[1]]
+ }
+ if(is.null(industry)){
+ n <- dim(V)[1]
+ rho <- (sum(C) - n)/n/(n-1)
+ } else {
+ K <- length(unique(industry))
+ GP <- unique(industry)
+ rho <- matrix(NA,K,K)
+ n <- rep(NA,K)
+ ss <- list()
+ for(i in 1:K){
+ ss[[i]] <- which(industry == GP[i])
+ n[i] <- length(ss[[i]])
+ }
+ for(i in 1:K){
+ for(j in min(c(K,i+1)):K){
+ rho[i,j] <- mean(C[ss[[i]], ss[[j]]])
+ rho[j,i] <- rho[i,j]
+ }
+ if(n[i] > 1){
+ rho[i,i] <- (sum(C[ss[[i]],ss[[i]]])-n[i])/n[i]/(n[i]-1)
+ } else {
+ rho[i,i] <- 1
+ }
+ }
+ rownames(rho) <- GP
+ colnames(rho) <- GP
+ }
+ return(rho)
+}
+
@@ -0,0 +1,120 @@
+`getReturns` <-
+function(ticker, freq=c('month', 'week', 'day'),
+get=c('overlapOnly', 'all'),
+start='1970-01-01', end=NULL){
+
+ #______ Cleaning, Checking, and Initialization ______#
+ startURL <- 'http://ichart.finance.yahoo.com/table.csv?s='
+ URL <- list()
+ full <- list()
+ r <- list()
+ dates <- list()
+ ticker <- as.character(ticker)
+ n <- length(ticker)
+ start <- as.Date(start)
+ if(class(start) != "Date"){
+ stop('Cannot read the start date.\n')
+ }
+ start <- c(format(as.Date(start), "%m"),
+ format(as.Date(start), "%d"),
+ format(as.Date(start), "%Y"))
+ start <- as.numeric(start)
+ if(is.null(end)[1]){
+ end <- ''
+ } else {
+ end <- as.Date(end)
+ if(class(end) != "Date"){
+ stop('Cannot read the end date.\n')
+ }
+ end <- c(format(as.Date(end), "%m"),
+ format(as.Date(end), "%d"),
+ format(as.Date(end), "%Y"))
+ end <- as.numeric(end)
+ end <- paste('&d=',end[1]-1, '&e=',end[2], '&f=',end[3], sep='')
+ }
+
+ #______ Data Retrieval ______#
+ N <- rep(-1, n)
+ period <- freq[1]
+ freq <- substr(freq[1],1,1)
+ start <- paste('&a=',start[1]-1, '&b=',start[2], '&c=',start[3], sep='')
+ endURL <- paste(start, end, "&g=", freq, "&ignore=.csv", sep="")
+ minDate <- as.Date('2499-12-31')
+ for(i in 1:n){
+ URL <- paste(startURL, ticker[i], endURL, sep='')
+ d <- read.delim(URL, TRUE, sep=',')
+ full[[ticker[i]]] <- d
+ r[[i]] <- (d[-dim(d)[1],7] - d[-1,7]) / d[-1,7]
+ dates[[i]] <- as.Date(d[-dim(d)[1],1])
+ minDate <- min(c(minDate, d[,1]))
+ N[i] <- length(r[[i]])
+ }
+ uDates <- rev(sort(unique(c(dates, recursive=TRUE) - 1)))
+ R <- matrix(NA, length(uDates), n)
+ rownames(R) <- as.character(as.Date(uDates, origin=minDate))
+ for(i in 1:n){
+ inR <- match(as.character(dates[[i]]), rownames(R))
+ R[inR,i] <- r[[i]]
+ }
+ if(get[1] == 'overlapOnly'){
+ #===> this has been modified to work very well for months <===#
+ toRemove <- which(apply(is.na(R), 1, any))
+ if(all(diff(toRemove) == 1) | freq != 'm'){
+ if(length(toRemove) > 0){
+ R <- R[-toRemove, ]
+ }
+ } else {
+ keep <- rep(0, length(toRemove))
+ theDates <- as.Date(rownames(R)[toRemove], "%Y-%m-%d")
+ theMonths <- months(theDates)
+ theYears <- format(theDates, '%Y')
+ toCombine <- 0
+ for(i in 1:(length(toRemove)-1)){
+ cond1 <- theMonths[i] == theMonths[i+1]
+ cond2 <- theYears[i] == theYears[i+1]
+ cond3 <- abs(as.numeric(theDates[i] - theDates[i+1])) < 7 # extra precaution
+ if((cond1 & cond2) | cond3){
+ if(keep[i] > 0){ # if a 3rd or 4th date of the month is listed
+ keep[i+1] <- keep[i]
+ } else {
+ toCombine <- toCombine+1
+ keep[i] <- toCombine
+ keep[i+1] <- toCombine
+ }
+ }
+ }
+ # now we need to reorganize R
+ if(any(keep == 0)){
+ R <- R[-toRemove[keep == 0], ]
+ }
+ nRemoved <- 0
+ for(i in 1:toCombine){
+ combineThese <- toRemove[keep == i]
+ inThisRow <- combineThese[1]
+ for(k in 2:length(combineThese)){
+ thisRow <- combineThese[k]
+ for(j in 1:ncol(R)){
+ if(!is.na(R[thisRow-nRemoved,j])){
+ R[inThisRow-nRemoved,j] <- R[thisRow-nRemoved,j]
+ }
+ }
+
+ }
+ R <- R[-(combineThese[-1]-nRemoved),]
+ nRemoved <- nRemoved + length(combineThese[-1])
+ }
+ }
+ }
+ if(!is.matrix(R)){
+ R <- matrix(R, ncol=1)
+ rownames(R) <- as.character(as.Date(uDates, origin=minDate))
+ }
+ colnames(R) <- ticker
+ start <- rownames(R)[dim(R)[1]]
+ end <- rownames(R)[1]
+ temp <- list(R=R, ticker=ticker, period=period,
+ start=start, end=end, full=full)
+ class(temp) <- "stockReturns"
+ return(temp)
+}
+
@@ -0,0 +1,21 @@
+`lines.stockReturns` <-
+function(x, keep='all', col=NULL, lty=NULL, ...){
+ if(keep == 'all'){
+ keep <- 1:dim(x$R)[2]
+ }
+ if(is.null(col)[1]){
+ col <- keep
+ } else if(length(col) < max(keep)){
+ col <- rep(col, max(keep))
+ }
+ if(is.null(lty)[1]){
+ lty <- keep
+ } else if(length(lty) < max(keep)){
+ lty <- rep(lty, max(keep))
+ }
+ n <- dim(x$R)[1]
+ for(i in keep){
+ lines(1:n, cumprod(rev(1+x$R[,i])), col=col[i], lty=lty[i], ...)
+ }
+}
+
@@ -0,0 +1,12 @@
+`lines.testPort` <-
+function(x, ...){
+ if(is.null(x$returns)[1]){
+ stop('Cannot plot this model since no returns data provided.\n')
+ }
+ hold <- dim(x$returns)[1]
+ values <- apply(1+x$returns[hold:1,], 2, cumprod)
+ theReturns <- c(1, as.numeric(values %*% x$X))
+ Index <- 0:(length(theReturns)-1)
+ lines(Index, theReturns, ...)
+}
+
Oops, something went wrong.

0 comments on commit 82134ce

Please sign in to comment.