投资组合 on 格物堂

善用向量化提升R语言的计算性能

Sat, 08 Mar 2014 00:00:00 +0000

用R 语言用的久了，渐渐发现 R 语言的世界里有很多黑魔法。其中一个黑魔法是向量化运算。向量化运算可以说是R语言区别于其它语言的特质之一，善用向量化运算不仅能有效降低代码的冗余度，还能显著提升代码的运算效率。遗憾的是，很多接触过其它编程语言的人未能掌握这一特性使得他们经常诟病R语言运算效率低下。这里给看官们举个例子来体会下。

想必大家都遇到过替换向量元素的情况。比如，我们有下面这样一个数据框，维度是1200000×2：

n = 1200000
df = data.frame(values = rnorm(n), 
 ID = rep(LETTERS[1:3], each = n/3),
 stringsAsFactors = FALSE)
head(df)

## values ID
## 1 1.8442348 A
## 2 -0.5089413 A
## 3 -0.8743655 A
## 4 0.7824285 A
## 5 -1.2115204 A
## 6 -1.4914611 A

tail(df)

## values ID
## 1199995 1.753660616 C
## 1199996 -0.007581797 C
## 1199997 -0.635219385 C
## 1199998 -1.437210958 C
## 1199999 -0.101465502 C
## 1200000 0.152135010 C

假设要把df$ID中的A替换为“A公司”，B和C类似。怎么做呢？一个常用的解决方案是利用if…for写循环。代码是这样的：

translator_if_for = function(input_vector) {
 output_vector = input_vector
 for(index in seq_along(input_vector)) {
 if(input_vector[index] == 'A') {
 output_vector[index] = 'A公司'
 } else if(input_vector[index] == 'B') {
 output_vector[index] = 'B公司'
 } else if(input_vector[index] == 'C') {
 output_vector[index] = 'C公司'
 } 
 } 
 return(output_vector)
}

dum_if_for = translator_if_for(df$ID)
head(dum_if_for)
tail(dum_if_for)

用rbenchmark包测试下上述操作需要的时间：

library(rbenchmark)
res = benchmark(if_for_solution = translator_if_for(df$ID),
 columns= c("test","replications","elapsed","relative","user.self","sys.self"),
 replications = 10)
 res

 test replications elapsed relative user.self sys.self
1 if_for_solution 10 69.63 1 69.48 0

上面这段代码的缺点是时间久，而且看起来一点都不简洁。那么，是否有更好点的解决方案呢？Absolutely！而且不止一种。比较常用的替代方案是借助 apply族函数（apply族函数是R语言中避免编写显式循环的一个trick）。在用apply族函数之前，得先构造一个辅助函数。构造函数之前不妨先想想我们的操作逻辑，我们想做的事情是这样的，对于df$ID中的某个元素，如果元素是A其就变成A公司，B变成B公司，C变成C公司。这其实可以用switch来实现。对所有元素进行依次进行判断就可以了，针对所有元素进行判断这个过程可以交给sapply函数来完成，于是有下面的代码：

 translator_function = function(element) {
 switch(element,
 A = 'A公司',
 B = 'B公司',
 C = 'C公司')
 }
 
 dum_switch_sapply = sapply(df$ID, translator_function)
 head(dum_switch_sapply)
 tail(dum_switch_sapply)

代码看起来更简洁，看看操作结果是否一致：

all.equal(dum_if_for, dum_switch_sapply, check.attributes = FALSE)

看看这段代码需要的时间：

 res = benchmark(function_solution = sapply(df$ID, translator_function),
 columns= c("test","replications","elapsed","relative","user.self","sys.self"),
 replications = 10)
 res

 test replications elapsed relative user.self sys.self
1 function_solution 10 64.58 1 64.1 0.24

可以看到时间也有所减少。But..这就是结束吗？操作效率是有提升，但提升的一点都不明显啊！？别急，我们还有杀手锏——向量化运算！先上代码，再慢慢解释逻辑。

 translator_vector = c(A = 'A公司',
 B = 'B公司',
 C = 'C公司')
 dum_vectorized = translator_vector[df$ID]
 head(dum_vectorized)
 tail(dum_vectorized)

看看结果是否一样：

all.equal(dum_vectorized, dum_switch_sapply, check.attributes = FALSE)

完全一样。但是看起来无疑简洁了很多。那么，从耗时角度讲呢？我们看一看：

 res = benchmark(vector_solution = translator_vector[df$ID],
 columns= c("test","replications","elapsed","relative","user.self","sys.self"),
 replications = 10)
 res

 test replications elapsed relative user.self sys.self
1 vector_solution 10 1.13 1 1.06 0.03

时间大大减少了。把三种方案的耗时放到一起看一看：

 res = benchmark(if_for_solution = translator_if_for(df$ID),
 function_solution = sapply(df$ID, translator_function),
 vector_solution = translator_vector[df$ID],
 columns= c("test","replications","elapsed","relative","user.self","sys.self"),
 replications = 10)
 res

 test replications elapsed relative user.self sys.self
2 function_solution 10 71.51 87.207 70.95 0.42
1 if_for_solution 10 69.89 85.232 69.34 0.25
3 vector_solution 10 0.82 1.000 0.75 0.08

向量化运算无论在代码简洁度还是在效率上完爆前两种方案。缺点是操作逻辑十分巧妙，可能不是那么容易理解。这里简单解释一下：

上面的translator_vector是个有名字的向量：

 translator_vector = c(A = 'A公司',
 B = 'B公司',
 C = 'C公司')
 translator_vector

names(translator_vector)

因此，可以通过元素的名字对元素进行索引。例如：

translator_vector["A"]
translator_vector["B"]
translator_vector[c("A","B")]

而df$ID刚好是一个由translator_vector向量的元素名字组成的向量。因此,代码：

translator_vector[df$ID]

就相当于一个索引操作，其结果得到的恰好是translator_vector中对应的元素，这也就相当于对向量元素进行了替换。

说说风险均摊投资组合的构建方法

Tue, 14 Jan 2014 00:00:00 +0000

引子

构建股票投资组合时，在筛选出备选股票之后，要解决的另外一个问题是确定备选股票在投资组合中的权重。我们可以用一个向量来表示：

$$ w=\left(w_1,w_2,…,w_n \right) $$

其中， $\sum_{i=1}^nw_{i}=1,i=1,2,...,n$ 。

显然，权重的可选集是个无限集合。如果想选取其中一个作为最优权重，那得先确定一个判断最优与否的方法。耳熟能详的方法自然是收益-风险法，即如果一个权重能够使投资组合的收益最大、风险最小，那么，它就是好的。如果用标准差来刻画风险的话，就有下面的评价函数:

$$ U(R,\sigma) $$

其中， $\frac{\partial U\left(\cdot\right)}{\partial R}\gt 0$ ， $\frac{\partial U\left(\cdot\right)}{\partial\sigma}\lt 0$。

$U\left(\cdot\right)$ 最简单的形式如下：

$$ U_p = aR_{p} + b \sigma _{p} $$

其中， $a\gt 0$ ， $b\le 0$ ； $R_{p}$ 是组合的收益率， $\sigma_{p}$ 是组合的标准差。显然：

$$ R_{p} = w’R $$

$$ \sigma_p = w’Cw $$

其中， $R=(R_1,R_2,...,R_n)$ 是组合中各证券的收益率， $C$ 是组合中各证券的收益率的协方差矩阵。

把 $R_{p}$ 和 $\sigma_p$ 带入 $U_p$ ，解出令 $U_p$ 最小的 $w$ 即可。

当然，也有其它理念。比如下面要说的风险均摊。风险均摊是指选出来这样一个权重，使得其确定的投资组合中各个证券的风险占证券投资总的风险的比例是相同的。有些拗口，直接看下面的公式。

风险均摊的理论基础及公式

由前面的公式可知：

$$ \sigma_p = wCw’=wC \times (w_1,w_2,…,w_n)’=\sum_{i=1}^n wC_{\cdot i}w_i $$

上面可以看到证券组合的风险相当于是 $wC_{\cdot i}$ 的加权组合，权重是 $w=(w_1,w_2,...,w_n)$ 。所谓风险均摊，就是令 $wC_{\cdot i}w_i=wC_{\cdot j}w_j$ 。显然，确定一个权重 $w$ 使得证券组合的风险得以均摊等同于找到一个权重 $w$ 使得下式最小：

$$ \sum_{j=1}^n \sum_{i=1}^n \left[ wC_{\cdot i}w_i-wC_{\cdot j}w_j \right]^2 $$

这是一个比较简单的优化问题，在 R 软件里面很容易得到结果。

用 R 实现风险均摊优化器

# 模拟获取数据
require(quantmod);
x=getSymbols("000635.sz",from="2013-01-01",auto.assign=FALSE)
y=getSymbols("000547.sz",from="2013-01-01",auto.assign=FALSE)
z=getSymbols("600241.ss",from="2013-01-01",auto.assign=FALSE)
ret_mat <- cbind(dailyReturn(x),dailyReturn(y),dailyReturn(z))
ret_mat <- na.omit(ret_mat)

# 定义目标函数

ff <- function(w,ret_mat){
 cov_mat <- cov(ret_mat);
 w=c(w,1-sum(w));
 len <- length(w);
 w_mat <- matrix(rep(w,time=len),nr=len,byrow=TRUE);
 diag_mat <- diag(w);
 res <- 2*len*as.vector(t(diag(w_mat%*%cov_mat%*%diag_mat))%*%diag(w_mat%*%cov_mat%*%diag_mat))-2*(sum (diag(w_mat%*%cov_mat%*%diag_mat)))^2;
 return(res);
 } 
 
# 优化目标函数

w <- optim(c(0.3,0.3),ff,ret_mat=ret_mat)$par;

# 查看权重

w=c(w,1-sum(w));
w = c(w,1-w[1]-w[2])

使用R和DEoptim求解大规模投资组合

Tue, 20 Aug 2013 00:00:00 +0000

1.楔子

第四届上海 R 语言会议时，在演讲中提到过一个 R 包：DEoptim 。这是一个用来做优化的包，它实现了几个差分进化算法（ Differential Evolution algorithms ）。差分进化算法是个什么东西呢？从“进化算法”这四个字可以看出它似乎跟生物学有点沾边，事实上，它算是遗传算法（ Genetic algorithms ）的一种。

诸位知道，遗传算法总的来说是借鉴了生物学中生物进化（其实，说优化可能更准确）过程，这种思路还是比较巧妙的。差分进化算法也类似，差分进化算法的主要过程是这样的：生成随机种子的群体、对各群体进行杂交、对群体进行变异、筛选优秀的群体作为后代。不断重复这一过程直到群体后代的优秀程度没法得到显著的提高为止。如果把目标函数（ objective function ）看作衡量群体优秀程度的标准、把目标函数的输入参数看作群体，显然，可以用差分遗传算法来对目标函数进行优化。

作为一种优化算法，差分进化算法可以应用到很多领域，金融领域的优化问题很多，求解投资组合就是其中一个应用。所以，这篇文章想看一看差分进化算法在求解投资组合方面的表现。选择投资组合的准则有很多，这里我们根据组合的 CVaR 对组合进行优化。具体来说，在各资产对组合贡献的 CVaR 的权重不超过 5% 的条件下，使得组合的 CVaR 的值最小。

具体的技术细节可参考 Portfolio Optimization with CVaR budgets 。

这里的组合优化对应的是一个非凸优化问题。用传统的局部最优方法，比如， optim 包和 nlminb 包中的 L-BFGS-B 方法和 Nelder-Mead 方法，在求解此类优化问题时，常常收敛到次优解，而非最优解。DEoptim 算法属于随机全局优化算法，相比较而言，它的优化效果会更好。

为了是文章更接近现实，下面使用的组合中的证券数目设定为 100 只股票。

2.系统环境说明

文中所有的结果和代码都基于 R 3.0.1 。获取数据用的是 quantmod 包中的 getSymbols 函数。目标函数中的风险度量函数来自 PerformanceAnalytics 包。DEoptim 函数的初始群落则由 PortfolioAnalytics 包中的 random_portfolios 函数生成。

DEoptim 函数会反复计算目标函数的值，直到把群落逼近全局最小值。对提高 DEoptim 函数的性能感兴趣的同学，必须集中活力解决目标函数的进化速度。对于纯 R 代码而言，最好的途径是并行。当然，最根本的道路还是用 c或者Fortran 对该算法进行重写。

3.获取数据

下面从 S&P 500中随意选取 100支股票作为组合中基础股票。然后，用 quantmod 包中的 getSymbols 函数来下载得到它们的10年间的月度数据，并计算指数收益率序列、均值序列及协方差矩阵。

 tickers = c( "VNO" , "VMC" , "WMT" , "WAG" , "DIS" , "WPO" , "WFC" , "WDC" ,
 "WY" , "WHR" , "WMB" , "WEC" , "XEL" , "XRX" , "XLNX" ,"ZION" ,"MMM" ,
 "ABT", "ADBE" , "AMD" , "AET" , "AFL" , "APD" , "ARG" ,"AA" , "AGN" ,
 "ALTR" , "MO" , "AEP" , "AXP" , "AIG" , "AMGN" , "APC" ,"ADI" , "AON" ,
 "APA", "AAPL" , "AMAT" ,"ADM" , "T" , "ADSK" , "ADP" , "AZO" , "AVY" ,
 "AVP", "BHI" , "BLL" , "BAC" , "BK" , "BCR" , "BAX" , "BBT" , "BDX" ,
 "BMS" , "BBY" , "BIG" , "HRB" , "BMC" , "BA" , "BMY" , "CA" , "COG" ,
 "CPB" , "CAH" , "CCL" , "CAT" , "CELG" , "CNP" , "CTL" , "YHOO", "CERN" ,
 "SCHW" , "CVX" , "CB" , "CI" ,"CINF" ,"CTAS" , "CSCO" , "C" , "CLF" ,
 "CLX", "CMS" , "KO" , "CCE" , "CL" , "CMCSA" ,"CMA" , "CSC" , "CAG" ,
 "COP" , "ED" , "QQQ" ,"GLW" , "COST" , "CVH" , "CSX" , "CMI" , "CVS" ,
 "DHR" , "DE")

 library(quantmod);
 getSymbols(tickers, from = "2000-12-01", to = "2010-12-31")
 P <- NULL; seltickers <- NULL
 for(ticker in tickers) {
 tmp <- Cl(to.monthly(eval(parse(text=ticker))))
 if(is.null(P)){ timeP = time(tmp) }
 if( any( time(tmp)!=timeP )) next
 else P<-cbind(P,as.numeric(tmp))
 seltickers = c( seltickers , ticker )
 }
 P = xts(P,order.by=timeP)
 colnames(P) <- seltickers
 R <- diff(log(P))
 R <- R[-1,]
 dim(R)
 mu <- colMeans(R)
 sigma <- cov(R)

4.设定目标函数及约束条件

这里的投资组合的优化问题由两个部分组成：一是，选择令投资组合具有最小CVaR的的组合权重；二是，令每支股票对整个投资组合的CVaR值的贡献不超过 5%。同时，组合必须是正数，且组合必须进行满仓操作。

借助于 PerformanceAnalytics 包中的 ES 函数，我们可以方便地计算投资组合的 CVaR 水平以及各支股票对整个投资组合的CVaR贡献值。简单起见，在计算CVaR值时，假定序列服从正态分布。不过，对于非正态分布的收益率序列而言，也能用 ES 函数计算其相应的组合CVaR水平以及各支股票对整个投资组合CVaR的贡献值。

为了使得得到的组合中，所有股票对整个组合的 CVaR 的贡献不超过 5% ，我们可以向目标函数增加一个罚函数。本来，我们允许搜索算法去考虑那些非可行解。必须对那些无法为投资者接受的投资组合施加足够的惩罚，以使得他们在目标函数的最小化过程中被过滤掉。并且，其对约束的偏离越大，目标函数的值应该增加的越多。

 library("PerformanceAnalytics")
 obj <- function(w) {
 if (sum(w) == 0) {
 w <- w + 1e-2
 }
 w <- w / sum(w)
 CVaR <- ES(weights = w,
 method = "gaussian",
 portfolio_method = "component",
 mu = mu,
 sigma = sigma)
 tmp1 <- CVaR$ES
 tmp2 <- max(CVaR$pct_contrib_ES - 0.05, 0)
 out <- tmp1 + 1e3 * tmp2
 return(out)
 }

组合权重需要满足两个条件，一是，多头；二是，必须满仓操作。现在的 DEoptim 允许对组合权重设定约束范围。我们称其为下边界 lower 和上边界 upper。

 N <- ncol(R)
 minw <- 0
 maxw <- 1
 lower <- rep(minw,N)
 upper <- rep(maxw,N)

完整的投资约束包括两个方面：一是，将目标函数的所有权重进行标准化，使得所有权重之和为 1 。二是，使用 Portfolioanalytics 包中的 random_portfolios 函数来生成满足上述所有约束条件的随机组合。DEoptim 将采用这些随机组合作为初始群落。

 source("random_portfolios.R")
 eps <- 0.025
 weight_seq<-generatesequence(min=minw,max=maxw,by=.001,rounding=3)
 rpconstraint<-constraint(
 assets=N, min_sum=(1-eps), max_sum=(1+eps),
 min=lower, max=upper, weight_seq=weight_seq)
 set.seed(1234)
 rp<- random_portfolios(rpconstraints=rpconstraint,permutations=N*10)
 rp <-rp/rowSums(rp)

5.尝试传统的梯度优化方法

前面介绍的目标函数中的罚函数是不可微，因此，标准的基于梯度的优化方法不再适用。比如，optim 包中的 L-BFGS-B 方法，还有 nlminb 包中的 Nelder-Mead 方法。

 out <- optim(par = rep(1/N, N), fn = obj,
 method = "L-BFGS-B", lower = lower, upper = upper)
 out$value
 out$message
 out <- nlminb(start =rep(1/N, N), objective = obj,
 lower = lower, upper = upper)
 out$objective

6.基于 DEoptim 的组合优化

与基于梯度的优化方法不同，DEoptim 函数会重复地查找优化问题的全局近似最小值。对于本文中这种复杂的组合，DEoptim 函数的表现极大地依赖于所选用的DE算法。

先看一下DEoptim的默认算法，即带固定参数的局部最优（local-to-best）策略。

如果目标函数在每150步迭代之后，两最优迭代之间的提升百分比低于 reltol=1e-6，我们就认为目标函数收敛。对于某些优化问题，DE算法要经过很多步迭代才收敛。这里，我们将最大迭代次数设定为5000。每完成250次迭代向屏幕输出一次结果。前面已经说过，用 rp 作为 DE 算法的初始群落。

 controlDE <- list(reltol=.000001,steptol=150, itermax = 5000,trace = 250,
 NP=as.numeric(nrow(rp)),initialpop=rp)
 set.seed(1234)
 start <- Sys.time()
 out <- DEoptim(fn = obj, lower = lower, upper = upper, control = controlDE)

Iteration: 250 bestvalit: 0.064652
Iteration: 500 bestvalit: 0.057199
Iteration: 750 bestvalit: 0.055774
Iteration: 1000 bestvalit: 0.055013
Iteration: 1250 bestvalit: 0.054581
Iteration: 1500 bestvalit: 0.054269
Iteration: 1750 bestvalit: 0.054146
Iteration: 2000 bestvalit: 0.054049
Iteration: 2250 bestvalit: 0.053706
Iteration: 2500 bestvalit: 0.053695
Iteration: 2750 bestvalit: 0.053351
Iteration: 3000 bestvalit: 0.053273
out$optim$iter
[1] 3055
 out$optim$bestval
[1] 0.05327273
end <- Sys.time()
end - start
Time difference of 16.03645 mins

在上面的5000次迭代中，带固定参数的局部最优策略得到的最优解优于前面提到的基于梯度的优化算法得到的结果。近来出现的JADE算法，对复杂优化问题具有更好地收敛特性。该算法糅合了局部最优策略和自适应参数控制策略。