R on 格物堂

R数据库交互系列笔记：DBI包

Mon, 19 May 2014 00:00:00 +0000

DBI是DataBase Interface的简称，即数据库界面。这篇笔记的主要内容是讲一讲如何用R中的DBI包来与常见数据库进行交互。

1 简介

DBI定义了一个与RDBMS类型数据库进行通信的泛型接口，对于任意一个RDBMS，DBI都会有一个兼容的数据库驱动来实现对接。目前，其可用的驱动包括Oracle、MySQL和SQLite等。

理论上说，DBI的泛型接口允许我们同样的代码来跟不同的RDBMS进行通信。但实际应用的时候，还要看具体的RDBMS与SQL标准的是否完全相似，以及数据库开发者开发过程中是否避免使用RDBMS特有的一些功能。

下面以SQLite数据库为例说明一下。例子中用的是Affymetrix hgu95av2的微阵列芯片数据，用之前先加载相关的包。

library(tools)
library("RBioinf")
library("DBI")
library("RSQLite")
dbPath <- "hgu95av2-sqlite.db"

2 DBI连接SQLite数据库

DBI连接RDBMS需要两步。第一步，用dbDriver函数创建一个适合的数据库驱动；第二步，用dbConnect函数创建数据库连接。具体到SQLite，只需要指定包含数据库的文件夹路径即可。而对于MySQL或者Oracle，则需要指定主机地址、用户名和密码等信息。

drv <- dbDriver("SQLite")
db <- dbConnect(drv, dbPath)
db

dbDisconnect函数可以断开连接。

dbDisconnect(db)

3 查询数据库结构

可以用dbListTables和dbListFields函数来列出数据库中的表名以及各表对应的字段（列名）。

db <- dbConnect(drv, dbPath)
dbListTables(db)
dbListFields(db, "go_probe")

4 查询语句

dbSendQuery函数可以执行任意SQL语句。返回的结果是DBI结果的子类，这个子类的结果可以用fetch函数来查询。为了节约内存，用不到的数据库查询对象可以用dbClearResult函数进行清除。

fetch函数可以将查询结果转为数据框。dbColumnInfo、dbGetRowsAffected和dbGetRowCount函数可以返回更多关于查询的信息。下面分别演示。

sql <- "select affy_id, evi from go_probe"
rs <- dbSendQuery(db, sql)
rs

DBIResult实例包含了查询的相关信息。

dbColumnInfo(rs)
dbGetStatement(rs)
dbGetRowsAffected(rs)

具体的结果可用fetch函数查看。

chunk <- fetch(rs, n = 5)
chunk

dbGetRowCount函数范围所有查询结果的行数。

dbGetRowCount(rs)

当不再用某个DBIResult实例时，记得清除。

dbClearResult(rs)
rs

5 基于查询结果构建R中的数据对象

sql <- "select * from go_probe"
rs <- dbSendQuery(db, sql)
dat <- fetch(rs, n = 500)
goList <- split(dat$go_id, dat$affy_id)

6 ODBC

RODBC包可以连接ODBC数据源，当然前提是安装相应的数据库驱动。R导入与导出中给出了一些使用RODBC的实例，可以供参考。用ODBC连接RDBMS时，需要指定一个ODBC数据服务，具体如何做要看所用的操作系统。

RBioinf包中提供Gavin和Ho提供关于AP-MS蛋白质实验结果数据，分别给出了pcomplex.txt和pcomplex.xls两种格式，下面用它来演示下RODBC的用法。

数据包括三列：bait-protein，experiment和prey-protein。下面的结果仅在Windows系统下才能重现。

library("RODBC")
if (.Platform$OS.type == "Windows") {
 pcomplexXls <- system.file("extdata/pcomplex.xls", package = "RBioinf")
 db <- odbcConnectExcel(pcomplexXls)
 }
if (!is.null(db)) {
 sqlTables(db)
 sqlQuery(db, "select * from [Sheet1$] limit 5")
 }

7 参考文献

Seth Falcon，How to Use DBI: Connecting to Databases with R，January 17, 2006。

R中的金融数据接口

Tue, 05 Nov 2013 00:00:00 +0000

借助R软件，我们可以从网站上获取很多经济和金融数据。我整理了一下目前R可以使用的获取金融数据的包，供大家参考。

数据源	金融工具类型	R包	免费	是否发布在CRAN上	链接
yahoo	所有金融工具，日数据	quantmod	是	是	http://www.quantmod.com
google	所有金融工具，财务数据，日数据	quantmod	是	是	http://www.quantmod.com
Oanda	外汇、贵金属数据	quantmod	是	是	http://www.quantmod.com
Fred	经济数据	quamod	是	是	http://www.quantmod.com
Quandl	期货数据，日数据	RQuandl	是	是	http://quandl/help/packages/r
TrueFX	外汇高频数据	TFX	是	是	http://rpubs.com/gsee/TFX
Bloomberg	所有品种、基金、所有频度	Rbbg	否	否	http://finddata.org/rbloomberg/
Interactive Broker	所有品种、所有频度	IBrokers	否	yes	www.interactivebrokers.com

安装RMySQL

Sat, 28 Sep 2013 00:00:00 +0000

处理金融市场数据的时候会用到MySQL数据库，R提供了一个RMySQL`包作为自身跟MySQL的接口。这个包本身很容易用，唯一不足的一点是在Windows下面安装RMySQL有点麻烦。安装RMySQL时,除了按部就班的安装MySQL、R、RTools、RMySQL等之外还要设置各种path变量以及把某些文件夹在各个路径里来回移动。

这篇文章就说一下自己在安装RMySQL过程中总结出来的较优的安装步骤。

下载并安装 MySQL

下载并安装 MySQL ，这一点大多数人都知道如何操作，只提醒一点看清楚自己的电脑是 32位还是64位.

把MySQL添加到Path变量.

具体做法是找到我的电脑(指图标)，右键，系统属性，打开"高级"选项卡，下面可以瞅见"环境变量"，点进去，上面部分为"用户变量"，下面部分是"系统变量"，在变量列，找到一个叫Path的东西，选中，点编辑，把MySQL的安装路径复制进去即可。

关联MySQL和R软件

具体是，打开 C:\Program Files\MySQL\MySQL Server 5.5\lib ，新建 OPT 文件夹，并复制 MYSQLLIB.LIB 到该文件夹内。同时，复制 libmysql.dll 到到\R\R-2.14.0\bin\ (64 bit) 或 \R\R-2.14.0\bin\i386\ (32 bit) 和 C:\Windows\System32 中;接下来,找到 R\3.0.2\etc 文件夹，并新建 Renviron.site 文件,用记事本打开,向其中添加一行:MYSQL_HOME =”C:/Program Files/MySQL/MySQL Server 5.5/” .

下载并安装RTools

安装过程很简单。要提醒的是要把\Rtools\2.14\bin,\Rtools\3.0.x\MinGW\bin,\Rtools\3.0.x\MinGW64\bin 添加到 path 变量。

下载RMySQL源代码

略过。

运行代码安装RMySQL

假设源码存放地址为 d://RMySQL_0.8-0.tar.gz ,运行如下命令:

install.packages("RMySQL_0.8-0.tar.gz",repo=NULL,type="source")

测试安装是否成功:

library(RMySQL) 
drv = dbDriver("MySQL") 
con = dbConnect(drv,host="localhost",dbname="test",user="root",pass="root") 
album = dbGetQuery(con,statement="select * from t_master") 
album

R软件中的集合计算操作

Fri, 27 Sep 2013 00:00:00 +0000

在处理数据尤其是在编写函数或编译R包的时候会涉及到集合的运算操作。比如，判断某个元素是否属于某个集合，并用这个判断结果作为 if 结构中的条件语句。

在量化投资的编程中更是经常用到集合的运算操作。比如，判断某支股票是否在今日的投资组合里，又或者在已有当前投资组合的情况下如何生成交易单以得到理想投资组合的股票代码，这涉及到差集操作。因此，了解一下R中的集合计算操作是很有必要的。

根据小学时候的知识，我们知道集合计算无非包括这么几类：

两个集合的交集，即两个集合中共有的那些元素
两个集合的并集，即两个集合粗暴合并，并剔除重复值后剩余的那些元素
两个集合的差集，集合1减去集合1跟集合2的交集，即得到集合1、集合2的差集，换句话说，集合1中包含而集合2未包含的那些元素
元素判断，即开篇说的那个问题，某个元素是否属于某个集合
集合等价判断，即两个集合是否是同一个集合

它们对应的R函数就是下面这些：

union(x, y)
intersect(x, y)
setdiff(x, y)
is.element(el, set)
setequal(x, y)

本着解释知识不举例子就是耍流氓的精神，我们看看下面的例子:

# 随意生成两个向量x和y
x <- c(sort(sample(1:20, 9)), NA)
y <- c(sort(sample(3:23, 7)), NA)
# 查看 x，y 都长什么样子
x

## [1] 1 4 6 7 9 11 15 17 19 NA

## [1] 12 13 14 15 19 20 21 NA

# 计算并集
union(x, y)

## [1] 1 4 6 7 9 11 15 17 19 NA 12 13 14 20 21

# 计算交集
intersect(x, y)

## [1] 15 19 NA

# 计算差集，注意：计算差集时，集合的先后顺序是影响结果滴！
setdiff(x, y)

## [1] 1 4 6 7 9 11 17

setdiff(y, x)

## [1] 12 13 14 20 21

# x，y是否相等，当然不相等啦....
setequal(x, y)

## [1] FALSE

# 看看并集、交集、差集的关系
## True for all possible x & y :
setequal( union(x, y),
 c(setdiff(x, y), intersect(x, y), setdiff(y, x)))

## [1] TRUE

# 元素判断
is.element(5, x)

## [1] FALSE

is.element(100, x)

## [1] FALSE

is.element(x, y) # length 10

## [1] FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE TRUE TRUE

is.element(y, x) # length 8

## [1] FALSE FALSE FALSE TRUE TRUE FALSE FALSE TRUE

WDI包：从世界银行获取世界发展指标数据

Mon, 09 Sep 2013 00:00:00 +0000

在网络上闲逛时偶然发现了WDI包，这个包可以帮助我们搜索、提取及格式化世界银行（World Bank）公布的世界发展指标（World Development Indicators）数据。

WDI包包括一个数据对象WDI_data及三个函数 WDIsearch、WDIcache和WDI。其中，WDI是主函数，WDIsearch和WDIcache是辅助函数。

WDI_data作为一个本地对象，保存了世界银行截止2012年6月18日所有可获得的指标信息。

WDIcache函数作用是更新可获得的WDI的指标列表。从世界银行网站上下载一个WDI指标的列表。返回一个数据框，该数据框可以作为WDIsarch函数的对象。从世界银行网站下载所有的时序信息会非常耗时间。用来对wDI_data对象中的信息进行更新。通过 cache 函数输入到WDIsearch函数中。

WDIseach函数的作用是搜索所有WDI序列的名字和信息描述。搜索WDI序列的代码、名字、描述及数据源。

 WDIsearch(string = "gdp", field = "name", short = TRUE,
 cache = NULL)

string 搜索关键字 field 搜索范围’indicator’, ’name’, ‘description’, ‘sourceDatabase’, ‘sourceOrganization’等。 short 逻辑变量。TRUE，只返回代码和名字。FALSE返回序列的所有信息。 cache WDIcache函数生成的数据列表。缺失的话，WDIsearch会在本地的数据列表中进行查询。

返回的是满足特定搜索条件的序列的代码、名字、数据源及序列描述。

WDIsearch(string='gdp', field='name', cache=NULL)
WDIsearch(string='AG.AGR.TRAC.NO', field='indicator', cache=NULL)

使用世界银行的API获取需要的数据，解析生成的JSON文件并将结果整理为包含国家和年份信息的长格式数据。

add.indicator函数笔记

Sun, 01 Sep 2013 00:00:00 +0000

add.indicator函数是quantstrat包中的主函数之一。它的主要功能是生成信号指示器。这种解释方法有点绕口。举个例子说起来更容易明白。假如说，我们想测试这样一个策略：即当某支股票的价格低于5日算术平均时，买入该股票；高于5日算术平均时卖出该股票。那么，在这个测试过程中，我们要用到 SMA(price,n=5) 这个序列（SMA函数的作用是计算算术平均），既然要用到这个序列，那么得首先生成这个序列， add.indicator函数就是干这个的，是用来生成序列的。

看看帮助文档中的 add.indicator 函数的参数：

add.indicator(strategy, name, arguments,
 parameters = NULL, label = NULL, ..., enabled = TRUE,
 indexnum = NULL, store = FALSE)

strategy参数是策略名。在quantstrat 包的框架中，所有指示器（indicator）都从属于策略（strategy），因此，使用add.indicator函数时要率先指定策略名；name参数的作用是指定生成指示器所用的R函数，比如，这里我们用到的函数是SMA ，那么，此时的name参数就是SMA；arguments参数也是个从属参数，它的作用是指定name 参数对应的那个函数的参数。好绕口！说人话的话是这样的：SMA函数除了要输入时间序列参数x 外，还得指定做算术平均时候的时间跨度n，而这个n就是在aruments中指定的。label参数的作用是设定指示器的标签，这样在生成指示器序列时，指示器的序列名的后缀会是该标签的内容。该参数默认是 name+ind。其它参数暂时不怎么重要，就不闲扯了，多说无益，上代码：

##定义一个策略，名字名为 str_sma 
strategy("str_sma", store=TRUE)
##获取策略的标的，名字为 SPY
getSymbols("SPY", src='yahoo')
##添加指示器
add.indicator('str.sma', 'SMA', arguments=list(x=quote(Ad(SPY)), n=20),label="sma.20")
##查看策略的结构
str(getStrategy('str.sma')$indicators)
## 执行指示器
out <- applyIndicators('str.sma', SPY)
## 查看指示器结果
tail(out)

时空数据可视化

Sun, 28 Jul 2013 00:00:00 +0000

这几天北京有点热，穿着汗衫都觉得浑身冒烟儿，做啥都没有激情，只能赖在家里或者躲进图书馆和博物馆。没什么紧要的事情都懒得往外面走，但一月一次的“COS数据分析沙龙”是个例外。没有紧要的事儿，都得抽出时间去参加，偶尔还得客串一下主持人。

这次沙龙的主题是“时空数据的可视化”，分享嘉宾是来自中科院地理所的王江浩（@沐洲），整个沙龙内容真的令人震撼。

我第一次对江浩有印象是在微博上。二〇一三年三月，上海爆发H9N7疫情，之后不久江苏、浙江等省份相继出现疫情。一时间全国上下议论纷纷，专家、民众都担心这次疫情会酿成第二次SARS（非典型性肺炎）。很多人都开始关注H9N7的疫情趋势，就在这个时候，江浩的微博开始贴出H9N7疫情的可视化图，且被大量转发。

再不久，雅安发生地震，江浩根据网上抓取的地震相关数据，对雅安周边的地区震级做了相当经典的可视化，从地图上标注了雅安周边地区各个县、乡的地震成度。让人对当地情况一目了然。我也是第一次感觉到了时空数据可视化的重要性。

细想之下，何止地震和疫情呢？交通情况也是时空数据可视化中的重点。此外，还有经济学中的时空经济学，也可以研究经济体在时空中的发展变化。我感觉，时空数据可视化对于国家宏观管理意义非凡。

修改chartSeries绘图结果的x轴标签

Wed, 26 Jun 2013 00:00:00 +0000

用quantmod包中的chartSeries绘图时，x轴标签会默认为中文汉字，看起来不太美观。想要修改制图结果吧，chartSeries函数中没有提供可设置x.labels的参数。原来chartSeries函数会自动识别系统语言并根据系统语言生成x.labels。这样的话，只要我们把自己的系统语言更改为英语，就应该显示为更为整洁的英文了。

require(quantmod)
getSymbols("AAPL")
chartSeries(AAPL,theme="white")

Sys.setlocale("LC_TIME","english")
chartSeries(AAPL,theme="white")

不过，这个好像不怎么重要吧？

R中的金融分析包：quantmod学习笔记补充版

Wed, 12 Jun 2013 00:00:00 +0000

很久之前在统计之都论坛发了一个quantmod包的学习笔记。听说后来流传很广泛。因为当时我也是初学quantmod，所以，该版本笔记中有很多错漏之处，同时笔记的叙述结构也不太合理。一直我都想修订一版出来作为补充。修订的版本现在在这里可以看到。

供大家参考，如果有什么建议和意见，请不吝指正。

安装mgarch包终极解决方案

Mon, 10 Jun 2013 00:00:00 +0000

mgarch包是一个可以拟合和诊断BEKK模型的R包。包中的主函数很少，只有mvBEKK.sim，mvBEKK.diag，mvBEKK.est三个。这三个函数各司其职，分别用来模拟BEKK数据、诊断BEKK模型、拟合BEKK模型。照常理说，这样的包很好啦。就只有一样不好，作者自从2009年更新一次之后，再也不提供更新的.zip包了。很多需要拟合BEKK模型的同学急得团团转就是不知道怎么安装和使用这个包。这里提供三个方案：

方案一：

下载mgarch的源代码包mgarch_0.00-1.tar.gz。解压缩到R的当前工作文件夹中。如果不知道当前工作文件夹路径。敲入get.wd()函数就可以看到了。解压缩之后，按照mgarch->>R的顺序打开文件夹，你会在R文件夹中看到好几个.r格式的文件。用source()函数载入进来就可以用了。

方案二：

拿着mgarch包，按照开发R程序包之忍者篇自己编译mgarch包。

方案三:

这个方案跟方案二类似，也得先安装Rtools，目的是可以编译源代码。同时，由于mgarch依赖于zoo、tseries、mvnorm三个支撑包，所以，也得捎带手安装一下，并保证它们被升级了到合适的版本。接着，将mgarch_0.00-1.tar.gz放到当前工作文件夹中（不知道当前工作文件夹是哪个？看方案一）。最后，敲入下面的代码：

install.packages("mgarch_0.00-1.tar.gz",repos=NULL,type="source") ##安装源代码文件
library(mgarch) ##查看是否可以使用

安装mgarchBEKK包

Sat, 08 Jun 2013 00:00:00 +0000

R中另外一个拟合BEKK模型的包是mgarchBEKK。这个包跟前面提到的mgarch包类似。主函数也基本一样，分别是mvBEKK.sim、mvBEKK.est、mvBEKK.diag等。这个包作者已经很久没有更新了，好像已经放弃更新。但是有不少人还想用它。我们现在能在quantmod包的主页找到该包的源代码，但不巧的是源代码包中缺失了namespace。不过，没关系，我们可以为其添加一个namespace即可。添加完之后，压缩为.tar格式的压缩包（已添加完namespace的mgarchBEKK可以到这里下载），再按照前面提到的安装方式进行安装即可。

有用但不易被发现的R函数：file.choose

Mon, 03 Jun 2013 00:00:00 +0000

用R进行数据分析的时候，常常需要从外部载入数据或者函数。比如，我们有一个名为example.txt的数据位于E盘中的R文件夹中，我们可以用下面的命令把数据读取到R里：

dat = read.table("E://R/example.txt",header=TRUE)

在同样的文件夹中，有一个现成的函数脚本文件命名为fun.r，现在需要将其载入到R中使用。可以用下面的命令:

soure("E://R/fun.r")

上面这两种做法有一个共同点就是得记住文件的绝对路径。绝对路径短的话，没有任何问题。当绝对路径很长，长到记不清楚的时候就麻烦了。

一个偷懒的做法是使用setwd()设定工作文件夹。比如，我们可以把R的工作路径设定为E://R/：

setwd("E://R/")

然后，载入数据或者函数就可以用简化的命令了：

source("fun.r")
dat <- read.table("example.txt",header=TRUE)

如果连E://R/都记不清楚呢？那就只能搞一个浏览窗口了。R中恰好有这个函数：file.choose()

source(file.choose())
dat <- read.table(file.choose(),header=TRUE)

运行之后，R会弹出一个Select File的小窗口，挥动鼠标就可以对各个盘符和文件夹进行选择了。

自动下载财务套表

Mon, 27 May 2013 00:00:00 +0000

在国内获取上市公司的财务数据是一件叫人头疼的事儿。对于没有Wind终端的个人而言，只有一条路：那就是从网络上抓取。当然，这还是有前提的，那就是网上得有数据可抓。很长一段时间，我都受此困扰，跋山涉水之后，终于从sina财经找到了一个可以下载上市公司历年财务套表的接口，用R写一段自动下载的代码，就可以轻松获取上市公司财务数据了（耶！好开心，妈妈再也不用担心我的的数据来源了！）。

代码真相在这里：

# symbol：股票代码
# type：报表类型。BS为资产负债表；PS为利润表；CF为现金流量表
# file:存储下载文件的地址。比如，file="D://"

getsheets <- function(symbol,type,file){
 pre="http://money.finance.sina.com.cn/corp/go.php/vDOWN_";
 mid="/displaytype/4/stockid/";
 end="/ctrl/all.phtml";
 
 if(type=="BS"){
 url=paste(pre,"BalanceSheet",mid,symbol,end,sep="");
 destfile=paste(file,"BalanceSheet_",symbol,".xls",sep="");
 }
 else if(type=="PS"){
 url=paste(pre,"ProfitStatement",mid,symbol,end,sep="");
 destfile=paste(file,"ProfitStatement_",symbol,".xls",sep="");
 }
 else if(type=="CF"){
 url=paste(pre,"CashFlow",mid,symbol,end,sep="");
 destfile=paste(file,"CashFlow_",symbol,".xls",sep="");
 }
 download.file(url, destfile);
}

运行时如下：

# 下载000065的资产负债表，并存放在D盘
getsheets("000065","BS","D://")

D盘里面有一个叫BalanceSheet_000065.xls的文件，打开就可以看到历年的资产负债表数据了。

从东方财富网获取股票开户数据

Thu, 18 Apr 2013 00:00:00 +0000

股票账户的开户数据对于观察和预测股票市场的冷热程度非常重要。但对于普通的投资人而言，由于没有专业的数据终端，他们是没有太多渠道可以获得股票开户数据的。好在一些网站上经常会公布股票开户数据，这样给普通投资者一个很好的渠道去获取数据。

目前，东方财富网的网页上就提供了逐月的股票账户开户数据，可以供普通投资者参考。

以前有人用R软件中的XML包去抓取上述网页。现在R软件中则提供了httr包和rvest包替代XML去抓取网页。不过，鉴于网站可能有严格的反爬虫机制，这种办法未必可以成功了。我还听说有人用RSelenium包获取网页上的表格数据，这个方案可能更复杂一些，但更可行。

几本关于R的书籍

Thu, 18 Apr 2013 00:00:00 +0000

最近，出版社的朋友推荐了四本在亚马逊上卖的火热的R书籍。大致看了下内容，都算是上乘之作。这里简单介绍一下：

第一本叫《Introductory Time Series with R》。这是Springer出版社的UseR!系列作品，质量绝对是有保证的，内容集中于时间序列分析方面。作者是Paul S.P. Cowpertwait和Andrew V. Metcalfe 。

第二本是《Time Series Analysis: With Applications in R》是Springer统计学系列的一本书，也是专注于时间序列分析，这本书的厚度是第一本书的两倍。

第三本叫《Financial Risk Forecasting: The Theory and Practice of Forecasting Market Risk with Implementation in R and Matlab 》是Wiley出版社Finance Series系列的一本书，比较薄，内容主要集中在金融风险的预测上，更适合搞投资的人来阅读。

第四本是《Software for Data Analysis: Programming with R》是 Springer旗下Statistics and Computing系列的一般书，作者是R领域的大牛人叫John Chambers，我想他的名字是如雷贯耳的，无需多言，只需膜拜。

R中的量化投资包：quantstrat

Wed, 17 Apr 2013 00:00:00 +0000

quantstrat是什么东西？

quantstrat是Quantitative Strategy（量化策略）的缩写，它是由Peter Carl、 Brian G. Peterson、Josh Ulrich、Garrett See、Yu Chen等联合开发的用于量化投资的R包。

这个包为用户提供了一个测试和模拟基于信号的量化策略模型的泛型框架。它不仅可以帮助用户构建交易系统，还可以对构建的交易系统进行仿真测试；能够支持对多资产类别和多币种组合进行回测（backtesting）等。

这个包在设计的过程中充分贯彻了“交易导向型”（Transaction-oriented）原则。

目前，这个包由Brian G.Peterson在维护，还在开发中，不过已经被很多业内人士拿来实战了。

因为quantstrat包是一个建立在xts, FinancialInstrument,blotter等包上的高级抽象包，所以，在应用quantstrat包时，除了除了安装quantstrat包之外，还得记得装上这三个支撑包。看起来安装有点麻烦，正式因为安装麻烦，所以，它才能使得用户用几行简单的代码就能来构建和测试策略。

quantstrat涉及的量化策略基础知识

基于信号的策略的泛型建模

基于信号的策略模型需要先生成交易信号。交易指标是从市场数据中获知的量化指标（包括移动平均、RSI、波动带、通道、动量等）。交易指标应该以矢量化（快速回测）和数据流（实施执行）的形式应用于市场数据，并且假定交易指标是路径独立的（即不受账户、组合类型、现有头寸和交易的限制）。

交易指标和市场数据的相互作用会生成交易信号（交叉、阈值、倍数），交易信号标示交易者应当采取交易行动的时间，虽然，有时候，你无法行动。跟交易指标类似，交易信号也应该以矢量化和流形式应用于市场数据，并且需要假定交易信号是路径独立的。

交易规则基于交易指标、交易信号、账户头寸和账户/组合特性生成交易指令。注意关于头寸大小、填补模拟、指令生成和管理的规则与交易指标和交易信号的生成过程是独立的。与交易指标和交易信号不同，交易规则在是执行时是路径依赖式（事实上，也支持非路径依赖式的交易规则，然而，非路径依赖式的交易规则在现实中很少见）的，与已往市场数据和执行规则时的头寸大小相关。交易规则可以生成新的交易指令，也可以对现有交易指令进行修改（比如风险控制、填补、再平衡、介入、退出等）。

Quantstrat如何构建策略？

quantstrat通过FinancialInstrument包指定金融工具（包括所用币种）、通过blotter包跟踪交易信息和市值及组合和账户的变动。

交易指标通常是跟TTR包中函数类似的标准技术分析函数；交易信号通常有quantstrat包中的sig*族函数指定（比如sigComparison、sigCrossover、sigFormula、sigPeak、sigThreshold）；规则通常有quantstrat包中的ruleSignal函数指定。

用来指定交易指标、交易信号和加以规则的函数不限于上述那些。add.indicator、add.signal、和add.rule的参数为任意R函数。因为支持链是基于xts对象构建的，因此，如果自定义的函数返回结果是xts对象的话，其能够被很好地整合到quantstrat包中。

策略模型以层形式创建，并且是延迟执行的。这意味着策略可以不加调整地应用于多种不同的组合。执行之前，策略不知道自身将应用到何种金融工具上，也不知道将被传递什么参数。例如，移动平均的时间参数和阈值参数很可能影响策略的性能。参数的默认值可以在策略对象中设定，也可以在执行时通过applyStrategy的参数（参数是一个命名列表，跟参数列表的用法类似）来设定。

quantstrat对交易指令进行建模，交易指令可能转化为实际交易，也可能不能转化为实际交易。这提供了一个额外功能，可以用来评估策略是如何工作的、为何不工作以及如何改进。例如，策略的性能经常受到“休息现价订单”的改变、替换和删除的影响。订单允许量化策略师检查决策作出时的市场条件。同时，订单历史使得针对许多策略的颇为重要的计算过程变得简单，比如填补比率的计算。

参数匹配规则

Quantstrat中很多地方会应用到通过策略技术参数传递（参数列表或者…）给交易指标、信号和交易规则函数的变元：

这些变元按照下面的顺序进行匹配，后面的赋值可以覆盖前值。具体的顺序如下: 赋值给每个交易指标、交易信号和交易规则的arguments=list(…)参数；调用applyStrategy是应用的parameters=list{…}参数；调用applyStrategy时，在…中传递的任意附加参数。

乱码，又见乱码

Thu, 13 Sep 2012 00:00:00 +0000

在Windows系统下，用readHTMLTable函数读取编码为unicod的网页时会出现乱码。这个时候的乱码是因为R是用本地码（通常是GBK）来解释了网页中的unicode，因此出现了符号不兼容。此时，只要用iconv(x,“utf-8”,“gbk”)就可以了。然而，有时候会出现另外一种情况：

library(XML);
url="http://data.caixin.com/macro/macro_indicator_more.html?id=F0001&cpage=2&pageSize=30&url=macro_indicator_more.html#top";
tables=readHTMLTable(url)
head(tables)

这种情况下icnov好像就无能为力了。不过，事情还是有解决方案的，在readHTMLTable之前加上一句代码就可以了。

url= htmlParse(url,encoding="UTF-8")

看看效果：

library(XML)
url <- "http://data.caixin.com/macro/macro_indicator_more.html?id=F0001&cpage=2&pageSize=30&url=macro_indicator_more.html#top"
url<- htmlParse(url,encoding="UTF-8")
tables <- readHTMLTable(url)
head(tables)

获取上市公司主要财务指标

Fri, 07 Sep 2012 00:00:00 +0000

写了一段获取上市公司主要财务指标的代码：

# 加载XML包
library(XML)
####id:股票代码
####year:年度
get.finance <- function(id,year,...){
 web <- paste("http://money.finance.sina.com.cn/corp/go.php/vFD_FinancialGuideLine/stockid/",id,"/ctrl/",year,"/displaytype/4.phtml",sep="")
 tables <- readHTMLTable(web)$BalanceSheetNewTable0
 colnames(tables)<-tables[1,]
 tables <- tables[-1,]
 return(tables)
}

简单演示一下：

library(XML)
res <- get.finance("000002","2012")

基于这些财务数据和价格数据，就可以着手建立股票排名系统了。

R中的斯皮尔曼等级相关检验与异方差

Thu, 16 Aug 2012 00:00:00 +0000

有一种异方差表现为模型的残差与自变量相关，也就是说，模型残差随着自变量增大而变大或者反之。在这种情况下只要度量模型的残差与自变量的相关性就可以确定是否有异方差了。如果自变量是连续变量，则普通的相关性检验就可以奏效。倘若自变量是年龄、职业、气候等定型变量时就得考虑别的方法了。

此时，斯皮尔曼等级相关检验是个不错的选择。斯皮尔曼等级相关检验是一种非参数检验方法，它的大致原理是这样的：

如果变量和变量相关，那么，将两者按照大小排序，则两者的顺序应该是相仿的，若两者相关性弱，则两者的顺序没有明显的一致性。

举个简单的例子：

 x <-c(25,40,54,58,68)
 y <-c(1.6,2.9,10.7,14.8,5.7)

上下对应，下面按照的大小进行排序，则能看到下面的结果：

rank(x)

## [1] 1 2 3 4 5

rank(y)

## [1] 1 2 4 5 3

rank(x)-rank(y)

## [1] 0 0 -1 -1 2

构造统计量，容易知道等于1时，两者正相关；等于-1时两者负相关。设定原假设统计量为零，该统计量近似服从均值为0，方差为的正态分布，由此可对其进行假设检验。

R中pspearman包中的spearman.test函数可以完成斯皮尔曼等级相关检验：

# 安装包，如果未安装
# install.packages("pspearman")
library(pspearman)
x=c(25,40,53,58,68)
y=c(1.6,2.9,10.7,14.8,5.7)
spearman.test(x,y)

## 
## 	Spearman's rank correlation rho
## 
## data: x and y
## S = 6, p-value = 0.2333
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho 
## 0.7

也可用cor.test函数来检验：

cor.test(x,y,method="spearman")

## 
## 	Spearman's rank correlation rho
## 
## data: x and y
## S = 6, p-value = 0.2333
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho 
## 0.7

棘手的R乱码和给力的iconv函数

Wed, 09 May 2012 00:00:00 +0000

从网上抓数据（网页是utf-8编码）时，发现读入R的数据出现了乱码。代码和返回结果分别如下：

library(XML)
id="000002"
year="2011"
web=paste("http://money.finance.sina.com.cn/corp/go.php/vFD_FinancialGuideLine/stockid/",id,"/ctrl/",year,"/displaytype/4.phtml",sep="")
web
[1] "http://money.finance.sina.com.cn/corp/go.php/vFD_FinancialGuideLine/stockid/000002/ctrl/2011/displaytype/4.phtml"
tables head(tables)

涓囩A(000002) 璐一姟镌囨爣 NA
1 鎶ュ憡镞ユ湡 2011-12-31
2 姣忚偂镌囨爣
3 鎽婅杽姣忚偂鏀剁泭(鍏\x83) 1.055
4 锷犳潈姣忚偂鏀剁泭(鍏\x83) 0.88
5 姣忚偂鏀剁泭_璋冩暣鍚\x8e(鍏\x83) 0.88
6 镓ｉ櫎闱炵粡甯告ф崯鐩婂悗镄勬疮镶℃敹鐩\x8a(鍏\x83) 0.87
NA NA NA
1 2011-09-30 2011-06-30 2011-03-31
2
3 0.3735 0.2958 0.1082
4 0.326 0.27 0.11
5 0.326 0.27 0.11
6 0.321 0.27

去COS咨询了一番，都说运行完我提供的代码之后没有出现乱码。当时的我有些凌乱。心中苦闷得很，难道R代码的运行结果还跟运行者相关么？如果R语言真能发展到如此智能的地步，我定然乐不可支。当然，这是题外话了，按住不说。

于是，我泡在论坛上翻了无数旧帖，最终发现了李舰和陈丽云讨论的结果。他们说R中出现乱码后可以用Encoding来解决。在这个原则指导下我各种Encoding，却回回都是无功而返。思考再三，我觉得可能是电脑的问题。

只是电脑的问题那么多，根源在哪儿呢？我贴出了自己的sessionInfo，想找出问题的根源。幸好有人跟帖也贴出了sessionInfo。对比之下才发现问题出在电脑系统的内部编码上。他们几人所用的都是Linux平台，内部编码设定都是utf。而我苦苦耗在的Windows平台上，系统的内部编码是gbk。

好了，找到了病根。下一步只要修改一下Windows系统的内部编码就行了。我正欢欣鼓舞呢，颜林林却说，Windows系统没法修改系统编码。好吧!我就像一个病人在熟读各种医书终于发现病根所在之时，却被告知没有药材。绝望之情状如井喷。

至此，我几近投奔Linux了。结果，无意中见到一个人用iconv函数解决类似的问题。看起来效果不错，我就尝试了一下：

rownames(tables)<-iconv(tables[,1],"UTF-8","gbk")
head(tables[,-1])

虽然不知道什么原理，但问题毕竟是解决了。

R语言在线资源列表

Sun, 19 Feb 2012 00:00:00 +0000

http://alittleknowledge.wordpress.com/2009/09/11/r-for-pedestrians/ http://astro.u-strasbg.fr/~fmurtagh/mda-sw/ http://bayes.bgsu.edu/bcwr/ http://biocep-distrib.r-forge.r-project.org/doc.html http://biostatistics.iop.kcl.ac.uk/publications/everitt/ http://blog.opendatagroup.com/courses/ http://bm2.genes.nig.ac.jp/RGM2/index.php?clear=all http://cm.bell-labs.com/cm/ms/departments/sia/project/trellis/ http://code.google.com/p/batchfiles/ http://commons.wikimedia.org/wiki/Category:Created_with_R http://csde.washington.edu/statnet/ http://dataspora.com/blog/predictive-analytics-using-r/ http://ecology.msu.montana.edu/labdsv/R/ http://ess.r-project.org/ http://factominer.free.fr/ http://faculty.ucr.edu/~tgirke/Documents/R_BioCond/R_BioCondManual.html http://faculty.washington.edu/tlumley/Rcourse/ http://gking.harvard.edu/readme/ http://grass.itc.it/statsgrass/grass_geostats.html http://greg.weebly.com/1/post/2008/10/programming-in-r-makes-serious-statistics-serious-fun.html http://igraph.sourceforge.net/documentation.html http://www.inside-r.org/ http://jblevins.org/computing/r/ http://jgr.markushelbig.org/JGR.html http://learnr.wordpress.com/ http://lethain.com/ http://math.acadiau.ca/ACMMaC/Rmpi/examples.html http://mathesaurus.sourceforge.net/ http://mathstat.helsinki.fi/openbugs/ http://mccammon.ucsd.edu/~bgrant/bio3d/index.html http://people.biology.ufl.edu/bolker/emdbook/ http://personality-project.org/r/ http://pj.freefaculty.org/R/Rtips.html http://pj.freefaculty.org/R/statsRus.html http://planatscher.net/svmtut/svmtut.html http://processtrends.com/Learn_R_Toolkit.htm http://rocr.bioinf.mpi-sb.mpg.de/ http://rosuda.org/JRI/ http://rpy.sourceforge.net/ http://ryouready.wordpress.com/2009/03/16/r-monitor-function-progress-with-a-progress-bar/ http://socserv.mcmaster.ca/jfox/ http://socserv.socsci.mcmaster.ca/jfox/Courses/R-course/index.html http://stats.math.uni-augsburg.de/Mondrian/ http://tables2graphs.com/doku.php http://tolstoy.newcastle.edu.au/R/ http://users.fmg.uva.nl/rgrasman/rpages/2005/09/error-bars-in-plots.html http://wiener.math.csi.cuny.edu/Statistics/R/simpleR/ http://wiki.math.yorku.ca/index.php/R:_Getting_started http://wiki.services.openoffice.org/wiki/R_and_Calc http://wiki.stdout.org/rcookbook/ http://www.agr.kuleuven.ac.be/vakken/statisticsbyR/index.htm http://www.ai.rug.nl/~hedderik/R/US2004/ http://www.ats.ucla.edu/stat/R/ http://www.bioconductor.org/ http://www.burns-stat.com/ http://www.cerebralmastication.com/r-resources/ http://www.ci.tuwien.ac.at/gR/ http://www.cl.cam.ac.uk/~sjm217/projects/graphics/ http://www.cyclismo.org/tutorial/R/ http://www.daimi.au.dk/~besen/TBiB2007/lecture-notes/rpy.html http://www.decisionsciencenews.com/?p=261 http://www.decisionsciencenews.com/?p=264 http://www.drewconway.com/zia/?p=1221 http://www.econ.uiuc.edu/~econ472/e-Tutorial.html http://www.faculty.ucr.edu/~tgirke/Documents/R_BioCond/R_Programming.html http://www.harding.edu/fmccown/R/ http://www.ibm.com/developerworks/linux/library/l-r1/ http://www.johndcook.com/R_language_for_programmers.html http://www.liaad.up.pt/~ltorgo/DataMiningWithR/ http://www.math.montana.edu/Rweb/Rnotes/R.html http://www.math.umass.edu/~lavine/Book/book.html http://www.math.yorku.ca/SCS/Gallery/ http://www.maths.bath.ac.uk/~jjf23/book/ http://www.mayin.org/ajayshah/KB/R/ http://www.nettakeaway.com/tp/?s=R http://www.nickfieller.staff.shef.ac.uk/sheff-only/statmod.html http://www.nytimes.com/2009/01/07/technology/business-computing/07program.html?_r=1 http://www.omegahat.org http://www.personality-project.org/r/ http://www.personality-project.org/r/r.anova.html http://www.phaget4.org/R/image_matrix.html http://www.phaget4.org/R/R_notes.html http://www.psych.upenn.edu/~baron/rpsych/rpsych.html http://www.r-bloggers.com/ http://www.r-cookbook.com/ http://www.rdatamining.com/ http://www.revolution-computing.com/ http://www.rosuda.org/iplots/ http://www.rparallel.org/examples.php http://www.santafe.edu/~aaronc/powerlaws/ http://www.sfu.ca/~sblay/R/ http://www.splusbook.com/Rintro/RCourseMaterial.html http://www.stat.auckland.ac.nz/~paul/RGraphics/rgraphics.html http://www.stat.columbia.edu/~gelman/bugsR/ http://www.stat.pitt.edu/stoffer/tsa2/ http://www.stat.tamu.edu/~ljin/Finance/stat689-R.htm http://www.stat.ucl.ac.be/ISdidactique/Rhelp/ http://www.stat.ufl.edu/~aa/cda/cda.html http://www.stat.umn.edu/alr/R.html http://www.stat.umn.edu/geyer/5102/examp/reg.html#predplot http://www.stat.wisc.edu/~deepayan/SIBS2005/demos/trellis-graphics.html http://www.statistik.lmu.de/~leisch/Sweave/ http://www.statmethods.net/index.html http://www.stats.ox.ac.uk/pub/MASS4/ http://www.statslab.cam.ac.uk/~pat/ http://www.student.uit.no/~felsted/rtips/rtips_html/rtips.html http://www.theresearchkitchen.com/blog/archives/category/project-euler http://www.togaware.com/ http://www1.maths.lth.se/help/R/RCC/ [http://www2.warwick.ac.uk/fac/sci/moac/degrees/modules/ch923/r_introduction/histograms_etc/ http://wwwmaths.anu.edu.au/~johnm/](http://www2.warwick.ac.uk/fac/sci/moac/degrees/modules/ch923/r_introduction/histograms_etc/ http://wwwmaths.anu.edu.au/~johnm/) http://www-stat.stanford.edu/~jhf/R-MART.html http://xweb.geos.ed.ac.uk/~hcp/r_notes/r_notes.html http://zoonek.free.fr/blosxom/R/2006-08-27_The_Grammar_of_Graphics.html http://zoonek2.free.fr/UNIX/48_R/all.html

R是一种生活，数据是一种态度

Wed, 08 Feb 2012 00:00:00 +0000

有多少人听说过R软件？有多少人用过R软件？你现在最常用的软件是什么？SAS？SPSS？EViews?如果你是一个经常和数据分析打交道的人，或者从事金融建模，数学建模的人员，还不用R，你就有点out了。如果现在不学R，五年后你没有任何优势可言；如果5年后，你还不学R，那你差不多就可以被淘汰了。

接下来，我先介绍一下R软件，然后，会详细的讲解为什么你不用R就会out。

R是有Ross Ihaka跟Robert一起开发的一个面向对象的编程语言。什么是面向对象呢？就像现在，我在这里演讲，直接看见你们，你们就是我面向的对象，当然，这是开玩笑。面向对象的意思就是，R里面的一切东西都是视为对象（Object）。无论是数据框、列表还是函数或者环境，这里先不讲，免得把大家吓跑了。

R语言的前身是S语言，这个语言一度是数据分析领域里面的标准语言。当然，现在也是，但是正在逐步被R语言取代。S语言是由贝尔实验室开发的，贝尔实验室开发了很多经典的东西，S是其中之一。S语言的缺点是它不是免费的，而R最大的优点在于R是免费的。

现在很多人用SPSS，SAS,MatLab，但是用的都是盗版软件。从法律上来讲这是非法的，但是非法的东西在中国很流行，很多教授也用这些非法软件，并且还帮着同学去获取盗版软件，其实，这不太可取。当然，在感情上我予以充分理解。

上次去上海参加第4届R会议，来了一个嘉宾是新西兰人，新西兰是R的故乡，中间熊熹提到她复印了一本ggplot2的书，被外国人看到，外国人就问她征求过版权问题吗？在外国人看来这是很严肃的事情。当然，这是题外话。

免费是R很大的优点，但不是唯一的。R的最大优点是出色的作图功能、丰富的统计学方法以及超快的更新速度。下面讲一下R的各种功能。

首先，R可以作为计算器使用，例如（屏幕演示）。其次，出色的绘图功能，例如（屏幕演示，直方图，小提琴图），还可以绘制一些高级的图形，向日葵图，玫瑰花瓣图，脸谱图。当然，这是最基本的功能。虽然很基本，SPSS这些软件是不可能做到这么完美的。R的画图分四个层级，最基本的就是刚才演示的。高级一点的是grid，然后是，Lattice，Lattice的图形是这样的（屏幕演示），很适合做多元数据展示。grid是这样的（屏幕演示），grid图形引入了图层概念，并且可以切换图形的视角。举个例子：（A4纸演示），接下来是ggpolt2：ggplot2是一个更具有创新性的绘图设备，它创建了自己的语法，相当于R里面有创建了一门新的绘图语言。ggplot2的功能是这样的（屏幕演示）。最后，比较终极的绘图BOSS是ggobi，这是一个动态的绘图软件，交互性很强，不过可能很快要被谢益辉的cecran给取代了。后者是前者的加强版。

然后，就是R建模。R的建模能力超强。建立线性模型，只需要用lm函数就可以了，广义线性模型glm就可以了，广义可加模型gam就可以了。

然后是，时间序列分析。这个很有用的。我觉得，对于本科生也好，研究生也好，想基于一元或者多元回归做一个比较上层次的论文是困难的。但是，用时间序列分析是可以的，可以用arima，说到这里很多人就笑了，arima这个我知道，终于听到一个自己知道的模型了，其次是garch模型。我知道很多人做garch模型用EViews，但是这个软件太老了，极其不智能，稍微高级的方法都用不了。加一个外生变量要折腾半天。而且最重要的是你用的是盗版软件，话说过来，即使是正版的Eviews也不智能。R里面做garch模型就很简单，用rgarch包就可以了，可以构建各种高级的garch模型，tgarch，igarch，gjrgarch之类的，还有高级的Dccgarch，可能你又听不懂了，还有更高阶的BEKK模型，BEKK没什么神秘的，其实就是多元GARCH模型，就是把GARCH模型从一维推广到了二维了。还有更高阶的，因为参数估计起来太麻烦，所以应用比较少。

Rgarch包还能计算VaR。也就是Value at Risk。风险价值。这个东西很高级，没有听过吧？其实，我认为上了大三的人就应该很熟悉VaR。但是很多人不知道，因为中国的教育不太成功，我们叫不成功，不叫失败，免得打击教育部。高校的老师，怎么说呢，比较善于推己及人。他们当年读大三的时候，就不懂得VaR，他们复习半年，考上研究生的时候也不怎么懂。所以他们认为别的本科生也不懂，或者说没有能力懂。他们对中国的学生太没有信心了。其实，VaR的概念并不是很难。（演示）

这就是VaR，其实就是分位数。分位数其实就是对密度函数求变上限的积分，求变上限的积分都会吧？不过，也不用手动求，用R就可以了。

理论上讲，只要知道了密度函数，求积分不在话下。所以求密度函数其实是VaR的核心。根据求VaR密度函数的方法的不同，可以将它分成三种重用的方法，历史模拟法，蒙特卡洛模拟法，方差-协方差法。历史模拟法就是用历史数据的密度函数代替未来的密度函数，蒙特卡洛模拟法就是假设一个分布，模拟一批随机数。说到随机数，想起来本科期间一件事情，当时精算专业要生成随机数，一批学生不知道怎么做，在Excel里面瞎折腾。我就想不明白，为什么不用R呢，产生正态分布的随机数rnorm(5)就可以了，产生5万个，rnorm(50000)，在Excel里面，折腾死你。

蒙特卡洛模拟完随机数，就根据这一批样本来计算VaR。方差-协方差呢，跟这个不同，它求的是条件密度函数，理论上讲应该更准确。历史模拟法对历史区间的选择很敏感；蒙特卡洛对分布的假设很敏感，正态分布假设和t分布假设结果相差很大；方差-协方差对厚尾与否很敏感。

如果是单个资产的话，像上面这样求分位数就搞定了。资产组合的时候，要知道联合分布，才能求分位数。联合分布怎么求，最新的方法是Copula。简单而言就是个复合函数：假设你有联合分布函数F(x1,x2,x3,…)，有边际分布，f(x1),f(x2),f(x3)…要找到要个函数H（·）使得F(x1,x2,x3,…)=H（f(x1),f(x2),f(x2)…）。

这个函数就是Copula。这是工作原理，操作起来有一系列复杂的技术。当然，求解这个过程计算机会帮忙的，不需要手算。君子善假于物也。

本科生的时候做过一个项目是关于VaR的。当时学校的一个老师提出过质疑，因为VaR的最初定义是是关于头寸的。而R里面是基于收益率的。两者在测量风险方面没什么差异。但是，他非得坚持算头寸。答辩的时候，我跟他讲这是很容易换算的，他问怎么容易。我就解释给他，当时年少无知，连续向他发问，我估计他很久没有看最新的VaR文献了，因此，我质疑的问题，他一个都答不上来，后面听答辩的同学，开始欢呼，掌声雷动。我很了解同龄人，大家都喜欢看见权威被打倒。这是潜在的暴力倾向，我很不喜欢。值得注意的是，刘姝威老师也在下面拍手。

现在想起来当时太冲动了，事后我试图向那个老师道歉。当然，不是因为我用错了方法，只是因为我用错了态度。我觉得一个人还是应该尊重另一个人的。

刘姝威老师后来说，本科生能做出来这个VaR是很不容易的。我当时心里很舒服，得到了赞赏。后来想想，这个赞赏的代价很大。VaR明明很容易计算，她却因为这个儿称赞我，那不是在贬低其他所有的不会算VaR的同学吗？这是我后来想明白的。

R还能做极值理论。今年上海交大的一个研究生问我用R作极值理论的东西，我就帮他说了一下，他说帮了他大忙。说要感谢我，我说不用，在论文后面，鸣谢一下就可以了。其实，我心里一直在怀疑，研究生要毕业了，极值理论都还不懂，研究生到底读的是神马？更进一步，这样的人为什么能踏过研究生的门槛，问什么能考上研究生呢？中国的研究生录取机制有问题。

再之外，R在数据挖掘领域是顶呱呱的。里面有各种方法，比如随机森林，支持向量机，Lasso等。什么是Lasso，也许你说，那是lasso，我跟你说，你说错了，这个单词的重音在第二个。关于这方面，刘思喆是专家，你们可以到论坛上或者微博上咨询他。

R能做的东西很多。那有没有R不能做到的事情？让我想一想，好像还真有。比如，R好像不能下电影，看电影，听音乐。不过，R里面却是提供了很多高级的工具，它提供了一个hook，可以启动电脑中的其他程序，比如迅雷，可以自动下载网页附件，自动解压缩，读入数据等等。很多R粉丝甚至用R关机，用R发微博，发校内状态。R能给人很多惊喜，比如用R下五子棋，扫雷，玩儿递归汉诺塔。做贺卡，马赛克图，这里面是什么知道吗？是AV女优，不信你看看，是不是发现了很多熟人？

话说回来，很长一段时间里。SPSS,SAS,Matlab还会继续存在，不会骤然消失。我甚至认为这些软件不会消失。因为他还是有自己的受众的。你不能要求所有人的都学习R编程。

这些软件也有些优点，我最喜欢Matlab，他跟R有点像。好吧R跟matlab有点像，免得伤害Matlab user的感情。曾经有一个人发了一段代码，让用R实现。我不知道那人是什么动机。是想看看R能不能做到，还是想看看COS有没有人会。很不好意思，我两者都会一点，于是我就用R重现了那个过程，代码极其简单。后来，那人说，太牛了，这都能做到。其实，我想说，这不算什么。真的。牛人都在做更重要的事情。

我希望将来随着时日推移、随着SPSS，SAS，Matlab这一批老人家的辞世，R能快速的成长起来，老人家不愿意学编程，这一点我是很理解的，但是，他们阻碍了R的崛起，R将来势必是一种潮流。

目前，市场上流行一个观点。即数据越便宜，数据分析技术越昂贵。我早就意识到了这个问题，目前中国获取数据很难，大家都把数据当资源来买。国外就是不一样，国外开放很多数据，因为国外认为，数据里面的信息才是资源。我把数据源放开，你有本事就从里面寻找信息吧。所以，国外分析数据的人就很贵。

将来，中国的数据提供商肯定会转型，会开始搞咨询，搞分析，而不是单纯的卖数据。卖数据没有前途。他们不卖数据了，数据分析师就会开始值钱了。这一天，我相信很快就到来了。

R这么好，如何学习R呢?我推荐一些材料给大家。一个是Rforbeginner，R导论。看完之后，看一下Rin a Nutshell，接着看The R book或者Statistics with R。这些资源基本都是开放的。

你们也可以跟着学校的老师学，如果有用R的老师的话，实在不行就靠自己自学，来论坛问也是可以的。

总之，R是一片广阔的海域，你认为自己有理想，就放马过来吧。加入时代的浪潮，Come on!最后一点希望，希望在做的各位，将来毕业时都能够写出一篇漂亮的论文，不要抄袭！

祝各位身体健康，天天快乐，谢谢！

quantmod:R中的金融分析包（学习笔记）

Mon, 06 Feb 2012 00:00:00 +0000

很久之前随手写了一份quantmod学习笔记，本来只是随手涂鸦，后来竟然出乎意料地广泛流传。因为那个册子格式混乱，结构也没有筹划，因此一直想着重新写一份。目前还没写完，但已经大致可以看了，先发出来，共需要的人来看，也便于大家提些意见。

下载：notes on quantmod。

weibo数据开发思路

Wed, 01 Feb 2012 00:00:00 +0000

weibo开放了API提供了众多的接口。只是这些接口对于非开发人员而言过于复杂，不利于weibo数据的开发和挖掘。

李舰结合weibo的API以及TwitteR包编写了一个叫Rweibo的包，然而Rweibo包的使用方法也相当繁琐。根据自己的需要，我整理了一下weibo数据的开发思路，需要建立的是这样一套东西：

应当具有的功能：

1.获取用户A在时间t至时间t+k之间发布的所有微博正文文本内容。

对应的函数为：weibotext(A,from=t,to=t+k)。

该函数有三个参数：分别表示用户ID、起始时间t和截止时间t+k。

2.获取用户A发布的某条微博W的被转发次数和被评论次数。

3.获取用户A当前的粉丝数量。

4.获取用户A当前关注的用户数量。

R语言书籍的学习路线图

Thu, 19 Jan 2012 00:00:00 +0000

现在对R感兴趣的人越来越多，很多人都想快速地掌握R。然而，由于目前大部分高校都没有开设R课程，这就导致很多人不知道如何着手学习R。

对于初学R，最常见的方式是看看百度上的简介。遇到不会的地方，就跑到论坛上吼一嗓子，然后欣欣然（得到解答）或者悲伤（未得到解答）地离去。一直到遇到下一个问题再回来。当然，这不是最好的学习方式。最好的方式是看书。

目前，市面上介绍R语言的书籍已经很多，中英文都有。那么，众多书籍中，一个菜鸟应该从哪一本入门呢？入门之后如何才能把自己练就成某个方面的高手呢？相信这是很多人心中的疑问。有这种疑问的人有福了，因为笔者将根据自己的经历总结一下R书籍的学习路线图以使大家少走些弯路。

本文分为6个部分，分别介绍初级入门、高级入门、绘图与可视化、计量经济学、时间序列分析和金融等。

1.初级入门

《An Introduction to R》，这是R官网公布的入门小册子，其有中文版，由丁国徽翻译的，译名是《R导论》。《R4Beginners》，这本小册子有中文版应该叫《R入门》。除此之外，还可以去读刘思喆的《153分钟学会R》，对R有一个感性的认识，这个册子收集了R初学者提问频率最高的153个问题。为什么叫153分钟呢？因为最初作者写了153个问题，阅读一个问题花费1分钟时间，全局下来也就是153分钟了。有了这些基础之后，要去读一些经典书籍比较全面的入门书籍，比如《统计建模与R软件》，国外还有《R Cookbook》和《R in action》（中文翻译为《R实战》）等。

最后隆重推荐《R in a Nutshell》，直译是“果壳里面的R”。当然，这是开玩笑的，”in a Nutshell“是英文俚语，意思是“简单的说”。很多技术类书籍都有Nutshell版本，这类书籍一般翻译为”**核心技术手册“，目前，我们已经译好这本书的中文版，预计今年会面世。这本书很不错，深度和广度都超越同类书籍，大家可以从现在开始期待，并广而告知一下！

2.高级入门

读了上述书籍之后，你就可以去高级入门阶段了。这时候要读的书有两本很经典的。《Statistics with R》和《The R book》以及《Modern Statistics with S》。之所以说这三本书高级，是因为这三本书已经不再限于R了，而是结合了数据分析的各种常见方法来写就的，比较系统的介绍了R在线性回归、方差分析、多元统计、R绘图、时间序列分析、数据挖掘等各方面的内容。看完之后你会发现，哇，原来R能做的事情这么多，而且做起来是那么简洁。

读到这里已经差不多了，剩下的估计就是你要专门攻读的某个方面内容了。下面大致说一说。

3.绘图与可视化

亚里斯多德说，“较其他感觉而言，人类更喜欢观看”。因此，绘图和可视化得到很多人的关注和重视。那么，如何学习R画图和数据可视化呢？再简单些，如何画直方图？如何往直方图上添加密度曲线呢？我想读完下面这几本书你就大致会明白了。

首先，画图入门可以读《R Graphics》，个人认为这本是比较经典的，全面介绍了R中绘图系统。该书对应的有一个网站，google之就可以了。更深入的可以读《Lattice：Multivariate Data Visualization with R》，Lattice是R中针对多元数据可视化而开发的一套绘图系统。上面这些都是比较普通的。对应的有比较文艺和优雅的ggplot2系统，看《ggplot2：Elegant Graphics for Data Analysis》，中文版是《ggplot2:数据分析与图形艺术》。这本书理论性较强，实战比较弱。与之互补的要推荐《The R Graphics cookbook》，中文对应的是《R图形可视化手册》，译者是邓一硕、魏太云和肖楠，这本书详细列举了所有常见数据分析图形的绘制方法，适合做工具书。再有就是交互式图形的书了，著名的交互系统是ggobi，这个我已经喜欢多年，关于ggobi的书有《Interactive and Dynamic Graphics for Data Analysis With R and GGobi》，不过，也只是适宜入门，更多更全面的还是去ggobi的主页吧，上面有各种资料以及包的更新信息。

此外，R还推出了shiny和rChart以及rechart等包，可以将图形绘制到网页上，这个可以说是未来的主流，不得不关注。

特别推荐一下，中文版绘图书籍中谢益辉的《现代统计图形》和我们翻译的《R图形可视化手册》。

4.计量经济学

关于计量经济学，首先推荐一本很薄的小册子:《Econometrics In R》，做入门用。然后，是《Applied Econometrics with R》，该书对应的R包是AER包，可以安装之后配合使用，效果甚佳。计量经济学中很大一部分是关于时间序列分析的，这一块内容在下面的地方说。

5.时间序列分析

时间序列书籍的书籍分两类，一种是比较普适的书籍，典型的代表是：《Time Series Analysis and Its Applications ：with R examples》。该书介绍了各种时间序列分析的经典方法及实现各种经典方法的R代码，该书有中文版。如果不想买的话，建议去作者主页直接下载，英文版读起来很简单。时间序列分析中有一大块儿是关于金融时间序列分析的。这方面比较流行的书有两本《Analysis of financial time series》，这本书的最初是用的S-plus代码，不过新版已经以R代码为主了。这本书适合有时间序列分析基础和金融基础的人来看，因为书中关于时间序列分析的理论以及各种金融知识讲解的不是特别清楚，将极值理论计算VaR的部分就比较难看懂。另外一个比较有意思的是Rmetrics推出的《TimeSeries FAQ》，这本书是金融时间序列入门的东西，讲的很基础，但是很难懂。对应的中文版有《金融时间序列分析常见问题集》。经济领域的时间序列有一种特殊的情况叫协整，很多人很关注这方面的理论，关心这个的可以看《Analysis of Integrated and Cointegrated Time Series with R》。最后，比较高级的一本书是关于小波分析的，看《Wavelet Methods in Statistics with R》。附加一点，关于时间序列聚类的书籍目前比较少见，是一个处女地，有志之士可以开垦。

6.金融

金融的领域很广泛，如果是大金融的话，保险也要被纳入此间。用R做金融更多地需要掌握的是金融知识，只会数据分析技术意义寥寥。我觉得这些书对于懂金融、不同数据分析技术的人比较有用，只懂数据分析技术而不动金融知识的人看起来肯定如雾里看花，甚至有人会觉得金融分析比较低级。这方面比较经典的书籍有：《Advanced Topics in Analysis of Economic and Financial Data Using R》以及《Modelling Financial Time Series With S-plus》。金融产品定价之类的常常要用到随机微分方程，有一本叫《Simulation Inference Stochastic Differential Equations：with R examples》的书是关于这方面的内容的，有实例，内容详实。此外，风险度量与管理类比较经典的有《Simulation Techniques in Financial Risk Management》、《Modern Actuarial Risk Theory Using R》和《Quantitative Risk Management：Concepts, Techniques and Tools》。投资组合分析类和期权定价类可以分别看《Portfolio Optimization with R》和《Option Pricing and Estimation of Financial Models with R》。

7.数据挖掘

这方面的书有《Data Mining with R:learing with case studies》，《Machine learning for hacks》以及不过《Data Mining with Rattle and R》，书中主要讲了基于Rattle包进行数据挖掘的操作方法，这本书是罕有的全流程数据挖掘工具书，书中详细讲解了从导入数据、清洗数据、数据重整、数据可视化、模型构建、变量选择、模型评价等各个数据挖掘环节，是学习数据挖掘的不二之选。当然，个人比较喜欢Rattle，这本书对应的中文版是《Rattle:R中的数据挖掘GUI》，是由邓一硕、郝智恒、谭丽等翻译的。除了Rattle，Rweka做数据挖掘也很棒。R中数据挖掘方面的包已经足够多了，参考包中的帮助文档就足够了。

R数据分析实例

Fri, 23 Dec 2011 00:00:00 +0000

回归模型（Regression Models）

一元回归
多元回归
非线性回归
稳健回归
岭回归

二分变量及分类模型（Models for Binary and Categorical Outcomes）

Logistic回归（Logistic Regression）
确切Logistic回归（Exact Logistic Regression）
多分类Logistic回归（Multinomial Logistic Regression）
顺序Logistic回归（Ordinal Logistic Regression）
Probit回归（Probit Regression)

计数模型（Count Models）

泊松回归（Poisson Regression）
负二项式回归（Negative Binomial Regression）
零膨胀泊松回归（Zero-inflated Poisson Regression）
零膨胀负二项式回归（Zero-inflated Negative Binomial Regression）
零截断泊松回归（Zero-truncated Poisson）
零截断负二项式回归（Zero-truncated Negative Binomial)

双侧截断回归（Censored and Truncated Regression）

Tobit回归（Tobit Regression）
截断回归（Truncated Regression）
区间回归（Interval Regression）

多因素分析（Multivariate Analysis）

单边多元方差分析（One-way MANOVA）
判别函数分析（Discriminant Function Analysis）
典型相关分析（Canonical Correlation Analysis）
多元回归分析（Multivariate Multiple Regression）

效能/样本量分析（Power Analysis / Sample Size）

单样本t检验（Single-sample t-test）
配对样本t检验（Paired-sample t-test）
独立样本t检验（Independent-sample t-test）
独立比例分析(Two Independent Proportions)
单侧方差分析（One-way ANOVA）
多元回归（Multiple Regression）
参数精度分析（Accuracy in Parameter Estimation）
Logistic回归（Logistic Regression）

其它

潜类分析（Latent Class Analysis）

从股票代码到公司名

Mon, 12 Dec 2011 00:00:00 +0000

Ruser也有Ruser的恶习，经常弄的什么事情都想用R来完成：用R玩儿扫雷、用R玩汉诺塔、用R玩儿黑白棋、用R获取股票数据、用R获取财务数据。

现在想的是，如果已经知道一个股票代码，比如上交所的000061，如何知道其对应的公司名称呢？如果能找到一个数据库，其包含公司名称、公司股票代码、公司简称就可以完成这样的事情了。

最典型的金融数据库有什么呢？google?yahoo? yahoo是可以的。代码：

library(quantmod)
paste(getQuote("000061.ss", what=yahooQF("Name"))[,2])

返回结果如下：

[1] "SSE CORPORATE BON"

R数据分析实例：稳健回归

Fri, 09 Dec 2011 00:00:00 +0000

**按语：**当数据含有离群点（Outliar）或者强影响点（influential observation）时，稳健回归（Robust Regression）会比普通最小二乘法(OLS)的表现要更优异。稳健回归也可以用来检测数据中的强影响点。

提示: 本文旨在介绍与稳健回归相关的R命令，因此，并未全面覆盖稳健回归的相关知识，也不涉及数据清洗、数据检测、模型假设和模型诊断等内容。

文档内容基于R 2.14.0，最后更新于2011年12月19日。

简介

介绍几个线性回归（linear regression）中的术语：

残差（Residual）:基于回归方程的预测值与观测值的差。

离群点（Outlier）:线性回归（linear regression）中的离群点是指对应残差较大的观测值。也就是说，当某个观测值与基于回归方程的预测值相差较大时，该观测值即可视为离群点。离群点的出现一般是因为样本自身较为特殊或者数据录入错误导致的，当然也可能是其他问题。

杠杆率（Leverage）: 当某个观测值所对应的预测值为极端值时，该观测值称为高杠杆率点。杠杆率衡量的是独立变量对自身均值的偏异程度。高杠杆率的观测值对于回归方程的参数有重大影响。

影响力点：（Influence）: 若某观测值的剔除与否，对回归方程的系数估计有显著相应，则该观测值是具有影响力的，称为影响力点。影响力是高杠杆率和离群情况引起的。

Cook距离（Cook’s distance）: 综合了杠杆率信息和残差信息的统计量。

使用最小二乘回归时，有时候会遇到离群点和高杠杆率点。此时，若认定离群点或者高杠杆率点的出现并非因为数据录入错误或者该该观测值来自另外一个总体的话，使用最小二乘回归会变得很棘手，因为数据分析者因为没有充分的理由剔除离群点和高杠杆率。此时稳健回归是个极佳的替代方案。稳健回归在剔除离群点或者高杠杆率点和保留离群点或高杠杆率点并像最小二乘法那样平等使用各点之间找到了一个折中。其在估计回归参数时，根据观测值的稳健情况对观测值进行赋权。简而言之，稳健回归是加权最小二乘回归，或称文艺最小二乘回归。

MASS 包中的 rlm命令提供了不同形式的稳健回归拟合方式。接下来，以基于Huber方法和bisquare方法下的M估计为例来进行演示。这是两种最为基本的M估计方法。在M估计中，要做的事情是在满足约束 $ \Sigma_{i=1}^{n}w_{i}(y_i-x_{i}^{’}b) x_{i}^{’} = 0 $时，求出使得 $\Sigma w_{i}^2e_i^2$ 最小的参数。

由于权重的估计依赖于残差，而残差的估计又反过来依赖于权重，因此需用迭代重复加权最小二乘（ Iteratively Reweighted Least Squares ，IRLS）来估计参数。

举例，第j次迭代得到的系数矩阵为:$ B_j = \left[X^{’}W_{j-1}X-1X]-1X^{’}W_{j-1}Y\right]$ ，这里下脚标表示求解过程中的迭代次数，而不是通常的行标或者列标，持续这一过程，直到结果收敛为止。Huber方法下，残差较小的观测值被赋予的权重为1，残差较大的观测值的权重随着残差的增大而递减。而bisquare方法下，所有的非0残差所对应观测值的权重都是递减的。

Huber权重函数通过阈值参数 $ k $ 控制对异常值的敏感度：

$$ w(e) = \begin{cases} 1 & \text{若 } |e| \leq k \ \frac{k}{|e|} & \text{若 } |e| > k \end{cases} $$

Huber方法特性

‌梯度惩罚‌：对 $|e| > k$ 的残差施加线性惩罚，平衡效率与鲁棒性
‌连续性‌：权重函数在 $ |e| = k $ 处连续但不可微分
‌参数选择‌：典型值 $ k = 1.345\sigma $，覆盖约95%的正态分布数据

Bisquare权重函数采用平滑的二次递减形式：

$$ w(e) = \begin{cases} \left(1 - \left(\frac{e}{k}\right)^2\right)^2 & \text{若 } |e| \leq k \ 0 & \text{若 } |e| > k \end{cases} $$

Bisquare方法特性

‌硬截断‌：完全忽略 $|e| > k$ 的观测值
‌平滑性‌：权重曲线在 $ |e| = k $ 处连续且一阶可导
‌参数选择‌：典型值 $ k = 4.685\sigma $，保留约99%的正常数据

数据描述

下面用到的数据是Alan Agresti和Barbara Finlay所著的《Statistical Methods for Social Sciences》中的crime数据集。

该数据集的变量分别是：

州代码(sid)
州名 (state)
每十万人暴力犯罪数(crime)
每十万人谋杀犯罪数 (murder)
城市圈人口占比 (pctmetro)
白人占比(pctwhite)
高中及以上教育占比 (pcths)
贫困线以下人口占比 (poverty)
单亲家庭人口占比 (single)


该数据集共有51个观测值。接下来用数据集中的**poverty** 和 **single** 变量来预测 **crime**.


``` r
library(foreign)

cdata <- read.dta("http://www.ats.ucla.edu/stat/data/crime.dta")

summary(cdata)

稳健回归

先对数据进行OLS回归，重点观察回归结果中的残差、拟合值、Cook距离和杠杆率。

ols <- lm(crime ~ poverty + single, data = cdata) summary(ols)

从图上看出，第 9, 第25和第5个观测值可能是离群点，看看这些观测值所属的是哪些州。

cdata[c(9, 25, 51), 1:2]

可以猜测，DC、Florida和Mississippi这三个地方所对应的观测值可能具有较大的残差或者杠杆率。

下面观察一下Cook距离较大的观测值有哪些。在判断Cook距离大小的时候，通常采用过的经验分界点是Cook距离序列的4/n处，其中n是观测值的个数。

library(MASS) 
d1 <- cooks.distance(ols) 
r <- stdres(ols) 
a <- cbind(cdata, d1, r) 
a[d1 > 4/51, ]

本来应当先删除DC所对应的观测值，因为DC对应的并不是州。然而，由于DC所对应的Cook距离较大保留DC有助于我们进行观察。下面生成一个absr1变量，其对应的为残差序列的绝对值，取出残差绝对值较大的观测值：

rabs <- abs(r) a <- cbind(cdata, d1, r, rabs) asorted <- a[order(-rabs), ] asorted[1:10, ]

现在转向稳健回归。再提示一下，稳健回归是通过迭代重复加权最小二乘来完成的。其对应的R函数是MASS包中的rlm。IRLS对应的有多个权重函数（ weighting functions），首先演示一下Huber方法。

演示过程中，重点关注IRLS过程得出的权重结果。

rr.huber <- rlm(crime ~ poverty + single, data = cdata) 
summary(rr.huber)
hweights <- data.frame(state = cdata$state, resid = rr.huber$resid, weight = rr.huber$w) 
hweights2 <- hweights[order(rr.huber$w), ] hweights2[1:15, ]

容易看出来，观测值的残差绝对值越大，其被赋予的权重越小。结果表明Mississippi所对应的观测值被赋予的权重是最小的，其次是Florida所对应的观测值，而所有未被展示的观测值的权重皆为1。由于OLS回归中所有观测值的权重都为1，因此，稳健回归中权重为1的观测值越多，则稳健回归于OLS回归的分析结果越相近。

接下来，用bisquare方法来进行稳健回归过程。

rr.bisquare <- rlm(crime ~ poverty + single, data=cdata, psi = psi.bisquare) summary(rr.bisquare)
biweights <- data.frame(state = cdata$state, resid = rr.bisquare$resid, weight = rr.bisquare$w) 
biweights2 <- biweights[order(rr.bisquare$w), ] 
biweights2[1:15, ]

与Huber方法相比，bisquare方法下的 Mississippi观测值被赋予了极小的权重，并且两种方法估计出的回归参数也相差甚大。通常，当稳健回归跟OLS回归的分析结果相差较大时，数据分析者采用稳健回归较为明智。稳健回归和OLS回归的分析结果的较大差异通常暗示着离群点对模型参数产生了较大影响。所有的方法都有长处和软肋，稳健回归也不例外。稳健回归中，Huber方法的软肋在于无法很好的而处理极端离群点，而bisquare方法的软肋在于回归结果不易收敛，以至于经常有多个最优解。

除此之外，两种方法得出的参数结果极为不同，尤其是single变量的系数和截距项(intercept)。不过，一般而言无需关注截距项，除非事先已经对预测变量进行了中心化，此时截距项才显的有些用处。再有，变量** poverty** 的系数在两种方法下都不显著，而变量 single则刚好相反，都较为显著。

思考：

稳健回归没有解决OLS回归中的异方差问题，有关这一问题可以参见sandwich包中的 lm函数。
这里展示的只是在R实现M估计的一种方法，读者尚可以在rlm中发现更多方法，比如MM等。此外，robustbase包中ltsReg可以用来实现最小截平方（ Least trimmed squares）。

参考资料：

Li, G. 1985. Robust regression. In Exploring Data Tables, Trends and Shapes, ed. D. C. Hoaglin, F. Mosteller, and J. W. Tukey, Wiley.
John Fox, Applied regression analysis,linear models and related models, Sage publications, Inc, 1997

R中的3维HCPC图

Mon, 28 Nov 2011 00:00:00 +0000

第四届R会议上，余苓提到了一个叫FactoMineR的包，这个包提供了一个可以绘制立体谱系图的函数plot.HCPC()。我记得之前有人在COS论坛上问过这个问题，我就特别留意了一下这个函数。

它的用法如下：

# 安装包,如果未安装
# install.packages("FactoMineR")
library(FactoMineR) #加载包
data(iris) #加载数据
res.hcpc <- HCPC(iris[1:4], nb.clust=3) #基于PC的聚类

plot.HCPC(res.hcpc, choice="3D.map", angle=60) #3D谱系图

但是，这个图不够好，因为这个图缺少该有的交互性。等我有时间了，我会用rgl包重新写一个具有交互功能的立体谱系图。

apply函数族入门

Wed, 09 Nov 2011 00:00:00 +0000

在任何一个R语言问答网站或者论坛，你都能看见这样的问题：

Q:如何用循环做【…各种奇怪的事情…】 A:不用用循环哦，亲！apply函数可以解决这个问题哦，亲！

上面答案中提到的这个神奇的apply函数到底是什么？下面通过一些简单的操作示范一下。

打开R，敲入??apply函数，选定base包部分你会看到下面的东西：

base::apply Apply Functions Over Array Margins
base::by Apply a Function to a Data Frame Split by Factors
base::eapply Apply a Function Over Values in an Environment
base::lapply Apply a Function over a List or Vector
base::mapply Apply a Function to Multiple List or Vector Arguments
base::rapply Recursively Apply a Function to a List
base::tapply Apply a Function Over a Ragged Array

下面一一示范。

apply

先看看帮助文档中对其的描述：

“Returns a vector or array or list of values obtained by applying a function to margins of an array or matrix. ”

好吧，vector、array和function是神马我都明白，margins是什么？我来翻译一下吧，margins为1时是指行，margins为2时是指列，如果是c(1:2)，好吧，这个啰嗦的举动，指的是整个array或者matrix。

例子如下:

#创建一个10行2列的矩阵
m <- matrix(c(1:10,11:20),nrow=10,ncol=2)

#求m的每一行的均值
apply(m,1,mean)

## [1] 6 7 8 9 10 11 12 13 14 15

#求m的每一列的均值
apply(m,2,mean)

## [1] 5.5 15.5

#将m的每个值除以2
apply(m,1:2,function(x) x/2)

## [,1] [,2]
## [1,] 0.5 5.5
## [2,] 1.0 6.0
## [3,] 1.5 6.5
## [4,] 2.0 7.0
## [5,] 2.5 7.5
## [6,] 3.0 8.0
## [7,] 3.5 8.5
## [8,] 4.0 9.0
## [9,] 4.5 9.5
## [10,] 5.0 10.0

最后一个例子仅仅是为了示范，我们有更简单的方法一秒钟实现。

m/2

## [,1] [,2]
## [1,] 0.5 5.5
## [2,] 1.0 6.0
## [3,] 1.5 6.5
## [4,] 2.0 7.0
## [5,] 2.5 7.5
## [6,] 3.0 8.0
## [7,] 3.5 8.5
## [8,] 4.0 9.0
## [9,] 4.5 9.5
## [10,] 5.0 10.0

帮助文档中的描述：

“Function by is an object-oriented wrapper for tapply applied to data frames. ”

事实上，by的功能绝不是这一句话所能描述的。接着读下去，你会看到

“A data frame is split by row into data frames subsetted by the values of one or more factors, and function FUN is applied to each subset in turn. ”

这里，我们用一个带有定性变量的数据进行示范。这个数据集就是著名的iris。

attach(iris)
head(iris)

## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa

#根据Species分类，求前4个变量的均值
by(iris[,1:4],Species,mean)

## Warning in mean.default(data[x, , drop = FALSE], ...):
## 参数不是数值也不是逻辑值：返回NA
## Warning in mean.default(data[x, , drop = FALSE], ...):
## 参数不是数值也不是逻辑值：返回NA
## Warning in mean.default(data[x, , drop = FALSE], ...):
## 参数不是数值也不是逻辑值：返回NA

## Species: setosa
## [1] NA
## ------------------------------------------------------------ 
## Species: versicolor
## [1] NA
## ------------------------------------------------------------ 
## Species: virginica
## [1] NA

其实，就是根据一个定性变量将数据分为若干个子集，再对各子集进行apply操作。

eapply

帮助文档的描述：

“eapply applies FUN to the named values from an environment and returns the results as a list. The user can request that all named objects are used (normally names that begin with a dot are not). The output is not sorted and no enclosing environments are searched. ”

有理解这句话，重点是理解environment这个东西。environment相当于是R里面的一个小系统，这个系统包含有自己的变量和函数等内容。

用一个简单的例子来示范：

#创建一个新的environment
e=new.env()
#在e中创建两个变量
e$a=1:10
e$b=11:20
#求e中变量的均值
eapply(e,mean)

## $a
## [1] 5.5
## 
## $b
## [1] 15.5

一般人儿可能不常用environment这个东西。不过，Bioconductor们是例外。

lapply

帮助文档的描述：

“lapply returns a list of the same length as X, each element of which is the result of applying FUN to the corresponding element of X. ”

这是apply函数的帮助文档中最简明扼要的一个。直接给示范：

#创建一个list
l=list(a=1:10,b=11:20)
#计算list中每个元素的均值
lapply(l,mean)

## $a
## [1] 5.5
## 
## $b
## [1] 15.5

#计算list中每个元素的和
lapply(l,sum)

## $a
## [1] 55
## 
## $b
## [1] 155

lapply的文档中让我们进一步参考sapply、vapply和replicate。那我们走去看看。

sapply

帮助文档的描述：

“sapply is a user-friendly version and wrapper of lapply by default returning a vector, matrix or, if simplify=“array”, an array if appropriate, by applying simplify2array(). sapply(x, f, simplify=FALSE, USE.NAMES=FALSE) is the same as lapply(x,f). ”

上面一堆简单说就是，lapply返回的是一个含有两个元素$a和$b的list，而sapply返回的是一个含有元素[[“a”]]和[[“b”]]的vector，或者列名为a和b的矩阵。

示范如下：

#创建一个list
l=list(a=1:10,b=11:20)
#用sapply求均值
l.mean=sapply(l,mean)
#观察返回结果的类型
class(l.mean)

## [1] "numeric"

l.mean[['a']]

## [1] 5.5

vapply

帮助文档的描述：

“vapply is similar to sapply, but has a pre-specified type of return value, so it can be safer (and sometimes faster) to use.”

直接示范：

l=list(a=1:10,b=11:20)
#用vapply函数计算五分位数
l.fivenum=vapply(l,fivenum,c(Min.=0,"lst Qu."=0,Median=0,"3rd Qu."=0,Max.=0))
class(l.fivenum)

## [1] "matrix" "array"

#结果
l.fivenum

## a b
## Min. 1.0 11.0
## lst Qu. 3.0 13.0
## Median 5.5 15.5
## 3rd Qu. 8.0 18.0
## Max. 10.0 20.0

从结果可以看到，vapply返回的是一个矩阵。矩阵的列名是list的元素，行名取决于函数的输出结果。

replicate

帮助文档的描述:

“replicate is a wrapper for the common use of sapply for repeated evaluation of an expression (which will usually involve random number generation). ”

replicate是一个非常强大的函数，它有两个强制参数：replications,即操作的重复次数；function，及要重复的操作。还有一个可选择参数：simplify=T，是否将操作结果转化为vector或者matrix。

示范：

replicate(10,rnorm(10))

## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.09404565 0.6900446 0.20266413 0.5129547 1.0128168 0.05653415
## [2,] -0.91284275 0.4148158 0.52344728 1.6220620 -0.1530737 0.05569266
## [3,] -2.82534108 -0.8308159 -0.80378790 -0.4079487 -2.1890716 -0.63564857
## [4,] -0.88857743 -0.3077837 -1.04967642 0.3230530 0.1094893 0.38889519
## [5,] 0.21849109 1.2910931 -1.31689751 -0.8643641 -1.6985050 -0.72514369
## [6,] 0.42406931 1.0962243 0.03433455 -0.3644647 -1.1519254 -0.51264405
## [7,] -0.95389493 0.8339559 -0.48655834 0.0271446 0.8224275 -0.75322140
## [8,] 1.30411129 0.6961557 -0.94826540 3.8187493 1.9491568 -0.70021472
## [9,] 1.42619896 1.3484791 -1.77604799 0.2154067 0.3761675 -0.24362034
## [10,] -0.12993140 0.2320959 -0.08696657 1.2382602 0.5781700 -1.26176561
## [,7] [,8] [,9] [,10]
## [1,] 0.29583451 1.7547814 -0.4761433 -2.9786950
## [2,] -1.51743386 -2.1529347 0.3729536 0.2775196
## [3,] -0.46015526 -0.7021302 -0.3539648 -0.6730854
## [4,] 0.89778909 0.1765478 1.9319342 0.3784471
## [5,] 1.42831439 -0.3437932 0.3734149 0.3974802
## [6,] 0.07412502 -2.5053443 -1.0342991 0.8934034
## [7,] 0.04454659 -0.1709211 -0.4627233 1.0121957
## [8,] -0.46424059 -0.2812505 -0.3270812 0.2869938
## [9,] 0.11599570 1.5177862 0.2759767 0.8952857
## [10,] 0.59676528 -0.1538958 -0.9503086 -0.3969758

mapply

帮助文档的描述：

“mapply is a multivariate version of sapply. mapply applies FUN to the first elements of each … argument, the second elements, the third elements, and so on. Arguments are recycled if necessary. ”

如果你认真看看mapply的帮助文档的话，我打赌你会看到头大。这里给看官两个简单的例子：

l1=list(a=1:10,b=11:20)
l2=list(c=21:30,d=31:40)
l1

## $a
## [1] 1 2 3 4 5 6 7 8 9 10
## 
## $b
## [1] 11 12 13 14 15 16 17 18 19 20

l2

## $c
## [1] 21 22 23 24 25 26 27 28 29 30
## 
## $d
## [1] 31 32 33 34 35 36 37 38 39 40

#计算l1,l2中各元素的和
mapply(sum,l1$a,l1$b,l2$c,l2$d)

## [1] 64 68 72 76 80 84 88 92 96 100

竖直看下来，加总就得到了上面的结果。

rapply

帮助文档的描述：

“rapply is a recursive version of lapply. ”

这个描述是史上最差描述之一。因为rapply跟recursive并没有太大关系。rapply的创造性在于提供了一个结果输出形式的参数。

示范：

#创建list
l=list(a=1:10,b=11:20)
#计算l中元素的log2
rapply(l,log2)

## a1 a2 a3 a4 a5 a6 a7 a8 
## 0.000000 1.000000 1.584963 2.000000 2.321928 2.584963 2.807355 3.000000 
## a9 a10 b1 b2 b3 b4 b5 b6 
## 3.169925 3.321928 3.459432 3.584963 3.700440 3.807355 3.906891 4.000000 
## b7 b8 b9 b10 
## 4.087463 4.169925 4.247928 4.321928

#将结果的输出形式设定为list

rapply(l,log2,how="list")

## $a
## [1] 0.000000 1.000000 1.584963 2.000000 2.321928 2.584963 2.807355 3.000000
## [9] 3.169925 3.321928
## 
## $b
## [1] 3.459432 3.584963 3.700440 3.807355 3.906891 4.000000 4.087463 4.169925
## [9] 4.247928 4.321928

#计算均值
rapply(l,mean)

## a b 
## 5.5 15.5

rapply(l,mean,how="list")

## $a
## [1] 5.5
## 
## $b
## [1] 15.5

综上，rapply函数的输出结果取决于函数和how参数。当how=“list"时，数据的原始结构被保留，否则，输出结果被转化为vector。

当然，看官还可以将classes函数传递给rapply函数。例如在混合型list中，可以通过classes=numeric，是的函数子对数字型元素进行操作。

tapply

帮助文档的描述：

“Apply a function to each cell of a ragged array, that is to each (non-empty) group of values given by a unique combination of the levels of certain factors.”

语焉不详。翻译一下大概是：

“tapply(X, INDEX, FUN = NULL, …, simplify = TRUE)”中的“X”是 “an atomic object, typically a vector.”，而“INDEX”是“list of factors, each of same length as X. The elements are coerced to factors by as.factor.”

依然以iris数据集为例示范一下：

attach(iris)

## The following objects are masked from iris (pos = 3):
## 
## Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species

#根据sprcies进行分类，计算petal的均值
tapply(iris$Petal.Length,Species,mean)

## setosa versicolor virginica 
## 1.462 4.260 5.552

简短的总结：

这里给出的都是极其简单的例子，基于最简单的数据，和最简单的函数。因为对于每一个操作而言，看官都可查看数据的操作前状态和操作后状态，这样便于看官知道，操作到底对数据干了什么事情。

当然了，apply函数的功能不限于文中介绍的这些，进一步的功用期待看官自己去挖掘。

给出几个使用apply函数的建议，在使用之前应当思考：

原始数据是什么类型？vector?matrix?data frame?….
想对原始数据的哪些子集进行操作？行?列？所有元素？….
操作将返回什么结果？原始数据的结构是如何变化的？

只是一个老生常谈的关于“输入——操作——输出”的故事：你有什么？你想要什么？两者之间需要什么？

R与月跨度函数，理论与应用的差距

Thu, 15 Sep 2011 00:00:00 +0000

R在处理数据方面的灵活性一直都被人们赞誉。当然，理论界的人的多些，应用界的人相对较少。

混迹应用界的人一般会对R有更多的细节要求。比如在处理日期的时候，如果我想获取两个日期，2010年3月25日和2010年6月27日的月跨度，R里面就没有现存的函数。这一点让我意外，因为这是数据处理实务中经常遇到的问题。为什么R包的作者没有想到呢？不要抱怨，抱怨没用，这就是理论和应用的差距。

应用者的一切以方便为导向，理论者则不同，他们负责提供石头，建筑有时候要靠你自己去完成。

花了一会儿时间，找到了三个石头，length,months,seq。完成了建筑，在代码里面把2010-03-**全部处理为2010-03-01，把2010-06-**全部处理成2010-06-01。

d1="2010-03-25"
d2="2010-06-24"

length(seq(from=as.Date(paste(substr(d1,1,7),"01",sep="-")),
 to=as.Date(paste(substr(d2,1,7),"01",sep="-")),
 by="month"))

## [1] 4

当然，也可以封装一下：

month.span=function(d1,d2){
 date1=paste(substr(d1,1,7),"01",sep="-")
 date2=paste(substr(d2,1,7),"01",sep="-")
 L=length(seq(from=as.Date(date1),to=as.Date(date2),by="month"))
 L
}

month.span(d1,d2)

## [1] 4

非线性模型极大似然估计方法

Tue, 13 Sep 2011 00:00:00 +0000

一、模型设定与概率框架

设非线性生产函数形式为： $$ y_i = aL_i^bK_i^c + \epsilon_i \quad (i=1,…,n) $$ 其中误差项 $\epsilon_i \sim N(0,\sigma^2)$，则观测值 $y_i$ 服从均值为 $aL_i^bK_i^c$、方差为 $\sigma^2$ 的正态分布。

二、似然函数构建

1. 联合概率密度函数

$$ L(a,b,c,\sigma) = \prod_{i=1}^n \frac{1}{\sqrt{2\pi\sigma^2}} \exp\left[ -\frac{(y_i-aL_i^bK_i^c)^2}{2\sigma^2} \right] $$

2. 负对数似然函数（目标函数）

$$ \ell(a,b,c,\sigma) = -\ln L = \frac{n}{2}\ln(2\pi) + n\ln\sigma + \frac{1}{2\sigma^2}\sum_{i=1}^n (y_i - aL_i^bK_i^c)^2 $$

三、参数估计流程

1. 数据处理与准备

# 导入数据
data <- data.frame(
 y = c(76,47,97,107,123,139,159,152,191,201,207,200),
 L = c(0.02,0.02,0.06,0.06,0.11,0.11,0.22,0.22,0.56,0.56,1.10,1.10),
 K = c(1.1,0.9,2.3,2.1,3.4,3.6,4.5,4.3,5.8,6.0,7.2,7.0)
)

# 定义负对数似然函数
mloglik <- function(theta) {
 a <- theta[1]
 b <- theta[2]
 c <- theta[3]
 sigma <- theta[4]
 
 y_pred <- a * data$L^b * data$K^c
 residuals <- data$y - y_pred
 n <- length(data$y)
 
 # 避免\sigma 趋近于零
 if(sigma <= 0) return(1e10)
 
 (n/2)*log(2*pi) + n*log(sigma) + sum(residuals^2)/(2*sigma^2)
}

# 采用线性化方法获取初始值
log_model <- lm(log(y) ~ log(L) + log(K), data = data)
theta_init <- c(
 exp(coef(log_model)[1]),
 coef(log_model)[2],
 coef(log_model)[3],
 sd(resid(log_model))
)

# 优化求解
fit <- nlm(mloglik, theta_init, hessian = TRUE)

## Warning in nlm(mloglik, theta_init, hessian = TRUE): NA/NaN replaced by maximum
## positive value

## Warning in nlm(mloglik, theta_init, hessian = TRUE): Inf replaced by maximum
## positive value

# 提取估计结果
params <- fit$estimate
names(params) <- c("a", "b", "c", "sigma")
params

## a b c sigma 
## 55.45620820 -0.02273718 0.67704166 7.67493891

NASDAQ有泡沫吗

Tue, 06 Sep 2011 00:00:00 +0000

LPPL模型是什么

LPPL（对数周期性幂律）模型是由Didier Sornette等学者提出的金融市场泡沫检测模型，用于识别资产价格在崩盘前的非线性加速增长模式。该模型结合了幂律增长和对数周期性振荡，被广泛应用于金融泡沫预警和临界点预测。

模型的核心是资产价格演化方程：

$$ \ln p(t) = A + B(t_c - t)^\beta \left[1 + C\cos\left(\omega \ln(t_c - t) + \phi\right)\right] $$

$t_c$ 是临界时间（预测的崩盘时间）
$\beta$ 是幂律指数
$\omega$ 是振荡频率（典型值5-15）
$C$ 是振荡幅度
$\phi$ 是相位参数

其中： $0 \lt \beta \lt 1$

LPPL模型具有如下特征：

价格加速增长
- 幂律项 $(t_c - t)^\beta$ 描述价格超指数增长。
- 典型泡沫阶段 $\beta \in (0,1)$，反映增长速率随时间递增。
对数周期振荡
- 其中 $cos\left[\omega\ln\left(t_{c}-t\right)\right]$ 反映投资者博弈产生的离散尺度不变性。
- 震荡幅度随 $t\to t_{c}$ 增大，体现市场分歧加剧。
临界时间特性
- 当 $t\to t_{c}$ 时模型预测系统失稳。
- 实际崩盘可能发生在 $t_{c}$ 前6个月内。

拟合模型

# 加载依赖包
library(quantmod)

## 载入需要的程序包：xts

## 载入需要的程序包：zoo

## 
## 载入程序包：'zoo'

## The following objects are masked from 'package:base':
## 
## as.Date, as.Date.numeric

## 载入需要的程序包：TTR

## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo

library(DEoptim)

## 载入需要的程序包：parallel

## 
## DEoptim package
## Differential Evolution algorithm in R
## Authors: D. Ardia, K. Mullen, B. Peterson and J. Ulrich

library(ggplot2)

# 获取纳斯达克指数数据（2010-01-01至2011-08-30）
getSymbols("^IXIC", src = "yahoo", from = "2010-01-01", to = "2011-08-30")

## [1] "IXIC"

nasdaq <- data.frame(
 t = 1:nrow(IXIC), 
 ln_p = log(Ad(IXIC))
)

colnames(nasdaq)=c("t","ln_p")
# 数据降噪（7日移动平均）
nasdaq$ln_p_smooth <- stats::filter(nasdaq$ln_p, rep(1/7, 7), sides = 2)
nasdaq <- na.omit(nasdaq) # 剔除NA值


# 定义LPPL模型函数
lppl_model <- function(params, t) {
 A <- params["A"]; B <- params["B"]; tc <- params["tc"]
 beta <- params["beta"]; C <- params["C"]; omega <- params["omega"]; phi <- params["phi"]
 term <- pmax(tc - t, 1e-6) # 防止出现负数
 A + B * term^beta + C * term^beta * cos(omega * log(term) + phi)
}

# 定义损失函数（均方误差）
loss <- function(params) {
 pred <- lppl_model(params, nasdaq$t)
 if (any(is.na(pred))) return(Inf)
 mean((pred - nasdaq$ln_p_smooth)^2, na.rm = TRUE)
}

# 参数约束范围
lower <- c(
 A = min(nasdaq$ln_p_smooth), 
 B = -2, 
 tc = max(nasdaq$t) + 1, 
 beta = 0.01, 
 C = 0, 
 omega = 6, 
 phi = 0
)

upper <- c(
 A = max(nasdaq$ln_p_smooth), 
 B = 0, 
 tc = max(nasdaq$t) * 1.2, 
 beta = 0.99, 
 C = 0.5, 
 omega = 13, 
 phi = 2 * pi
)


# 全局优化（差分进化算法）
set.seed(123)
de_result <- DEoptim(
 fn = loss, 
 lower = lower, 
 upper = upper, 
 control = list(
 itermax = 500, 
 NP = 100, 
 trace = FALSE
 )
)

# 局部优化（L-BFGS-B）
final_params <- optim(
 de_result$optim$bestmem, 
 fn = loss, 
 method = "L-BFGS-B",
 lower = lower, 
 upper = upper
)$par

# 输出参数估计结果
cat("LPPL模型参数估计结果：\n")

## LPPL模型参数估计结果：

print(round(final_params, 4))

## A B tc beta C omega phi 
## 7.9574 -0.0009 459.8781 0.9167 0.0000 7.7609 5.3808

结果解读

从模型结果可以看出：

临界时间：$t_c$若输出值为 round(final_params,4)$tc，需结合市场背景评估泡沫风险；
震荡频率：$\omega$介于6-13区间符合典型泡沫特征；
衰减指数: $\beta$ 接近 round(final_params,4)$beta表明价格波动趋于临界点时分歧加大。

模型结果可视化

# 生成预测值
nasdaq$pred <- lppl_model(final_params, nasdaq$t)

# 绘制拟合曲线
ggplot(nasdaq, aes(x = t)) +
 geom_line(aes(y = ln_p, color = "原始对数价格"), alpha = 0.5) +
 geom_line(aes(y = ln_p_smooth, color = "平滑序列"), linetype = "dashed") +
 geom_line(aes(y = pred, color = "LPPL拟合"), linewidth = 1) +
 scale_color_manual(values = c("原始对数价格" = "grey", "平滑序列" = "blue", "LPPL拟合" = "red")) +
 labs(
 title = "纳斯达克指数LPPL模型拟合效果（2020-2025）",
 x = "交易日序数", 
 y = "对数价格"
 ) +
 theme_minimal() +
 theme(legend.position = "top", plot.title = element_text(hjust = 0.5))

R中的魔方矩阵

Mon, 29 Aug 2011 00:00:00 +0000

某个朋友去证券公司笔试，题目中竟然有一道要求用C语言完成魔方矩阵的输出。如果之前没有做过相关练习，骤然间写出代码可是不容易的事情。

今天下午查了一下R中的魔方矩阵，发现里面已经有一个magic包可以完成魔方矩阵的输出。R真有点无所不包的气势。

魔方矩阵：原理、应用与可视化实现

一、数学原理

魔方矩阵（Magic Square）又称幻方，是$n \times n$的方阵，满足以下特性：

等和定律：每行、每列及两条主对角线的元素和相等，称为魔方常数$M =\frac{n(n^2+1)}{2}$；
元素排列：包含$1$到$n^2$的连续自然数；
构造规律：奇数阶常用Siamese方法（楼梯法），偶数阶采用LUX或边界填充策略。

以3阶魔方为例：

$$ \begin{bmatrix} 8 & 1 & 6 \\ 3 & 5 & 7 \\ 4 & 9 & 2 \\ \end{bmatrix} $$

其行、列、对角线之和均为$15$。

二、核心价值

1. 科学研究维度

数论验证：魔方常数与矩阵阶数的数学关系为代数理论提供验证案例
组合优化：启发旅行商问题(TSP)、排班系统等组合优化算法设计

2. 文化应用场景

密码原型：古代战争曾用魔方矩阵加密军事情报
艺术设计：印度泰姬陵地砖、敦煌壁画均包含幻方图案

三、R语言实现

1. 构造魔方矩阵

# 安装必要包
if (!require("magic")) install.packages("magic")

## 载入需要的程序包：magic

## 载入需要的程序包：abind

library(magic)

# 生成5阶魔方矩阵
magic_matrix <- magic(5)
print(magic_matrix)

## [,1] [,2] [,3] [,4] [,5]
## [1,] 9 2 25 18 11
## [2,] 3 21 19 12 10
## [3,] 22 20 13 6 4
## [4,] 16 14 7 5 23
## [5,] 15 8 1 24 17

2. 可视化

library(ggplot2)
library(reshape2)

# 数据重塑
melted_matrix <- melt(magic_matrix)
colnames(melted_matrix) <- c("Row", "Column", "Value")

# 绘制热力图
ggplot(melted_matrix, aes(x = Column, y = Row, fill = Value)) +
 geom_tile(color = "white") +
 scale_fill_gradient(low = "#FFD700", high = "#FF4500") +
 geom_text(aes(label = Value), color = "black", size = 4) +
 theme_minimal(base_family="PingFang SC") +
 labs(title = "5阶魔方矩阵可视化",
 subtitle = "行、列、对角线之和均为65") +
 coord_fixed()

还可以写一段更简单的代码：

# 安装包，如果为安装
# install.packages("magic")
library(magic)
# 定义魔方矩阵函数magic.image()
magic.image <- function(n,...){
 # 生成n阶魔方矩阵
 m<- magic(n)
 # 生成魔方矩阵热图
 image(m)
 # 添加数字标签
 for(j in 1:n){
 for(i in 1:n){
 text(1/(n-1)*i-1/(n-1),1+1/(n-1)-1/(n-1)*j,m[j,i])
 }
 }
}
# 使用函数
magic.image(5)

R与矩阵运算总结

Sat, 27 Aug 2011 00:00:00 +0000

1 矩阵基本操作

1.1创建向量

R里面有多种方法来创建向量（Vector），最简单的是用函数c()。例如：

X=c(1,2,3,4)

X

## [1] 1 2 3 4

当然，还有别的方法。例如：

X=1:4

X

## [1] 1 2 3 4

还有seq()函数。例如：

X=seq(1,4,length=4)

X

## [1] 1 2 3 4

注意一点，R中的向量默认为列向量，如果要得到行向量需要对其进行转置。

1.2创建矩阵

R中创建矩阵的方法也有很多。大致分为直接创建和由其它格式转换两种方法。

1.2.1直接创建矩阵

最简单的直接创建矩阵的方法是用matrix()函数，matrix()函数的使用方法如下：

args(matrix)

## function (data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL) 
## NULL

其中，data参数输入的为矩阵的元素，不能为空；nrow参数输入的是矩阵的行数，默认为1；ncol参数输入的是矩阵的列数，默认为1；byrow参数控制矩阵元素的排列方式，TRUE表示按行排列，FALSE表示按列排列，默认为FALSE；dimnames参数输入矩阵的行名和列名，可以不输入，系统默认为NULL。例如：

matrix(1:6,nrow=2,ncol=3,byrow=FALSE)

## [,1] [,2] [,3]
## [1,] 1 3 5
## [2,] 2 4 6

改变矩阵的行数和列数：

matrix(1:6,nrow=3,ncol=2,byrow=FALSE)

## [,1] [,2]
## [1,] 1 4
## [2,] 2 5
## [3,] 3 6

改变byrow参数：

matrix(1:6,nrow=3,ncol=2,byrow=T)

## [,1] [,2]
## [1,] 1 2
## [2,] 3 4
## [3,] 5 6

设定矩阵的行名和列名：

matrix(1:6,nrow=3,ncol=2,byrow=T,dimnames=list(c("A","B","C"),c("boy","girl")))

## boy girl
## A 1 2
## B 3 4
## C 5 6

1.2.2 由其它格式转换

也可以由其它格式的数据转换为矩阵，此时需要用到函数as.matrix()。

1.3 查看和改变矩阵的维数

矩阵有两个维数，即行维数和列维数。在R中查看矩阵的行维数和列维数可以用函数dim()。例如：

 X=matrix(1:12,ncol=3,nrow=4)

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 2 6 10
## [3,] 3 7 11
## [4,] 4 8 12

 dim(X)

## [1] 4 3

只返回行维数：

 dim(X)[1]

## [1] 4

也可以用函数nrow()

nrow(X)

## [1] 4

只返回列维数：

 dim(X)[2]

## [1] 3

也可以用函数ncol():

 ncol(X)

## [1] 3

同时，函数dim()也可以改变矩阵的维数。例如：

dim(X)=c(2,6)

X

## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1 3 5 7 9 11
## [2,] 2 4 6 8 10 12

1.4矩阵行列的名称

查看矩阵的行名和列名分别用函数rownames()和函数colnames()。例如：

X=matrix(1:6,nrow=3,ncol=2,byrow=T,dimnames=list(c("A","B","C"),c("boy","girl")))

 X

## boy girl
## A 1 2
## B 3 4
## C 5 6

查看矩阵的行名：

 rownames(X)

## [1] "A" "B" "C"

查看矩阵的列名：

 colnames(X)

## [1] "boy" "girl"

同时也可以改变矩阵的行名和列名，比如：

rownames(X)=c("E","F","G")

 X

## boy girl
## E 1 2
## F 3 4
## G 5 6

 colnames(X)=c("man","woman")

 X

## man woman
## E 1 2
## F 3 4
## G 5 6

1.5 矩阵元素的查看及其重新赋值

查看矩阵的某个特定元素，只需要知道该元素的行坐标和列坐标即可，例如：

 X=matrix(1:12,nrow=4,ncol=3)

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 2 6 10
## [3,] 3 7 11
## [4,] 4 8 12

查看位于矩阵第二行、第三列的元素：

 X[2,3]

## [1] 10

也可以重新对矩阵的元素进行赋值，将矩阵第二行、第三列的元素替换为0：

 X[2,3]=0

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 2 6 0
## [3,] 3 7 11
## [4,] 4 8 12

R中有一个diag()函数可以返回矩阵的全部对角元素：

 X=matrix(1:9,ncol=3,nrow=3)

 X

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9

diag(X)

## [1] 1 5 9

当然也可以对对角元素进行重新赋值：

 diag(X)=c(0,0,1)

 X

## [,1] [,2] [,3]
## [1,] 0 4 7
## [2,] 2 0 8
## [3,] 3 6 1

当操作对象不是对称矩阵时，diag()也可以进行操作。

 X=matrix(1:12,nrow=4,ncol=3)

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 2 6 10
## [3,] 3 7 11
## [4,] 4 8 12

 diag(X)

## [1] 1 6 11

diag()函数还能用来生成对角矩阵：

 diag(c(1,2,3))

## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 2 0
## [3,] 0 0 3

也可以生成单位对角矩阵：

 diag(3)

## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 1 0
## [3,] 0 0 1

 diag(4)

## [,1] [,2] [,3] [,4]
## [1,] 1 0 0 0
## [2,] 0 1 0 0
## [3,] 0 0 1 0
## [4,] 0 0 0 1

查看矩阵的上三角部分：在R中查看矩阵的上三角和下三角部分很简单。可以通过lower.tri()和upper.tir()来实现：

 args(lower.tri)

## function (x, diag = FALSE) 
## NULL

 args(upper.tri)

## function (x, diag = FALSE) 
## NULL

查看上三角：

 X=matrix(1:12,nrow=4,ncol=3)

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 2 6 10
## [3,] 3 7 11
## [4,] 4 8 12

 X[lower.tri(X)]

## [1] 2 3 4 7 8 12

改变赋值：

 X[lower.tri(X)]=0

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 0 6 10
## [3,] 0 0 11
## [4,] 0 0 0

2 矩阵计算

2.1矩阵转置

R中矩阵的转置可以用t()函数完成，例如：

 X=matrix(1:12,nrow=4,ncol=3)

 X

## [,1] [,2] [,3]
## [1,] 1 5 9
## [2,] 2 6 10
## [3,] 3 7 11
## [4,] 4 8 12

 t(X)

## [,1] [,2] [,3] [,4]
## [1,] 1 2 3 4
## [2,] 5 6 7 8
## [3,] 9 10 11 12

2.2矩阵的行和与列和及行平均值和列均值

在R中很容易计算一个矩阵的各行和和各列和以及各行的平均值和各列的平均值。例如：

 A=matrix(1:12,3,4)

 A

## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

 rowSums(A)

## [1] 22 26 30

 rowMeans(A)

## [1] 5.5 6.5 7.5

 colSums(A)

## [1] 6 15 24 33

 colMeans(A)

## [1] 2 5 8 11

2.3行列式的值

R中的函数det()将计算方阵A的行列式。例如：

 X=matrix(rnorm(9),nrow=3,ncol=3)

 X

## [,1] [,2] [,3]
## [1,] -0.6110769 -0.3434181 -1.1062389
## [2,] -1.9174083 0.1106630 -0.7469723
## [3,] -0.3393505 0.1931565 1.6372937

 det(X)

## [1] -0.9958889

2.4矩阵相加减

矩阵元素的相加减是指维数相同的矩阵，处于同行和同列的位置的元素进行加减。实现这个功能用“＋”，“－”即可。例如：

 A=B=matrix(1:12,nrow=3,ncol=4)

 A+B

## [,1] [,2] [,3] [,4]
## [1,] 2 8 14 20
## [2,] 4 10 16 22
## [3,] 6 12 18 24

A-B

## [,1] [,2] [,3] [,4]
## [1,] 0 0 0 0
## [2,] 0 0 0 0
## [3,] 0 0 0 0

2.5矩阵的数乘

矩阵的数乘是指一个常数与一个矩阵相乘。设A为 $m\times n$ 矩阵，当 $c\ne0$ 时，在R中求 $c*A$ 的值，可以用符号“*”。例如：

 c=2

 A=matrix(1:12,nrow=3,ncol=4)

 A

## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

c*A

## [,1] [,2] [,3] [,4]
## [1,] 2 8 14 20
## [2,] 4 10 16 22
## [3,] 6 12 18 24

结果矩阵与原矩阵的所有相应元素都差一个常数c。

2.6矩阵相乘

2.6.1矩阵的乘法

A为 $m\times n$ 矩阵，B为 $n\times k$ 矩阵，在R中求 $A\times B$ ，可以符号“%*%”。例如：

 A=matrix(1:12,nrow=3,ncol=4)

 B=matrix(1:12,nrow=4,ncol=3)

 A%*%B

## [,1] [,2] [,3]
## [1,] 70 158 246
## [2,] 80 184 288
## [3,] 90 210 330

注意: $B\times A$ 无意义，因其不符合矩阵的相乘规则。

若A为 $n\times m$ 矩阵，B为 $n\times k$ 矩阵，在R中求 $A^{'}\times B$ ：

 A=matrix(1:12,nrow=4,ncol=3)

 B=matrix(1:12,nrow=4,ncol=3)

 t(A)%*%B

## [,1] [,2] [,3]
## [1,] 30 70 110
## [2,] 70 174 278
## [3,] 110 278 446

也可以用函数crossprod()计算 $A^{'}\times B$ ：

crossprod(A,B)

## [,1] [,2] [,3]
## [1,] 30 70 110
## [2,] 70 174 278
## [3,] 110 278 446

2.6.2矩阵的Kronecker积

$n\times m$ 的矩阵A和 $h\times k$ 的矩阵B的Kronecker积是一个 $nh\times mk$ 维矩阵，公式为：

$$ A \otimes B = \begin{bmatrix} a_{11}B & a_{12}B & \cdots & a_{1m}B \ a_{21}B & a_{22}B & \cdots & a_{2m}B \ \vdots & \vdots & \ddots & \vdots \ a_{n1}B & a_{n2}B & \cdots & a_{nm}B \end{bmatrix} $$

其中：

$a_{ij}$ 表示矩阵A的第i行第j列元素
每个分块 $a_{ij}B$ 是原矩阵B的所有元素按 $a_{ij}$ 比例缩放后的子矩阵
最终结果矩阵的维度为 $(n \cdot h) \times (m \cdot k)$，即原矩阵行数乘积和新矩阵列数乘积

在R中Kronecker积可以用函数kronecher()来计算。例如：

 A=matrix(1:4,2,2)

 A

## [,1] [,2]
## [1,] 1 3
## [2,] 2 4

 B=matrix(rep(1,4),2,2)

 B

## [,1] [,2]
## [1,] 1 1
## [2,] 1 1

 kronecker(A,B)

## [,1] [,2] [,3] [,4]
## [1,] 1 1 3 3
## [2,] 1 1 3 3
## [3,] 2 2 4 4
## [4,] 2 2 4 4

2.7矩阵的伴随矩阵

求矩阵A的伴随矩阵可以用LoopAnalyst包中的函数make.adjoint()函数。例如：

 A=matrix(1:12,nrow=3,ncol=4)

 A

## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

 make.adjoint(A)

## [,1] [,2] [,3]
## [1,] -3 6 -3
## [2,] 6 -12 6
## [3,] -3 6 -3

2.8矩阵的逆和广义逆

2.8.1矩阵的逆

矩阵A的逆A-1可以用函数solve()，例如：

 A=matrix(rnorm(9),nrow=3,ncol=3)

 A

## [,1] [,2] [,3]
## [1,] 0.1630739 0.6387177 0.5308319
## [2,] -0.8614037 0.3068824 -0.2521929
## [3,] -1.4320496 0.4783913 -0.6097321

 solve(A)

## [,1] [,2] [,3]
## [1,] 0.6574602 -6.363927 3.204585
## [2,] 1.6228775 -6.535581 4.116074
## [3,] -0.2708487 9.818892 -5.937084

验证AA-1=1：

 A%*%solve(A)

## [,1] [,2] [,3]
## [1,] 1.000000e+00 8.881784e-16 -4.440892e-16
## [2,] -6.938894e-17 1.000000e+00 -2.220446e-16
## [3,] -2.775558e-17 -8.881784e-16 1.000000e+00

用round函数可以更好的得到结果：

 round(A%*%solve(A))

## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 1 0
## [3,] 0 0 1

solve()函数也可以用来求解方程组ax=b。

2.8.2矩阵的广义逆（Moore-Penrose）

$n \times m$ 矩阵 $A^+$ 称为矩阵 $A$ 的 Moore-Penrose 广义逆，当且仅当它同时满足以下四个条件:

1.相容性条件 $$ AA^+A = A $$
该条件保证了广义逆与原矩阵相乘后能保持原矩阵的核心结构不变。

2.弱相容性条件 $$ A^+AA^+ = A^+ $$
表明广义逆的迭代运算具有稳定性；

3.对称性条件 $$ (AA^+)^T = AA^+ $$
确保乘积矩阵 $AA^+$ 是正交投影算子；

4.共轭对称性条件 $$ (A^+A)^T = A^+A $$
保证乘积矩阵 $A^+A$ 同样是正交投影算子。

其核心特性包括：

存在唯一性：任意矩阵都存在唯一的 Moore-Penrose 逆；
退化特性：当 $A$ 可逆时，$A^+ = A^{-1}$；
计算方式：可通过奇异值分解实现 $$ A^+ = V\Sigma^+U^T $$ 其中 $\Sigma^+$ 为奇异值矩阵的伪逆。

R中MASS包中的ginv()函数可以计算矩阵的Moore-Penrose逆。例如：

 library(MASS)

 A=matrix(1:12,nrow=3,ncol=4)

 A

## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

 # solve(A) #出错

 ginv(A)

## [,1] [,2] [,3]
## [1,] -0.483333333 -0.03333333 0.41666667
## [2,] -0.244444444 -0.01111111 0.22222222
## [3,] -0.005555556 0.01111111 0.02777778
## [4,] 0.233333333 0.03333333 -0.16666667

验证性质1：

 A%*%ginv(A)%*%A

## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

验证性质2：

 ginv(A)%*%A%*%ginv(A)

## [,1] [,2] [,3]
## [1,] -0.483333333 -0.03333333 0.41666667
## [2,] -0.244444444 -0.01111111 0.22222222
## [3,] -0.005555556 0.01111111 0.02777778
## [4,] 0.233333333 0.03333333 -0.16666667

 ginv(A)

## [,1] [,2] [,3]
## [1,] -0.483333333 -0.03333333 0.41666667
## [2,] -0.244444444 -0.01111111 0.22222222
## [3,] -0.005555556 0.01111111 0.02777778
## [4,] 0.233333333 0.03333333 -0.16666667

验证性质3：

 A%*%ginv(A)

## [,1] [,2] [,3]
## [1,] 0.8333333 0.3333333 -0.1666667
## [2,] 0.3333333 0.3333333 0.3333333
## [3,] -0.1666667 0.3333333 0.8333333

 t(A%*%ginv(A))

## [,1] [,2] [,3]
## [1,] 0.8333333 0.3333333 -0.1666667
## [2,] 0.3333333 0.3333333 0.3333333
## [3,] -0.1666667 0.3333333 0.8333333

验证性质4：

 ginv(A)%*%A

## [,1] [,2] [,3] [,4]
## [1,] 0.7 0.4 0.1 -0.2
## [2,] 0.4 0.3 0.2 0.1
## [3,] 0.1 0.2 0.3 0.4
## [4,] -0.2 0.1 0.4 0.7

 t(ginv(A)%*%A)

## [,1] [,2] [,3] [,4]
## [1,] 0.7 0.4 0.1 -0.2
## [2,] 0.4 0.3 0.2 0.1
## [3,] 0.1 0.2 0.3 0.4
## [4,] -0.2 0.1 0.4 0.7

也可以不必如此麻烦来验证性质3和4，因为3和4只是表明 $AA^+$ 和 $A^+A$ 是对称矩阵。

2.8.3 [X^‘X ]的逆

很多时候，我们需要计算形如 $X^{'}X$ 的逆。这很容易实现，例如：

 x=matrix(rnorm(9),ncol=3,nrow=3)

 x

## [,1] [,2] [,3]
## [1,] 1.8093460 1.26990532 -1.3654367
## [2,] 0.4774751 0.21718498 0.2193708
## [3,] -0.9058385 0.06350197 0.6108242

 solve(crossprod(x))

## [,1] [,2] [,3]
## [1,] 2.112090 -1.0630514 1.9311835
## [2,] -1.063051 2.6346674 0.5414491
## [3,] 1.931184 0.5414491 3.2942094

R中的strucchange包中的函数solveCrossprod()也可完成：

 library(strucchange)

## 载入需要的程序包：zoo

## 
## 载入程序包：'zoo'

## The following objects are masked from 'package:base':
## 
## as.Date, as.Date.numeric

## 载入需要的程序包：sandwich

 args(solveCrossprod)

## function (X, method = c("qr", "chol", "solve")) 
## NULL

 solveCrossprod(x,method="qr")

## [,1] [,2] [,3]
## [1,] 2.112090 -1.0630514 1.9311835
## [2,] -1.063051 2.6346674 0.5414491
## [3,] 1.931184 0.5414491 3.2942094

 solveCrossprod(x,method="chol")

## [,1] [,2] [,3]
## [1,] 2.112090 -1.0630514 1.9311835
## [2,] -1.063051 2.6346674 0.5414491
## [3,] 1.931184 0.5414491 3.2942094

 solveCrossprod(x,method="solve")

## [,1] [,2] [,3]
## [1,] 2.112090 -1.0630514 1.9311835
## [2,] -1.063051 2.6346674 0.5414491
## [3,] 1.931184 0.5414491 3.2942094

2.9矩阵的特征值和特征向量

矩阵的谱分解（或称特征分解）是将方阵分解为特征值和特征向量构成的正交投影矩阵的线性组合。设 $A$ 是 $n \times n$ 的正规矩阵（例如实对称矩阵、Hermitian矩阵或酉矩阵），其谱分解公式为：

$$ A=\sum_{i=1}^{k}\lambda_{i}E_{i} $$

其中：

$\lambda_i$ 是 $A$ 的互异特征值（共 $k$ 个不同的特征值）；
$E_i$ 是到 $\lambda_i$ 对应特征空间的正交投影矩阵，满足： -正交性：$E_i E_j = 0 \ (\forall i \neq j)$ -幂等性：$E_i^2 = E_i$ -单位分解：$\sum_{i=1}^k E_i = I_n$

关键条件与性质：

1.可对角化性：谱分解要求矩阵 $A$ 可对角化，正规矩阵（如对称矩阵、Hermitian矩阵）一定满足此条件； 2.唯一性：分解形式唯一，由特征值和对应的正交投影矩阵完全确定； 3.几何意义：$E_i$ 将向量投影到 $\lambda_i$ 的特征空间，$A$ 的作用相当于在不同特征方向上按 $\lambda_i$ 缩放； 4.特殊情形：若 $A$ 的特征值互异（无重复），则 $E_i = v_i v_i^T / \|v_i\|^2$（$v_i$ 为标准正交特征向量）。

比如：

若 $A = \begin{bmatrix} 2 & 1 \\ 1 & 2 \end{bmatrix}$，其特征值 $\lambda_1=3$, $\lambda_2=1$，对应投影矩阵：

$$ E_1 = \frac{1}{2}\begin{bmatrix} 1 & 1 \ 1 & 1 \end{bmatrix}, \quad E_2 = \frac{1}{2}\begin{bmatrix} 1 & -1 \ -1 & 1 \end{bmatrix} $$

则谱分解为：

$$ A = 3E_1 + 1E_2 $$

 args(eigen)

## function (x, symmetric, only.values = FALSE, EISPACK = FALSE) 
## NULL

其中，x参数输入矩阵；symmetric参数判断矩阵是否为对称矩阵，如果参数为空，系统将自动检测矩阵的对称性。例如：

 A=matrix(1:9,nrow=3,ncol=3)
 A

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9

 Aeigen=eigen(A)

 Aeigen

## eigen() decomposition
## $values
## [1] 1.611684e+01 -1.116844e+00 -5.700691e-16
## 
## $vectors
## [,1] [,2] [,3]
## [1,] -0.4645473 -0.8829060 0.4082483
## [2,] -0.5707955 -0.2395204 -0.8164966
## [3,] -0.6770438 0.4038651 0.4082483

得到矩阵A的特征值：

 Aeigen$values

## [1] 1.611684e+01 -1.116844e+00 -5.700691e-16

得到矩阵A的特征向量：

 Aeigen$vectors

## [,1] [,2] [,3]
## [1,] -0.4645473 -0.8829060 0.4082483
## [2,] -0.5707955 -0.2395204 -0.8164966
## [3,] -0.6770438 0.4038651 0.4082483

3 矩阵高级操作

3.1 Choleskey分解

对于正定矩阵A，可以对其进行Choleskey分解，$A=P^{’}P$ ，其中P为上三角矩阵，在R中可以用函数chol()。例如：

 A=diag(3)+1

 A

## [,1] [,2] [,3]
## [1,] 2 1 1
## [2,] 1 2 1
## [3,] 1 1 2

 chol(A)

## [,1] [,2] [,3]
## [1,] 1.414214 0.7071068 0.7071068
## [2,] 0.000000 1.2247449 0.4082483
## [3,] 0.000000 0.0000000 1.1547005

验证$A=P^{’}P$ ：

 t(chol(A))%*%chol(A)

## [,1] [,2] [,3]
## [1,] 2 1 1
## [2,] 1 2 1
## [3,] 1 1 2

也可以用crossprod()函数：

 crossprod(chol(A),chol(A))

## [,1] [,2] [,3]
## [1,] 2 1 1
## [2,] 1 2 1
## [3,] 1 1 2

可以用Choleskey分解来计算矩阵的行列式：

 prod(diag(chol(A))^2)

## [1] 4

 det(A)

## [1] 4

也可以用Choleskey分解来计算矩阵的逆，这时候可以用到函数chol2inv():

 chol2inv(chol(A))

## [,1] [,2] [,3]
## [1,] 0.75 -0.25 -0.25
## [2,] -0.25 0.75 -0.25
## [3,] -0.25 -0.25 0.75

 solve(A)

## [,1] [,2] [,3]
## [1,] 0.75 -0.25 -0.25
## [2,] -0.25 0.75 -0.25
## [3,] -0.25 -0.25 0.75

3.2 奇异值分解

A为$m\times n$ 矩阵，矩阵的秩为r。A可以分解为$A=UDV^{’}$ ，其中:$U^{’}U=V^{’}V=I$ 。在R中可以用函数svd()来完成奇异值分解。

例如：

 A=matrix(1:18,3,6)

 A

## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1 4 7 10 13 16
## [2,] 2 5 8 11 14 17
## [3,] 3 6 9 12 15 18

 svd(A)

## $d
## [1] 4.589453e+01 1.640705e+00 1.366522e-15
## 
## $u
## [,1] [,2] [,3]
## [1,] -0.5290354 0.74394551 0.4082483
## [2,] -0.5760715 0.03840487 -0.8164966
## [3,] -0.6231077 -0.66713577 0.4082483
## 
## $v
## [,1] [,2] [,3]
## [1,] -0.07736219 -0.71960032 -0.4076688
## [2,] -0.19033085 -0.50893247 0.5745647
## [3,] -0.30329950 -0.29826463 -0.0280114
## [4,] -0.41626816 -0.08759679 0.2226621
## [5,] -0.52923682 0.12307105 -0.6212052
## [6,] -0.64220548 0.33373889 0.2596585

 svd(A)$u%*%diag(svd(A)$d)%*%t(svd(A)$v)

## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1 4 7 10 13 16
## [2,] 2 5 8 11 14 17
## [3,] 3 6 9 12 15 18

3.3 QR分解

A为$m\times n$ 矩阵可以进行QR分解:$A=QR$ ，其中$Q^{’}Q=I$ ，在R中可以用函数qr()来完成这个过程，例如：

 A=matrix(1:12,4,3)

 qr(A)

## $qr
## [,1] [,2] [,3]
## [1,] -5.4772256 -12.7801930 -2.008316e+01
## [2,] 0.3651484 -3.2659863 -6.531973e+00
## [3,] 0.5477226 -0.3781696 1.601186e-15
## [4,] 0.7302967 -0.9124744 -5.547002e-01
## 
## $rank
## [1] 2
## 
## $qraux
## [1] 1.182574 1.156135 1.832050
## 
## $pivot
## [1] 1 2 3
## 
## attr(,"class")
## [1] "qr"

Rank返回的是矩阵的秩。Qr项包含了Q矩阵和R矩阵的信息。要想得到Q矩阵和R矩阵，可以用qr.Q()函数和qr.R()函数：

qr.Q(qr(A))

## [,1] [,2] [,3]
## [1,] -0.1825742 -8.164966e-01 -0.4000874
## [2,] -0.3651484 -4.082483e-01 0.2546329
## [3,] -0.5477226 -1.665335e-16 0.6909965
## [4,] -0.7302967 4.082483e-01 -0.5455419

qr.R(qr(A))

## [,1] [,2] [,3]
## [1,] -5.477226 -12.780193 -2.008316e+01
## [2,] 0.000000 -3.265986 -6.531973e+00
## [3,] 0.000000 0.000000 1.601186e-15

4 解方程组

4.1普通方程组

解普通方程组可以用函数solve()，solve()的基本用法是solve(A,b)，其中，A为方程组的系数矩阵，b为方程组的右端。例如：

已知方程组：

$$ \begin{cases} 2x_1+2x_3=1\ 2x_1+x_2+2x_3=2\ 2x_1+x_2=3 \end{cases} $$

解法如下：

A=matrix(
c(2,0,2,
 2,1,2,
 2,1,0),
 byrow=TRUE,nrow=3
)

b=1:3

b

solve(A,b)

即$x_1=1$ ，$x_2=1$ ，$x_3=-0.5$ 。

4.2 特殊方程组

对于系数矩阵是上三角矩阵和下三角矩阵的方程组。R中提供了backsolve()和fowardsolve()来解决这个问题。

backsolve(r, x, k=ncol(r), upper.tri=TRUE, transpose=FALSE)

forwardsolve(l, x, k=ncol(l), upper.tri=FALSE, transpose=FALSE)

这两个函数都是符合操作的函数，大致可以分为三个步骤：

通过将系数矩阵的上三角或者下三角变为0的到新的系数矩阵,这通过upper.tri参数来实现，若upper.tri=TRUR，上三角不为0。
通过将对步骤1中得到的新系数矩阵进行转置得到新的系数矩阵，这通过transpose参数实现，若transpose=FALSE，则步骤1中得到的系数矩阵将被转置。
根据步骤2得到的系数矩阵来解方程组。

$$ \begin{cases} X_1+4X_2+7X_3=1\ 2X_1+5X_2+8X_3=2\ 3X_1+6X_2+9X_3=3 \end{cases} $$

方程组的系数矩阵为：

A <- matrix(
 c(1,4,7,
 2,5,8,
 3,6,9),
 byrow=TRUE,
 nrow = 3
)

b=1:3

backsolve(A,b,upper.tri=T,transpose=F)

## [1] -0.8000000 -0.1333333 0.3333333

过程分解：

upper.tri=T，说明系数矩阵的上三角不为0。

B=A

B[lower.tri(B)]=0

B

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 0 5 8
## [3,] 0 0 9

transpose=F说明系数矩阵未被转置。
解方程：

solve(B,b)

## [1] -0.8000000 -0.1333333 0.3333333

5 其它

5.1矩阵的向量化

将矩阵向量化有时候是必要的。矩阵的向量化可以通过as.vector()来实现：

A <- matrix(1:9,nrow=3)

A

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9

将矩阵元素向量化：

as.vector(A)

## [1] 1 2 3 4 5 6 7 8 9

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9

将矩阵的方阵部分元素向量化：

as.vector(A[1:min(dim(A)),1:min(dim(A))])

## [1] 1 2 3 4 5 6 7 8 9

5.2矩阵的合并

5.2.1矩阵的列合并

矩阵的列合并可以通过cbind()来实现。

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9

B=1:3

cbind(A,B)

## B
## [1,] 1 4 7 1
## [2,] 2 5 8 2
## [3,] 3 6 9 3

5.2.2矩阵的行合并

矩阵的行合并可以通过rbind()来实现。

## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9

B=1:3

rbind(A,B)

## [,1] [,2] [,3]
## 1 4 7
## 2 5 8
## 3 6 9
## B 1 2 3

R语言绘制维恩图

Sat, 27 Aug 2011 00:00:00 +0000

很久之前整理的关于R绘制维恩图的资料，虽然，用R绘制维恩图并不是很常见，还是记下一笔，以备需要者参考。

# Gplots包
library(gplots)

## 
## 载入程序包：'gplots'

## The following object is masked from 'package:stats':
## 
## lowess

A<- 1:20
B<- 1:20
C<- 2:20
D<- 3:21

input<-list(A,B,C,D)
input

## [[1]]
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 
## [[2]]
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 
## [[3]]
## [1] 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 
## [[4]]
## [1] 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

venn(input)

A<- as.logical(rbinom(100, 1, 0.2))
B<- as.logical(rbinom(100, 1, 0.7))
C<- as.logical(rbinom(100, 1, 0.2))
D<- as.logical(rbinom(100, 1, 0.1))

input<-data.frame(A,B,C,D)
venn(input)

tmp <- venn(input, simplify=TRUE)

## Warning in drawVennDiagram(data = counts, small = small, showSetLogicLabel = showSetLogicLabel, : Not shown: 0101 contains 2

tmp

## num A B C D
## 0000 0 0 0 0 0
## 0001 1 0 0 0 1
## 0010 4 0 0 1 0
## 0011 0 0 0 1 1
## 0100 36 0 1 0 0
## 0101 2 0 1 0 1
## 0110 6 0 1 1 0
## 0111 1 0 1 1 1
## 1000 5 1 0 0 0
## 1001 0 1 0 0 1
## 1010 0 1 0 1 0
## 1011 1 1 0 1 1
## 1100 15 1 1 0 0
## 1101 1 1 1 0 1
## 1110 6 1 1 1 0
## 1111 1 1 1 1 1
## attr(,"intersections")
## attr(,"intersections")$A
## [1] "18" "29" "32" "54" "58"
## 
## attr(,"intersections")$B
## [1] "12" "14" "19" "22" "28" "30" "34" "36" "40" "43" "45" "46" 
## [13] "51" "52" "53" "57" "60" "66" "67" "68" "69" "70" "73" "75" 
## [25] "76" "77" "78" "80" "81" "87" "88" "89" "92" "94" "98" "100"
## 
## attr(,"intersections")$C
## [1] "6" "10" "33" "84"
## 
## attr(,"intersections")$D
## [1] "79"
## 
## attr(,"intersections")$`A:B`
## [1] "2" "5" "9" "13" "17" "21" "25" "26" "27" "38" "39" "44" "49" "50" "56"
## 
## attr(,"intersections")$`B:C`
## [1] "20" "71" "72" "82" "83" "97"
## 
## attr(,"intersections")$`B:D`
## [1] "62" "63"
## 
## attr(,"intersections")$`A:B:C`
## [1] "3" "11" "47" "74" "85" "95"
## 
## attr(,"intersections")$`A:B:D`
## [1] "96"
## 
## attr(,"intersections")$`A:C:D`
## [1] "7"
## 
## attr(,"intersections")$`B:C:D`
## [1] "23"
## 
## attr(,"intersections")$`A:B:C:D`
## [1] "37"
## 
## attr(,"class")
## [1] "venn"

venn(input, showSetLogicLabel=TRUE)

# asbio包
library(asbio)

## 载入需要的程序包：tcltk

Venn(A=.3,B=.2,AandB=.06)

# limma包
# install.packages("BiocManager")
# BiocManager::install("limma")
library(limma)
Y <- matrix(rnorm(100*6),100,6)
Y[1:10,3:4] <- Y[1:10,3:4]+3
Y[1:20,5:6] <- Y[1:20,5:6]+3
design <- cbind(1,c(0,0,1,1,0,0),c(0,0,0,0,1,1))
fit <- eBayes(lmFit(Y,design))
results <- decideTests(fit)
a <- vennCounts(results)
print(a)

## x1 x2 x3 Counts
## 1 0 0 0 88
## 2 0 0 1 8
## 3 0 1 0 0
## 4 0 1 1 4
## 5 1 0 0 0
## 6 1 0 1 0
## 7 1 1 0 0
## 8 1 1 1 0
## attr(,"class")
## [1] "VennCounts"

vennDiagram(a)

vennDiagram(results,include=c("up","down"),counts.col=c("red","green"))

# venneuler包

library(venneuler)

## 载入需要的程序包：rJava

vd <- venneuler(c(A=0.3, B=0.3, C=1.1, "A&B"=0.1, "A&C"=0.2, "B&C"=0.1 ,"A&B&C"=0.1))

plot(vd)

m <- data.frame(elements=c("1","2","2","2","3"),sets=c("A","A","B","C","C"))
 
v <- venneuler(m)

plot(v)

m <- as.matrix(data.frame(A=c(1.5, 0.2, 0.4, 0, 0),B=c(0, 0.2, 0, 1, 0), C=c(0, 0, 0.3, 0, 1)))

v <- venneuler(m > 0)

plot(v)

v <- venneuler(m)

plot(v)

# Vennerable包

# BiocManager::install("graph")
# BiocManager::install("RBGL")
# BiocManager::install("reshape")
# install.packages("Vennerable", repos="http://R-Forge.R-project.org")

library(Vennerable)

## 载入需要的程序包：graph

## 载入需要的程序包：BiocGenerics

## 载入需要的程序包：generics

## 
## 载入程序包：'generics'

## The following objects are masked from 'package:base':
## 
## as.difftime, as.factor, as.ordered, intersect, is.element, setdiff,
## setequal, union

## 
## 载入程序包：'BiocGenerics'

## The following objects are masked from 'package:rJava':
## 
## anyDuplicated, duplicated, unique

## The following object is masked from 'package:limma':
## 
## plotMA

## The following objects are masked from 'package:stats':
## 
## IQR, mad, sd, var, xtabs

## The following objects are masked from 'package:base':
## 
## anyDuplicated, aperm, append, as.data.frame, basename, cbind,
## colnames, dirname, do.call, duplicated, eval, evalq, Filter, Find,
## get, grep, grepl, is.unsorted, lapply, Map, mapply, match, mget,
## order, paste, pmax, pmax.int, pmin, pmin.int, Position, rank,
## rbind, Reduce, rownames, sapply, saveRDS, table, tapply, unique,
## unsplit, which.max, which.min

## 载入需要的程序包：RBGL

## 载入需要的程序包：grid

## 载入需要的程序包：lattice

## 载入需要的程序包：RColorBrewer

## 载入需要的程序包：reshape

## 载入需要的程序包：gtools

## 载入需要的程序包：xtable

## 
## 载入程序包：'Vennerable'

## The following object is masked from 'package:asbio':
## 
## Venn

Venn(n=3)

## A Venn object on 3 sets named
## 1,2,3 
## 000 100 010 110 001 101 011 111 
## 1 1 1 1 1 1 1 1

plot(Venn(n=3))

data(StemCell)
w <- Venn(Sets=StemCell[1:2])
Weights(w)

## 00 10 01 11 
## 0 219 875 404

plot(w)

Weights(w) <- 1:4
plot(w)

draw.circle:R中的绘圆利器

Wed, 03 Aug 2011 00:00:00 +0000

R用户经常要在图形中绘圆，如果你是其中的一员的话，你就不得不了解一下plotrix包中的draw.circle()函数。draw.circle()函数的优点有：

任意指定位置
随意设定圆内的颜色
随意设定圆的线型
随意设定圆线的颜色

library(plotrix)
plot(1:5,seq(1,10,length=5),type="n",xlab="",ylab="",main="Test draw.circle()")
draw.circle(2,4,c(1,0.66,0.33),border="purple",
col=c("#ff00ff","#ff77ff","#ffccff"),lty=1,lwd=1)
draw.circle(2.5,8,0.6,border="red",lty=3,lwd=3)
draw.circle(4,3,0.7,border="green",lty=1,lwd=1)
draw.circle(3.5,7,0.8,border="blue",lty=2,lwd=2)

用四个参数拟合大象

Thu, 23 Jun 2011 00:00:00 +0000

冯·诺依曼说过一句话，

With four parameters I can fit an elephant, and with five I can make him wiggle his trunk.

冯·诺依曼说这句话的时候，当然是一种隐喻。他的大致意思是说，当一个模型能够完美拟合一个数据集的时候，不要沾沾自喜或者得意到脱掉下巴。因为之所以出现这种情况很可能是因为模型的参数太多，而不是模型的形式很好。如果给模型足够多的参数，我们实际上可以完美的拟合任何数据集。

虽然用四个参数来拟合大象并非是冯·诺依曼的本意，可是打他说出来这句话起，就有很多人前赴后继地研究如何用四个参数来真的拟合出来一头大象。后来，Jurgen Mayer, Khaled Khairy, and Jonathon Howard在论文“Drawing an elephant with four complex parameters”当真实现了这句话。

绘制大象的R代码如下：

p1=50-30i
p2=18+8i
p3=12-10i
p4=-14-60i
p5=40+20i

fourier=function(tt,CC){
f=numeric(length(tt));
A=Re(CC);
B=Im(CC);
k=1:length(CC);
for(i in 1:length(tt)){
co=cos(tt[i]*k)
si=sin(tt[i]*k)
f[i]=sum(A*co+B*si)
f
}
f
}

elephant=function(tt,p1,p2,p3,p4,p5){
n=6
Cx=complex(n);
Cy=complex(n);
Cx[1]=Re(p1)*1i
Cx[2]=Re(p2)*1i
Cx[3]=Re(p3)
Cx[5]=Re(p4)
Cy[1]=Im(p4)+Im(p1)*1i
Cy[2]=Im(p2)*1i
Cy[3]=Im(p3)*1i

x=fourier(tt,Cx)
y=fourier(tt,Cy)
res=cbind(y,-x)
res
}

tt=seq(from=0,to=2*pi,length=100)
el=elephant(tt,p1,p2,p3,p4,p5)

plot(el,type="l",col="red",ylab="",xlab="",lwd=2)
points(Im(p5),Im(p5),pch=20,col="red")

获取交易明细数据

Mon, 16 May 2011 00:00:00 +0000

或许是因为大学期间经常不吃早饭的原因，最终我的侥幸心理被无情的现实打破，不幸于上周罹患反流性食道炎。因为身体十分不适，所以也懒得写东西。

数天前，我在COS上发布了一个获取股市交易明细的R代码。几经修缮，臻于完整。将来我会将它们放入iquant包中。

两个示例如下：

source("get.nowdata.r"); #载入代码
nowdata=get.nowdata("000061"); #获取000061的交易明细数据

返回结果如下：

$symbol
[1] "000061"

$Company
[1] "农产品"

$Date
[1] "2011年05月16日 15:00"

$Details
Time Volum Price Turnover Orders NIO
1    09:25:02   133 17.57    23.44   平盘   0
2    09:30:02   251 17.60    44.21   流入   2
3    09:30:32    68 17.60    11.97   平盘   0
4    09:30:52     2 17.65     0.35   流入   2
5    09:31:02     8 17.78     1.42   流入   2
6    09:31:12     4 17.65     0.71   流出   1
7    09:31:22    11 17.80     1.96   流入   2
8    09:31:32     6 17.78     1.07   流入   2
9    09:31:42    10 17.66     1.91   平盘   0
10   09:31:47     6 17.73     1.06   流入   2
11   09:32:22    10 17.73     1.77   流入   2
12   09:32:37     3 17.73     0.53   流出   1
13   09:32:47     8 17.73     1.42   流出   1
14   09:32:52     4 17.73     0.71   流出   1
15   09:32:57    74 17.67    13.10   流出   1
16   09:33:12    10 17.73     1.77   流入   2
17   09:33:32     4 17.73     0.71   流入   2
18   09:33:37     6 17.73     1.06   流出   1
19   09:33:52    14 17.75     2.48   流入   2
20   09:34:02    12 17.73     2.12   流入   2
21   09:34:22     2 17.69     0.35   流出   1
22   09:34:27     3 17.69     0.53   流出   1
23   09:34:42     2 17.69     0.35   流出   1
24   09:34:47     1 17.73     0.18   流入   2
25   09:34:57     9 17.69     1.59   流出   1
26   09:35:07     1 17.69     0.18   流出   1
27   09:35:17    82 17.75    14.55   流入   2
28   09:35:22    13 17.75     2.31   流出   1

获得历史数据：

source("get.historydata.r"); #载入get.historydata.r
historydata=get.historydata("000061","20110401"); #获取000061在2011年4月1日的交易明细数据

结果如下：

$symbol
[1] "000061"

$Company
[1] "农产品"

$Date
[1] "2011年4月01日"

$Details
Time Volum Price Turnover Orders NIO
1    09:25:06    84 16.70    14.03   平盘   0
2    09:30:06    72 16.72    12.03   流入   2
3    09:30:11     5 16.74     0.84   流入   2
4    09:30:16    18 16.74     3.01   流入   2
5    09:30:21    18 16.74     3.01   流入   2
6    09:30:31    11 16.72     1.84   流出   1
7    09:30:36    50 16.75     8.37   流入   2
8    09:30:41    11 16.72     1.84   流出   1

函数代码文件： get.historydata get.nowdata

R获取股票数据

Thu, 14 Apr 2011 00:00:00 +0000

R中有多个包都提供了从线上数据库获取股票数据的方法。如果非得在其中找出一个最好的，quantmod当之无愧。譬如下载沪市大盘数据，代码可以是：

library(quantmod) 
SSE <- getSymbols("000001.SS",auto.assign=FALSE) 
head(SSE)

或者：

library(quantmod) 
setSymbolLookup(SSE=list(name="000001.SS", src="yahoo")) 
getSymbols("SSE") 
head(SSE)

以上是Jeff Ryan（quantmod作者）推荐过的方法。不过，后来JoshuaUlrich在他的邮件中给出了一个更简洁的方法：

library(quantmod) 
getSymbols("^SSEC") 
head(SSEC)

虽然quantmod的包出自Jeff Ryan之手，显而易见，在这一点上Joshua Ulrich是青出于蓝而胜于蓝。

quantmod：R中的金融分析包

Sun, 10 Apr 2011 00:00:00 +0000

大概两年前，写了一份quantmod的读书笔记。当时只是草草完成，不足之处很多。于是，一直以来都有修缮之心，思忖良久，前段时间终于开始着手，目前大致确定了内容。先将完成的部分记在这里。

用R拟合Vasicek模型

Sun, 10 Apr 2011 00:00:00 +0000

Vasicek模型几乎可以说是最常见的利率模型。在金融领域有着很大的用处，可以用R来做Vasicek模型的人显然不够多。

这里给出一个拟合Vasicek模型的代码：

#Vasicek negloglike函数:
VASICEKnegloglike<-function(param,data,times){ n.obs<-length(data)
 dum<-sort.list(times)
 data<-data[dum]
 times<-times[dum]
 delta<-diff(times,1)
 mv<-data[1:(n.obs-1)]*exp(-param[2]*delta)+param[1]*(1-exp(-param[2]*delta))
 variance<-param[3]^2*(1-exp(-2*param[2]*delta))/(2*param[2])
 VASICEKnegloglike<--sum(log(dnorm(data[2:n.obs],mv,sqrt(variance))))/n.obs
}

# VASICEKyield函数
VASICEKyield<-function(r,tau,Pparam,riskpremium=0)
{ b<-Pparam[1]+riskpremium
 a<-Pparam[2]
 sig<-Pparam[3]
 Btau<-(1-exp(-a*tau))/a
 Atau<-((Btau-tau)*(a^2*b-0.5*sig^2)/a^2 - sig^2*Btau^2/(4*a))
 VASICEKyield<-r*Btau/tau-Atau/tau
}

# 数据实例
maturities<-c(0.25,0.5,1,2,5,10)
spliceddata<-matrix(scan("http://www.math.ku.dk/~rolf/teaching/mfe04/USrates.52to04.dat"),byrow=T,ncol=7)
obs<-spliceddata[,2]
N<-length(obs)-1
dt<-1/12
data<-obs[2:(N+1)]
lagdata<-obs[1:N]
dates<-spliceddata[,1]

#Closed form estimators
bhat<-(sum(data*lagdata) - sum(data)*sum(lagdata)/N)/(sum(lagdata*lagdata) - sum(lagdata)*sum(lagdata)/N)
kappahat<--log(bhat)/dt
ahat<-sum(data)/N-bhat*sum(lagdata)/N
thetahat<-ahat/(1-bhat)
s2hat<-sum((data-lagdata*bhat-ahat)^2)/N
sigmahat<-sqrt(2*kappahat*s2hat/(1-bhat^2))
#plot the data (or more accurately, the short rate)
plot(dates[2:(N+1)],data,type='l', xlab="date", ylab="US 3M rate", main="US short rate 1952-2004")
abline(h=thetahat, lty=3)
text(dates[10], thetahat, "thetahat")

tstVAS<-optim(par=c(thetahat,kappahat,sigmahat),
 fn=VASICEKnegloglike,method = "BFGS", data=obs,times=dates)
#analyze average yield curves
meanyield<-2:7
for(i in 1:6) meanyield[i]<-mean(spliceddata[,i+1])
plot(maturities,meanyield,type='l',ylim=c(0.05,0.068),xlim=c(0,14),
 ylab="mean/average/typical yield",
	 main="Typical yield curves w/ US 1952-2004 data")
text(maturities[6],meanyield[6], "Average observed yield curve")
points(maturities,VASICEKyield(meanyield[1],maturities,tstVAS$par,riskpremium=0),type='l',lty=2)
text(maturities[6],VASICEKyield(meanyield[1],maturities[6],tstVAS$par,riskpremium=0)+0.001,
 "Typical Vasicek model curve, I (r0 = avr. short rate, risk premium=0) ")
points(maturities,VASICEKyield(thetahat,maturities,tstVAS$par,riskpremium=0),type='l',lty=2)
text(maturities[6],VASICEKyield(thetahat,maturities[6],tstVAS$par,riskpremium=0)-0.0005,"Typical Vasicek model curve, II (r0 = thetahat, risk premium=0) ")

rpfit<-function(rp){
rpfit<-sum(abs(meanyield-VASICEKyield(meanyield[1],maturities,tstVAS$par,riskpremium=rp)))
}

rp<-optim(par=c(0),fn=rpfit,method = "BFGS")$par

theory<-VASICEKyield(meanyield[1],maturities,tstVAS$par,riskpremium=rp)
points(maturities,theory,type='l',lty=2)

text(maturities[6],theory[6],"Typical Vasicek model curve, III (r0=avr. short rate, risk premium='what fits best') ")

plot(maturities,spliceddata[(N+1),2:7],type='l',ylab="yield",ylim=c(0.01,0.06),xlim=c(0,13), main="On the last day in the sample")

text(maturities[6],spliceddata[(N+1),7], "Observed yield curve")

points(maturities,VASICEKyield(spliceddata[(N+1),3],maturities,tstVAS$par,riskpremium=rp),type='l',lty=2)

text(maturities[6],VASICEKyield(spliceddata[(N+1),3],maturities[6],tstVAS$par,riskpremium=rp),"Vasicek model 'prediction' (w/ all the estimates) ")

从Tsay的书看R的未来

Sat, 09 Apr 2011 00:00:00 +0000

Tsay写的最著名的书叫《Analysis of Financial Time Series》，这本书目前已经到了第三版。可能很少有人注意到，第三版跟第二版比在书籍介绍里有一个微妙的变化：

第二版的部分书籍介绍如下： Software packages used in the book: SCA (Scientific Computing Associates), S-Plus with FinMetrics (Insightful) RATS (Regression Analysis of Time Series), and ** R with RMetrics (newer version is recommended.)** Instructions and some demonstrations for using R and S-Plus can be found in my teaching web: R-demo

第三版的部分书籍介绍如下： The main software package used in the book is R: Other packages used are SCA (Scientific Computing Associates), S-Plus with FinMetrics (Insightful) RATS (Regression Analysis of Time Series).

Further Instructions and some demonstrations for using R and S-Plus can be found in my teaching web for Business 41202.

R从第二版屈居单词“and”之后，变成第三版“main software package”，我想这个变化再次印证了R的潜力。

scatterplot3d:一个特立独行的R包

Sun, 13 Jun 2010 00:00:00 +0000

scatterplot3d是一个力图在3D空间展示多维数据的R包，在这个包里只含有一个函数scatterplot3d()，这一点上可谓是特立独行。scatterplot3d()的用法如下：

 scatterplot3d(x, y=NULL, z=NULL, color=par("col"), pch=NULL,
 main=NULL, sub=NULL, xlim=NULL, ylim=NULL, zlim=NULL,
 xlab=NULL, ylab=NULL, zlab=NULL, scale.y=1, angle=40,
 axis=TRUE, tick.marks=TRUE, label.tick.marks=TRUE,
 x.ticklabs=NULL, y.ticklabs=NULL, z.ticklabs=NULL,
 y.margin.add=0, grid=TRUE, box=TRUE, lab=par("lab"),
 lab.z=mean(lab[1:2]), type="p", highlight.3d=FALSE,
 mar=c(5,3,4,3)+0.1, col.axis=par("col.axis"),
 col.grid="grey", col.lab=par("col.lab"),
 cex.symbols=par("cex"), cex.axis=0.8 * par("cex.axis"),
 cex.lab=par("cex.lab"), font.axis=par("font.axis"),
 font.lab=par("font.lab"), lty.axis=par("lty"),
 lty.grid=par("lty"), lty.hide=NULL, lty.hplot=par("lty"),
 log="", ...)

这个函数的参数多到让人眼花缭乱。下面是几个例子:

先用scatterplot3d()画一个螺旋线：

library(scatterplot3d)
z <- seq(-10, 10, 0.01)
x <- cos(z)
y <- sin(z)
scatterplot3d(x, y, z, highlight.3d=TRUE, col.axis="blue",col.grid="lightblue",main="scatterplot3d - 1", pch=20)

再画半椭圆:

temp<- seq(-pi, 0, length = 50)
x <- c(rep(1, 50) %*% t(cos(temp)))
y <- c(cos(temp) %*% t(sin(temp)))
z <- c(sin(temp) %*% t(sin(temp)))
scatterplot3d(x, y, z, highlight.3d=TRUE,col.axis="blue", col.grid="lightblue",main="scatterplot3d - 2", pch=20)

将两者结合，输出结果很像龙盘柱。有点酷！

 x <- c(rep(1, 50) %*% t(cos(temp)))
 y <- c(cos(temp) %*% t(sin(temp)))
 z <- 10 * c(sin(temp) %*% t(sin(temp)))
 color <- rep("green", length(x))
 temp <- seq(-10, 10, 0.01)
 x <- c(x, cos(temp))
 y <- c(y, sin(temp))
 z <- c(z, temp)
 color <- c(color, rep("red", length(temp)))
 scatterplot3d(x, y, z, color, pch=20, zlim=c(-2, 10),main="scatterplot3d - 3")

来一个比较庸俗的，三维bar图：

my.mat <- matrix(runif(25), nrow=5)
dimnames(my.mat) <- list(LETTERS[1:5], letters[11:15])
s3d.dat <- data.frame(cols=as.vector(col(my.mat)),rows=as.vector(row(my.mat)),value=as.vector(my.mat))
scatterplot3d(s3d.dat, type="h", lwd=5, pch=" ",x.ticklabs=colnames(my.mat),y.ticklabs=rownames(my.mat))

上面的可以说都不是很实用，下面看一下二维回归平面图：

data(trees)
s3d <- scatterplot3d(trees, type="h", highlight.3d=TRUE,angle=55, scale.y=0.7, pch=16, main="scatterplot3d - 5")
s3d$points3d(seq(10,20,2), seq(85,60,-5), seq(60,10,-10),col="blue", type="h", pch=16)
 # 画回归平面
attach(trees)
my.lm <- lm(Volume ~ Girth + Height)
s3d$plane3d(my.lm, lty.box = "solid")

我看见有很多帖子索要二维正态分布的示意图，这里画一个，

 library(mvtnorm)
 x1 <- seq(-10, 10, length = 51)
 x2 <- seq(-10, 10, length = 51)
 dens <- matrix(dmvnorm(expand.grid(x1,x2),sigma=rbind(c(3,2),c(2,3))),ncol=length(x1))
 s3d<-scatterplot3d(x1,x2,seq(min(dens),max(dens),length=length(x1)),
 type="n",grid=FALSE,angle = 70,
 zlab=expression(f(x[1],x[2])),
 xlab=expression(x[1]),ylab=expression(x[2]),
 main="Bivariate normal distribution")
 text(s3d$xyz.convert(-1,10,0.07),
 labels=expression(f(x)==frac(1,sqrt((2*pi)^n*phantom(".")*det(Sigma[X])))*phantom(".")*exp(bgroup("(",-scriptstyle(frac(1,2)*phantom("."))*(x-mu)^T*Sigma[X]^-1*(x-mu),")"))))
 for(i in length(x1):1)
 s3d$points3d(rep(x1[i], length(x2)), x2, dens[i,], type = "l")
 for(i in length(x2):1)
 s3d$points3d(x1, rep(x2[i], length(x1)), dens[,i], type = "l")

之所以画下面这个，完全是因为我贪图色彩：

 cubedraw <- function(res3d, min = 0, max = 255, cex = 2, text. = FALSE)
 {
 cube01 <- rbind(c(0,0,1), 0, c(1,0,0), c(1,1,0), 1, c(0,1,1), # < 6 outer
 c(1,0,1), c(0,1,0)) 
 cub <- min + (max-min)* cube01
 res3d$points3d(cub[c(1:6,1,7,3,7,5) ,], cex = cex, type = 'b', lty = 1)
 res3d$points3d(cub[c(2,8,4,8,6), ], cex = cex, type = 'b', lty = 3)
 if(text.)
 text(res3d$xyz.convert(cub), labels=1:nrow(cub), col='tomato', cex=2)
 }
 cc <- colors()
 crgb <- t(col2rgb(cc))
 par(xpd = TRUE)
 rr <- scatterplot3d(crgb, color = cc, box = FALSE, angle = 24,
 xlim = c(-50, 300), ylim = c(-50, 300), zlim = c(-50, 300))
 cubedraw(rr)

 rbc <- rainbow(201)
 Rrb <- t(col2rgb(rbc))
 rR <- scatterplot3d(Rrb, color = rbc, box = FALSE, angle = 24,
 xlim = c(-50, 300), ylim = c(-50, 300), zlim = c(-50, 300))
 cubedraw(rR)
 rR$points3d(Rrb, col = rbc, pch = 16)

支持向量机

Wed, 05 May 2010 00:00:00 +0000

支持向量机(Support Vector Machine,SVM)是Corinna Cortes和Vapnik等于1995年首先提出的一种机器学习方法，它在解决小样本、非线性及高维模式识别中表现出许多特有的优势，并能够推广应用到函数拟合等其他机器学习问题中。

通俗的介绍一下这个过程:

我们有一些数据点，这些数据点是n维实空间中的点。我们希望能够把这些点通过一个n-1维的超平面分开。通常这个被称为线性分类器。有很多分类器都符合这个要求。但是我们还希望找到分类最佳的平面，即使得属于两个不同类的数据点间隔最大的那个面，该面亦称为最大间隔超平面。如果我们能够找到这个面，那么这个分类器就称为最大间隔分类器。

理解了上面这段话就可以理解支持向量机了。支持向量机是将向量映射到一个更高维的空间里，在这个空间里建立有一个最大间隔超平面。在分开数据的超平面的两边建有两个互相平行的超平面。建立方向合适的分隔超平面使两个与之平行的超平面间的距离最大化。其假定为，平行超平面间的距离或差距越大，分类器的总误差越小。而所谓支持向量是指那些在间隔区边缘的训练样本点。这里的“机（machine,机器）”实际上是一个算法。在机器学习领域，常把一些算法看做是一个机器。

学习支持向量机知识的一个极好指南是C.J.CBurges的《模式识别支持向量机指南》。

目前，R中已经实现了支持向量机算法(相关的包有e1071包、kernlab包、klar包和svmpath包。以数据iris和cats为例加以说明：

library(e1071)
library(MASS)
data(cats)
m= svm(Sex~., data = cats)
plot(m, cats)

data(iris)
m2=svm(Species~., data = iris)
plot(m2, iris, Petal.Width ~ Petal.Length, slice = list(Sepal.Width = 3, Sepal.Length = 4))

plot(m, cats, svSymbol = 1, dataSymbol = 2, symbolPalette = rainbow(4),color.palette =terrain.colors)

支持向量机还可以用到股票价格的预测上，具体案例回头再写。

BEKK模型

Thu, 15 Apr 2010 00:00:00 +0000

BEKK模型是目前比较流行的多变量波动性模型，可以看作GARCH模型在多维空间的实现。BEKK模型在应用过程中也有诸多缺点，其中最大的一个不足之处在于模型的待估计参数会随着模型维数的增加指数型增长。然而，这一点肯定会随着计算机的发展而被逐渐克服的。

R软件中提供了mgarch和mgarchBEKK两个包来估计BEKK模型参数。

mgarch包及其示例

# 安装包（如果未安装）
# devtools::install_github("https://github.com/vst/mgarch")

library(mgarch)

## 载入需要的程序包：tseries

## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo

## 载入需要的程序包：mvtnorm

先看mgarch包，该包有三个主要函数：

mvBEKK.sim: 模拟一个MGARCH-BEKK过程
mvBEKK.est: 估计MGARCH-BEKK模型的参数
mvBEKK.diag:对拟合的MGARCH-BEKK模型进行诊断

可以通过以下命令查询相关函数的用法：

?mvBEKK.sim
?mvBEKK.est
?mvBEKK.diag

运行以下命令可以模拟一个MGARCH-BEKK过程：

set.seed(123)
sim = mvBEKK.sim(series.count = 3, T = 1000)

## Class attributes are accessible through following names:
## length series.count order params true.params eigenvalues uncond.cov.matrix white.noise eps cor sd

合并模拟的时间序列：

eps = data.frame(sim$eps[[1]], sim$eps[[2]], sim$eps[[3]]) 
head(eps)

## sim.eps..1.. sim.eps..2.. sim.eps..3..
## 1 0.9472441 1.2177306 0.5491724
## 2 -1.1241768 -0.3366113 -0.6261458
## 3 0.7179649 -0.3272567 1.6880032
## 4 -0.4857962 1.2230006 -1.9563961
## 5 -1.1301479 4.0603942 -1.3856283
## 6 0.2057734 1.1435079 -0.6392246

tail(eps)

## sim.eps..1.. sim.eps..2.. sim.eps..3..
## 995 -1.43678861 -0.8651118 -1.55380698
## 996 -1.10173653 -0.5863329 -1.14479754
## 997 -1.06902893 -0.4398771 -3.08558958
## 998 -0.11478218 0.7226409 -3.00375826
## 999 -1.18562636 2.4487154 -0.04579639
## 1000 0.05764529 -0.2241948 0.86390660

估计模型参数：

est <- mvBEKK.est(eps)

## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...

## Warning in mvBEKK.est(eps): negative inverted hessian matrix element

查看估计结果包含哪些信息：

names(est)

## [1] "eps" "series.length" "estimation.time" 
## [4] "total.time" "order" "estimation" 
## [7] "aic" "asy.se.coef" "est.params" 
## [10] "cor" "sd" "H.estimated" 
## [13] "eigenvalues" "uncond.cov.matrix" "residuals"

模型诊断：

mvBEKK.diag(est)

## 	Number of estimated series : 3 
## 	Length of estimated series : 1000 
## 	Estimation Time : 32.41842 
## 	Total Time : 32.98894 
## 	BEKK order : 1 1 
## 	Eigenvalues : 0.8982855 0.5101535 0.4535976 0.3020472 0.2611067 0.2258987 0.1373383 0.05469751 0.05280793 
## 	aic : 4163.509 
## 	unconditional cov. matrix : 2.654942 -0.4582163 0.8566066 -0.4582163 2.38067 0.1093766 0.8566066 0.1093766 2.01 
## 	var(resid 1 ) : 0.999399 
## 	mean(resid 1 ) : -0.03860414 
## 	var(resid 2 ) : 0.9988757 
## 	mean(resid 2 ) : 0.04335019 
## 	var(resid 3 ) : 0.997348 
## 	mean(resid 3 ) : 0.02152967 
## 	Estimated parameters :
## 
## 	C estimates:
## [,1] [,2] [,3]
## [1,] 0.8909642 0.3328637 0.34152387
## [2,] 0.0000000 0.9827892 0.05270326
## [3,] 0.0000000 0.0000000 1.01236445
## 
## 	ARCH estimates:
## [,1] [,2] [,3]
## [1,] 0.340809760 0.06992293 0.07918491
## [2,] -0.064873614 0.36049917 0.35553210
## [3,] -0.008381618 -0.06665216 0.50150310
## 
## 	GARCH estimates:
## [,1] [,2] [,3]
## [1,] -0.3353086 0.37376137 -0.5032390
## [2,] 0.2151724 0.03756262 0.4608374
## [3,] 0.1756196 0.01577004 -0.4594647
## 
## 	asy.se.coef : 
## 
## 	C estimates, standard errors:
## [,1] [,2] [,3]
## [1,] 0.07738385 0.1351731 0.2359051
## [2,] 0.00000000 0.1141723 0.2671477
## [3,] 0.00000000 0.0000000 0.2311768
## 
## 	ARCH estimates, standard errors:
## [,1] [,2] [,3]
## [1,] 0.05481912 0.05484527 0.07796872
## [2,] 0.04677913 0.05338068 0.07267995
## [3,] 0.02304154 0.02555282 0.04677987
## 
## 	GARCH estimates, standard errors:
## [,1] [,2] [,3]
## [1,] 0.17105425 0.19123870 0.31018515
## [2,] 0.17509179 0.26972309 0.33665408
## [3,] 0.05380941 0.07028591 0.09210273
## Called from: mvBEKK.diag(est)
## debug: for (i in 1:length(estimation$eps)) {
## plot(estimation$residuals[[i]])
## browser()
## dev.off()
## }
## debug: plot(estimation$residuals[[i]])

## debug: browser()
## debug: dev.off()
## debug: plot(estimation$residuals[[i]])

## debug: browser()
## debug: dev.off()
## debug: plot(estimation$residuals[[i]])

## debug: browser()
## debug: dev.off()

mgarchBEKK包及其示例

# 安装包（如未安装）
# devtools::install_github("https://github.com/vst/mgarchBEKK")

# 加载包
library(mgarchBEKK)
# 模拟mgarchBEKK过程
simulated <- simulateBEKK(2, 1000, c(1,1))

## Class attributes are accessible through following names:
## length series.count order params true.params eigenvalues uncond.cov.matrix white.noise eps cor sd

# 合并模拟数据
simulated <- do.call(cbind, simulated$eps)
# 估计模型
estimated <- BEKK(simulated)

## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...
## H IS SINGULAR!...

## Warning in BEKK(simulated): negative inverted hessian matrix element

# 模型诊断
diagnoseBEKK(estimated)

## 	Number of estimated series : 2000 
## 	Length of estimated series : 1000 
## 	Estimation Time : 3.208226 
## 	Total Time : 3.330154 
## 	BEKK order : 1 1 
## 	Eigenvalues : 0.7940983 0.7122278 0.5839173 0.5353965 
## 	aic : 4614.775 
## 	unconditional cov. matrix : 6.481396 1.496551 1.496551 7.939293 
## 	var(resid 1 ) : 1.000363 
## 	mean(resid 1 ) : -0.007109519 
## 	var(resid 2 ) : 0.9958192 
## 	mean(resid 2 ) : -0.01444951 
## 	Estimated parameters :
## 
## 	C estimates:
## [,1] [,2]
## [1,] 0.9304752 0.4214324
## [2,] 0.0000000 1.6921455
## 
## 	ARCH estimates:
## [,1] [,2]
## [1,] -0.5382996 0.003724502
## [2,] 0.3896205 -0.351431137
## 
## 	GARCH estimates:
## [,1] [,2]
## [1,] 0.3804035 0.5270529
## [2,] -0.2806881 0.6526116
## 
## 	asy.se.coef : 
## 
## 	C estimates, standard errors:
## [,1] [,2]
## [1,] 0.2069876 0.5373757
## [2,] 0.0000000 0.2889314
## 
## 	ARCH estimates, standard errors:
## [,1] [,2]
## [1,] 0.04044854 0.04641720
## [2,] 0.02825686 0.04050683
## 
## 	GARCH estimates, standard errors:
## [,1] [,2]
## [1,] 0.05265359 0.05895967
## [2,] 0.06856104 0.07941475

## Called from: diagnoseBEKK(estimated)
## debug: dev.off()
## debug: plot(estimation$residuals[[i]])

## debug: browser()
## debug: dev.off()

四龟追逐问题

Mon, 29 Mar 2010 00:00:00 +0000

四龟行走是一个很著名的论题，题目的大意是这样的：

在一个房间的四个角上，分别有一只乌龟。在某一个时刻t同时出发以匀速V走向顺时针方向的下一只乌龟，如果他们的方向始终对准目标，那么它们的运动轨迹是怎样的？

这道题目的解答方法至少有三个：

借助微分方程来解答，这是最正经的解法，但是也最没有意思，是"书虫"才干的出来的事情。
常理判断。由于四龟地位完全对称，而相邻两龟运动方向始终垂直，因此四龟轨迹对称且都是螺旋线。这是极其聪明的人才能干出的事情。
统计模拟方法。这个方法兼具艺术性和趣味性，而且不会远离群众，是有趣的人会干出的事情。

关于前两个这里一笔带过，第三个方法在薛毅很久之前的一本书《统计建模与R软件》是有提及过。怡轩说，这个统计模拟的例子于他有着特殊的意义。巧合的是，四龟行走也恰恰是我学习统计学的启蒙案例。也就是在见到这个例子的刹那，我才初次领悟了编程的景致之所在，也开始了对编程的敬仰之旅。

前段时间，在看自然图形时，突然发现自然界很多植物如“紫荆花”等等都有着类似四龟行走轨迹的花型。因此萌发妄想将它写成一个动画。我尽量避免使用复杂的数学语言来描述以上过程，因为我觉得数学语言尽管清晰有时候只会耽误大众对事情本质的理解。

下面是一段模拟四龟行走问题的R代码：

# 加载必要的包
library(ggplot2)
library(gganimate)

# 模拟参数设置
V <- 0.02 # 移动速度
dt <- 0.01 # 时间步长
total_time <- 500 # 总模拟时间
threshold <- 0.01 # 停止阈值

# 初始化四只乌龟的起始位置（正方形顶点）
turtles <- matrix(c(
 0.0, 1.0, # 左上角乌龟1
 1.0, 1.0, # 右上角乌龟2
 1.0, 0.0, # 右下角乌龟3
 0.0, 0.0 # 左下角乌龟4
), ncol = 2, byrow = TRUE)

# 轨迹记录矩阵
history <- data.frame(
 turtle = integer(),
 time = numeric(),
 x = numeric(),
 y = numeric()
)

# 主循环模拟
current_time <- 0
while(current_time < total_time) {
 # 计算各乌龟的目标方向
 new_positions <- matrix(nrow = 4, ncol = 2)
 
 for(i in 1:4) {
 current_pos <- turtles[i, ]
 target_pos <- turtles[(i %% 4) + 1, ]
 
 # 计算方向向量并标准化
 direction <- target_pos - current_pos
 distance <- sqrt(sum(direction^2))
 
 if(distance < threshold) break # 提前终止条件
 
 unit_direction <- direction / distance
 displacement <- V * dt * unit_direction
 
 new_positions[i, ] <- current_pos + displacement
 }
 
 # 记录当前时刻所有位置
 for(i in 1:4) {
 history <- rbind(history, data.frame(
 turtle = i,
 time = current_time,
 x = turtles[i, 1],
 y = turtles[i, 2]
 ))
 }
 
 # 同步更新所有乌龟位置
 turtles <- new_positions
 current_time <- current_time + dt
}

# 可视化静态轨迹
ggplot(history, aes(x, y, color = factor(turtle))) +
 geom_path(aes(group = turtle), linewidth = 0.8) +
 geom_point(data = subset(history, time == min(time)), 
 size = 4, shape = 19) + # 起始点
 geom_point(data = subset(history, time == max(time)), 
 size = 4, shape = 4) + # 终止点
 scale_color_manual(values = c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4")) +
 coord_fixed() +
 theme_minimal() +
 labs(title = "四龟追逐运动轨迹", color = "乌龟编号")

# 生成动态可视化（需要安装gganimate）
anim <- ggplot(history, aes(x, y, color = factor(turtle))) +
 geom_path(aes(group = turtle), alpha = 0.5) +
 geom_point(size = 3) +
 transition_reveal(time) +
 scale_color_manual(values = c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4")) +
 coord_fixed() +
 labs(title = '时间: {frame_along}', x = 'X坐标', y = 'Y坐标', color = '乌龟编号')

animate(anim, fps = 20, duration = total_time, width = 600, height = 600)

R on 格物堂

R数据库交互系列笔记：DBI包

1 简介

2 DBI连接SQLite数据库

3 查询数据库结构

4 查询语句

5 基于查询结果构建R中的数据对象

6 ODBC

7 参考文献

R中的金融数据接口

安装RMySQL

下载并安装 MySQL

把MySQL添加到Path变量.

关联MySQL和R软件

下载并安装RTools

下载RMySQL源代码

运行代码安装RMySQL

R软件中的集合计算操作

WDI包：从世界银行获取世界发展指标数据

add.indicator函数笔记

时空数据可视化

修改chartSeries绘图结果的x轴标签

R中的金融分析包：quantmod学习笔记补充版

安装mgarch包终极解决方案

方案一：

方案二：

方案三:

安装mgarchBEKK包

有用但不易被发现的R函数：file.choose

自动下载财务套表

从东方财富网获取股票开户数据

几本关于R的书籍

R中的量化投资包：quantstrat

quantstrat是什么东西？

quantstrat涉及的量化策略基础知识

基于信号的策略的泛型建模

Quantstrat如何构建策略？

参数匹配规则

乱码，又见乱码

获取上市公司主要财务指标

R中的斯皮尔曼等级相关检验与异方差

棘手的R乱码和给力的iconv函数

R语言在线资源列表

R是一种生活，数据是一种态度

quantmod:R中的金融分析包（学习笔记）

weibo数据开发思路

R语言书籍的学习路线图

1.初级入门

2.高级入门

3.绘图与可视化

4.计量经济学

5.时间序列分析

6.金融

7.数据挖掘

R数据分析实例

回归模型（Regression Models）

二分变量及分类模型（Models for Binary and Categorical Outcomes）

计数模型（Count Models）

双侧截断回归（Censored and Truncated Regression）

多因素分析（Multivariate Analysis）

效能/样本量分析（Power Analysis / Sample Size）

其它

从股票代码到公司名

R数据分析实例：稳健回归

简介

数据描述

稳健回归

思考：

参考资料：

更多内容：

R中的3维HCPC图

apply函数族入门

R与月跨度函数，理论与应用的差距

非线性模型极大似然估计方法

一、模型设定与概率框架

二、似然函数构建

1. 联合概率密度函数

2. 负对数似然函数（目标函数）

三、参数估计流程

1. 数据处理与准备