找回密码
 注册
查看: 461|回复: 0

R语言 RMC包 examplesForDiagnostics()函数中文帮助文档(中英文对照)

[复制链接]
发表于 2012-9-26 23:56:11 | 显示全部楼层 |阅读模式
examplesForDiagnostics(RMC)
examplesForDiagnostics()所属R语言包:RMC

                                        The examples section of this help file provides code to produce the plots in Section 5.1 of Foster and Bravington (2009).
                                         这个帮助文件的例子“一节提供的代码产生的图在福斯特和Bravington(2009)第5.1节。

                                         译者:生物统计家园网 机器人LoveR

描述----------Description----------

This help file provides code to generate illustrative, simulated examples for different types of data/model discrepancies. The examples are those given in Section 5.1 of Foster and Bravington (2009). The code is provided so that any interested reader of that paper can, if they want, reproduce the results.
此帮助文件提供了代码来生成例子说明,模拟不同类型的数据/模型的差异。的例子是那些在的福斯特和Bravington(2009)第5.1节给。提供的代码,纸,任何有兴趣的读者,如果他们想复制的结果。


(作者)----------Author(s)----------


Scott D. Foster



参考文献----------References----------

<h3>See Also</h3>

实例----------Examples----------


## common parameters for the examples[#常用参数的例子]
nc <- 5
n <- 1000
n.cats <- 4
B&lt;-50        #number of simulations for simulated envelopes. The paper uses 1000 but this can be pretty slow[一些模拟的模拟信封。本文使用1000年,但很慢]
####################################################[################################################## #]
####        Example of stationary well-fitting models        ####[###示例的固定拟合模型####]
####################################################[################################################## #]
set.seed(21)
#simulating data -- will be the same as dataEG1[模拟数据 - 将是相同dataEG1]
chain <- sim.chain( n.chains=nc, n.obs=rep( n, nc), n.cats=n.cats, n.covars=1, beta=c(0,0.3,-0.3,0), gamma=c(0.5,0.2,1,0))
#plotting start of first chain as an example (Figure 1 of paper)[作为一个例子(图1的纸张)绘制开始的第一链]
m <- 100
plot( 1:m, head( chain[chain[,"chain"]==2,"state"],m), type='b', pch=19, main="Start of Example Chain", ylab="State", xlab="Index", axes=FALSE)
abline(h=c(1:n.cats), lty=3, col=grey(0.5))
axis(1)
axis( 2, 1:n.cats, 1:n.cats)
box()
#fitting the model[拟合模型]
fm.est <- RMC.mod( states=chain[,2], chain.id=chain[,1], X=chain[,3])
#defining true model[定义真实模型]
fm <- fm.est
fm$pars <- c( 0.5,0.2,1,0,0.3,-0.3,0)
#generating simulation envelope[产生模拟信封]
temp.est <- diagnos.envel( obs.states=chain[,2], chain.id=chain[,1], X=chain[,3,drop=FALSE], fit=fm.est, B=B)
#plotting patch residuals (Figure 2 of paper)[的绘图补丁残差(图2中的纸张)]
par( mfrow=c( 1,2))
my.cat <- 2
hrplot( temp.est[["patch"]][[my.cat]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Example Data, state 2", pch=19)
my.cat <- 3
hrplot( temp.est[["patch"]][[my.cat]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Example Data, state 3", pch=19)
#plotting movement residuals (Figure 3 of paper)[绘制运动残差(图3的纸张)]
hrplot( temp.est$movement, ylab="Movement Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Example Data", pch=20)
#############################################################[################################################## ##########]
####        Example of non-stationary good well-fitting models        ####[###示例的非平稳良好的拟合模型####]
#############################################################[################################################## ##########]
set.seed( 10)
#simulating data -- will be the same as dataEG2[模拟数据 - 将是相同dataEG2]
X <- cbind( rep( 1, nc*n), simRandWalk( nc=nc, ni=rep( n, nc), init.var=1, seq.var=0.1)[,-1])
colnames( X) <- c( "const", "rand2")
n.covs <- 2
gpar <- matrix( c( c( -0.6, 0), c( 1.1, 1.5), c( 0.2, 0), c( -1.25, -1.5)), nrow=n.covs, ncol=n.cats)
bpar <- matrix( c( rep( 0, n.covs), c( -0.9, 0.5), c( 0.8, -0.4), c( -0.4, -0.7)), nrow=n.covs, ncol=n.cats)
chain.ns <- sim.chain( n.chains=nc, n.obs=rep( n, nc), n.cats=n.cats, n.covars=n.covs, beta=bpar, gamma=gpar, X=X)
#setting up model[建立模型]
my.phi.id <- ifelse( gpar!=0, 1, 0)
my.pi.id <- apply( bpar, FUN=function(x){if( any( x!=0)) 1 else 0}, MARG=1)
#fitting the model[拟合模型]
fm.est1 <- RMC.mod( states=chain.ns[,2], chain.id=chain.ns[,1], X=chain.ns[,3:4], phi.id=my.phi.id, pi.id=my.pi.id)
#generating simulation envelope[产生模拟信封]
temp1 <- diagnos.envel( chain.id=chain.ns[,1], obs.states=chain.ns[,2], X=chain.ns[,3:4], fit=fm.est1, B=B)
#plotting residuals (Figure 4 of paper)[绘制残差(图4的纸张)]
par(mfrow=c(1,3))
my.cat <- 2
hrplot( temp1[["patch"]][[my.cat]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Non-Stationary Data, state 2", pch=20)
my.cat <- 3
hrplot( temp1[["patch"]][[my.cat]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Non-Stationary Data, state 3", pch=20)
hrplot( temp1$movement, ylab="Movement Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Non-Stationary Data", pch=20)
##################################[#################################]
####                Adding  outliers                ####[###添加离群值####]
##################################[#################################]
set.seed( 25)
#simulating data -- will be the same as dataEG3patch and dataEG3movement[模拟数据 - 是相同的为dataEG3patch和dataEG3movement的]
chain.orig <- sim.chain( n.chains=nc, n.obs=rep( n, nc), n.cats=n.cats, n.covars=1, beta=c(0,0.3,-0.3,0), gamma=c(0.5,0.2,1,0))
chain1 <- chain2 <- chain.orig
chain1[301:320,"state"] <- 3
ids <- sample( setdiff( 1nc*n), seq( from = n, to = n*nc, by = n) ) , 100)
chain2[ ids,"state"] <- 3
chain2[ ids+1, "state"] <- 4
#fit the models[适合车型]
fm1 <- RMC.mod( states=chain1[,2], chain.id=chain1[,1], X=chain1[,3])
fm2 <- RMC.mod( states=chain2[,2], chain.id=chain2[,1], X=chain2[,3])
#generate simulation envelopes[生成模拟信封]
temp1 <- diagnos.envel( chain.id=chain1[,1], obs.state=chain1[,2], X=chain1[,3,drop=FALSE], fm1, B=B)
temp2 <- diagnos.envel( chain.id=chain2[,1], obs.state=chain2[,2], X=chain2[,3,drop=FALSE], fm2, B=B)
#plotting residuals (Figure 5 of paper)[绘制残差纸(图5)]
par(mfrow=c(1,2))
hrplot( temp1[["patch"]][[3]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Data with Patch Outlier", pch=20)
hrplot( temp2$movement, ylab="Movement Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Data with Repetition Outlier", pch=20)
##################################[#################################]
####        Omitting Covariates                ####[#######省略协变量]
##################################[#################################]
set.seed(13)
#simulating data -- will be the same as dataEG4[模拟数据 - 将是相同dataEG4]
X <- cbind( rep( 1, nc*n), simRandWalk( nc=nc, ni=rep( n, nc), init.var=1, seq.var=0.1)[,-1])
colnames( X) <- c( "const", "rand2")
n.covs <- 2
gpar <- matrix( c( c( -0.6, 0), c( 1.1, 1.5), c( 0.2, 0), c( -1.25, -1.5)), nrow=n.covs, ncol=n.cats)
bpar <- matrix( c( rep( 0, n.covs), c( -0.9, 0.5), c( 0.8, -0.4), c( -0.4, -0.7)), nrow=n.covs, ncol=n.cats)
chain <- sim.chain( n.chains=nc, n.obs=rep( n, nc), n.cats=n.cats, n.covars=n.covs, beta=bpar, gamma=gpar, X=X)
#setting up model[建立模型]
my.phi.id <- ifelse( gpar!=0, 1, 0)
my.pi.id <- apply( bpar, FUN=function(x){if( any( x!=0)) 1 else 0}, MARG=1)
#fit the models (correct and incorrect)[适合的模型(正确的和不正确的)]
fm.est <- RMC.mod( states=chain[,2], chain.id=chain[,1], X=chain[,3,drop=FALSE])
fm.est1 <- RMC.mod( states=chain[,2], chain.id=chain[,1], X=chain[,3:4], phi.id=my.phi.id, pi.id=my.pi.id)
#generate simulation envelopes[生成模拟信封]
temp <- diagnos.envel( chain.id=chain[,1], obs.states=chain[,2], X=chain[,3,drop=FALSE], fit=fm.est, B=B)
temp1 <- diagnos.envel( chain.id=chain[,1], obs.states=chain[,2], X=chain[,-(1:2)], fit=fm.est1, B=B)
#plotting residuals[绘制残差]
par( mfrow=c( 2, 3))
my.set <- c( 1, 4)
hrplot( temp[["patch"]][[my.set[1]]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Mean Only Model", pch=20)
hrplot( temp[["patch"]][[my.set[2]]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Mean Only Model", pch=20)
hrplot( temp$movement, ylab="Movement Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Mean Only Model", pch=20)
       
hrplot( temp1[["patch"]][[my.set[1]]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Correct Model", pch=20)
hrplot( temp1[["patch"]][[my.set[2]]], ylab="atch Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Correct Model", pch=20)
hrplot( temp1$movement, ylab="Movement Residuals - Normal Quantiles", xlab="Normal Quantiles", main="Correct Model", pch=20)

转载请注明:出自 生物统计家园网(http://www.biostatistic.net)。


注:
注1:为了方便大家学习,本文档为生物统计家园网机器人LoveR翻译而成,仅供个人R语言学习参考使用,生物统计家园保留版权。
注2:由于是机器人自动翻译,难免有不准确之处,使用时仔细对照中、英文内容进行反复理解,可以帮助R语言的学习。
注3:如遇到不准确之处,请在本贴的后面进行回帖,我们会逐渐进行修订。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

手机版|小黑屋|生物统计家园 网站价格

GMT+8, 2024-11-23 23:45 , Processed in 0.023808 second(s), 16 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表