inst/doc/TAportfolio.R

In NMOF: Numerical Methods and Optimization in Finance

### R code from vignette source 'TAportfolio.Rnw'

###################################################
### code chunk number 1: TAportfolio.Rnw:22-23
###################################################
options(continue = "  ", digits = 5)


###################################################
### code chunk number 2: TAportfolio.Rnw:41-45
###################################################
require("NMOF")
resample <- function(x, ...)
    x[sample.int(length(x), ...)]
set.seed(112233)


###################################################
### code chunk number 3: TAportfolio.Rnw:76-87
###################################################
na <- dim(fundData)[2L]
ns <- dim(fundData)[1L]
winf <- 0.0; wsup <- 0.05
data <- list(R = t(fundData),
             RR = crossprod(fundData),
             na = na,
             ns = ns,
             eps = 0.5/100,
             winf = winf,
             wsup = wsup,
             resample = resample)


###################################################
### code chunk number 4: TAportfolio.Rnw:91-102
###################################################
neighbour <- function(w, data){
    eps <- runif(1L) * data$eps
    toSell <- w > data$winf
    toBuy  <- w < data$wsup
    i <- data$resample(which(toSell), size = 1L)
    j <- data$resample(which(toBuy),  size = 1L)
    eps <- min(w[i] - data$winf, data$wsup - w[j], eps)
    w[i] <- w[i] - eps
    w[j] <- w[j] + eps
    w
}


###################################################
### code chunk number 5: TAportfolio.Rnw:106-114
###################################################
OF1 <- function(w, data) {
    Rw <- crossprod(data$R, w)
    crossprod(Rw)
}
OF2 <- function(w, data) {
    aux <- crossprod(data$RR, w)
    crossprod(w, aux)
}


###################################################
### code chunk number 6: TAportfolio.Rnw:122-132
###################################################
w0 <- runif(na); w0 <- w0/sum(w0)

algo <- list(x0 = w0,
             neighbour = neighbour,
             nS = 2000L,
             nT = 10L,
             nD = 5000L,
             q = 0.20,
             printBar = FALSE,
             printDetail = FALSE)


###################################################
### code chunk number 7: TAportfolio.Rnw:135-137
###################################################
system.time(res <- TAopt(OF1,algo,data))
100 * sqrt(crossprod(fundData %*% res$xbest)/ns)


###################################################
### code chunk number 8: TAportfolio.Rnw:140-142
###################################################
system.time(res <- TAopt(OF2,algo,data))
100*sqrt(crossprod(fundData %*% res$xbest)/ns)


###################################################
### code chunk number 9: TAportfolio.Rnw:147-150
###################################################
min(res$xbest) ## should not be smaller than data$winf
max(res$xbest) ## should not be greater than data$wsup
sum(res$xbest) ## should be one


###################################################
### code chunk number 10: TAportfolio.Rnw:156-180
###################################################
if (require("quadprog", quietly = TRUE)) {
    covMatrix <- crossprod(fundData)
    A <- rep(1, na); a <- 1
    B <- rbind(-diag(na), diag(na))
    b <- rbind(array(-data$wsup, dim = c(na, 1L)),
               array( data$winf, dim = c(na, 1L)))
    system.time({
        result <- solve.QP(Dmat = covMatrix,
                           dvec = rep(0,na),
                           Amat = t(rbind(A,B)),
                           bvec = rbind(a,b),
                           meq = 1L)
    })
    wqp <- result$solution

    cat("Compare results...\n")
    cat("QP:", 100 * sqrt( crossprod(fundData %*% wqp)/ns ),"\n")
    cat("TA:", 100 * sqrt( crossprod(fundData %*% res$xbest)/ns ) ,"\n")

    cat("Check constraints ...\n")
    cat("min weight:", min(wqp), "\n")
    cat("max weight:", max(wqp), "\n")
    cat("sum of weights:", sum(wqp), "\n")
}


###################################################
### code chunk number 11: TAportfolio.Rnw:186-201
###################################################
neighbourU <- function(sol, data){
    wn <- sol$w
    toSell <- wn > data$winf
    toBuy  <- wn < data$wsup
    i <- data$resample(which(toSell), size = 1L)
    j <- data$resample(which(toBuy), size = 1L)
    eps <- runif(1) * data$eps
    eps <- min(wn[i] - data$winf, data$wsup - wn[j], eps)
    wn[i] <- wn[i] - eps
    wn[j] <- wn[j] + eps
    Rw <- sol$Rw + data$R[,c(i,j)] %*% c(-eps,eps)
    list(w = wn, Rw = Rw)
}
OF <- function(sol, data)
    crossprod(sol$Rw)


###################################################
### code chunk number 12: TAportfolio.Rnw:205-208
###################################################
data <- list(R = fundData, na = na, ns = ns,
             eps = 0.5/100, winf = winf, wsup = wsup,
             resample = resample)


###################################################
### code chunk number 13: TAportfolio.Rnw:212-224
###################################################
w0 <- runif(data$na); w0 <- w0/sum(w0)
x0 <- list(w = w0, Rw = fundData %*% w0)
algo <- list(x0 = x0,
             neighbour = neighbourU,
             nS = 2000L,
             nT = 10L,
             nD = 5000L,
             q = 0.20,
             printBar = FALSE,
             printDetail = FALSE)
system.time(res2 <- TAopt(OF, algo, data))
100*sqrt(crossprod(fundData %*% res2$xbest$w)/ns)


###################################################
### code chunk number 14: TAportfolio.Rnw:230-231
###################################################
fundData <- cbind(fundData, fundData[, 200L])


###################################################
### code chunk number 15: TAportfolio.Rnw:234-237
###################################################
dim(fundData)
qr(fundData)$rank
qr(cov(fundData))$rank


###################################################
### code chunk number 16: TAportfolio.Rnw:241-243
###################################################
if (require("quadprog", quietly = TRUE))
    wqp[200L]


###################################################
### code chunk number 17: TAportfolio.Rnw:246-253
###################################################
na <- dim(fundData)[2L]
ns <- dim(fundData)[1L]
winf <- 0.0; wsup <- 0.05
data <- list(R = fundData, na = na, ns = ns,
             eps = 0.5/100, winf = winf, wsup = wsup,
             resample = resample)



###################################################
### code chunk number 18: TAportfolio.Rnw:256-269
###################################################
if (require("quadprog", quietly = TRUE)) {
    covMatrix <- crossprod(fundData)
    A <- rep(1, na); a <- 1
    B <- rbind(-diag(na), diag(na))
    b <- rbind(array(-data$wsup, dim = c(na, 1L)),
               array( data$winf, dim = c(na, 1L)))
    cat(try(result <- solve.QP(Dmat = covMatrix,
                                 dvec = rep(0,na),
                                 Amat = t(rbind(A,B)),
                                 bvec = rbind(a,b),
                                 meq = 1L)
              ))
}


###################################################
### code chunk number 19: TAportfolio.Rnw:272-284
###################################################
w0 <- runif(data$na); w0 <- w0/sum(w0)
x0 <- list(w = w0, Rw = fundData %*% w0)
algo <- list(x0 = x0,
             neighbour = neighbourU,
             nS = 2000L,
             nT = 10L,
             nD = 5000L,
             q = 0.20,
             printBar = FALSE,
             printDetail = FALSE)
system.time(res3 <- TAopt(OF, algo, data))
100*sqrt(crossprod(fundData %*% res3$xbest$w)/ns)


###################################################
### code chunk number 20: TAportfolio.Rnw:287-288
###################################################
res3$xbest$w[200:201]