如何获得R绘制的完整图表?

时间:2016-08-22 14:01:18

标签: r

我已经尝试了很多次但仍然无法获得R绘制的完整图像,而不是截断的一个二重奏到“空间不足”?

请有人帮我解决这个问题。

下面是我的截图和R代码:

enter image description here

library(foreign, pos=4)
REmodeldata_continuous <- 
read.dta("F:/data for R.dta",
convert.dates=TRUE, convert.factors=TRUE, missing.type=TRUE, 
convert.underscore=TRUE, warn.missing.labels=TRUE)

library(R2WinBUGS)

REmodel_continuous<-function(){

for(i in 1:ns){                      #   LOOP THROUGH STUDIES  
w[i,1] <-  0    # adjustment for multi-arm trials is zero for control arm  
delta[i,1] < -  0             # treatment effect is zero for control arm  
mu[i] ~ dnorm(0,.0001)           # vague priors for all trial baselines 
for (k in 1:na[i]) {             #  LOOP THROUGH ARMS  
    var[i,k] < -  pow(se[i,k],2)   # calculate variances  
    prec[i,k] <-  1/var[i,k]      # set precisions 
    y[i,k] ~ dnorm(theta[i,k],prec[i,k]) # binomial likelihood 
    theta[i,k] < - mu[i] + delta[i,k]  # model for linear predictor 
#Deviance contribution 
    dev[i,k] < -  (y[i,k] -theta[i,k])*(y[i,k] -theta[i,k])*prec[i,k]  
   } 
#  summed residual deviance contribution for this trial  
resdev[i] < -  sum(dev[i,1:na[i]])         
for (k in 2:na[i]) {             # LOOP THROUGH ARMS  
# trial-specific LOR distributions 
    delta[i,k] ~ dnorm(md[i,k],taud[i,k])  
# mean of LOR distributions, with m ulti-arm trial correction 
    md[i,k] <-   d[t[i,k]] -  d[t[i,1]] + sw[i,k]  
# precision of LOR distributions (with multi-arm trial correction) 
    taud[i,k] < - tau *2*(k -1)/k  
# adjustment, multi-arm RCTs 
    w[i,k] <-  (delta[i,k] -  d[t[i,k]] + d[ t[i,1]])  
# cumulative adjustment for multi-arm trials 
    sw[i,k] < -  sum(w[i,1:k -1])/(k-1)  
   } 
}    
totresdev < -  sum(resdev[])            #Total Residual Deviance  
d[1]<-0       # treatment effect is zero for control arm  
# vague priors for  treatment effects  
for (k in 2:nt){  d[k] ~ dnorm(0,.0001) }  
sd ~ dunif(0,5)     # vague prior for between -trial SD 
tau <-  pow(sd,-2)   # between-trial precision = (1/between -trial variance)  

# All pairwise comparisons  
for (c in 1:(nt -1)) {  for (k in (c+1):nt)  { diff[c,k] < -  (d[c] -  d[k] )}}  
for (k in 1:nt) { 
rk[k] < -  nt+1 -rank(d[],k) # assumes events are “good”  
#rk[k] <-  rank(d[],k) # assumes events are “bad”  
best[k] < -  equals(rk[k],1) #calculate probability that treat k is best  
}         
}
# End of model

filename <- file.path("D://","REmodel_continuous.bug")

## write model file:
write.model(REmodel_continuous, filename)
## and let’s take a look:
file.show(filename)

#load data from dataset

t1<-REmodeldata_continuous$t1
y1<-REmodeldata_continuous$y1
se1<-REmodeldata_continuous$se1

t2<-REmodeldata_continuous$t2
y2<-REmodeldata_continuous$y2
se2<-REmodeldata_continuous$se2

t3<-REmodeldata_continuous$t3
y3<-REmodeldata_continuous$y3
se3<-REmodeldata_continuous$se3

t4<-REmodeldata_continuous$t4
y4<-REmodeldata_continuous$y4
se4<-REmodeldata_continuous$se4

na<-REmodeldata_continuous$na

t<-c(t1,t2,t3,t4)
y<-c(y1,y2,y3,y4)
se<-c(se1,se2,se3,se4)

dim(t)<-c(35,4)
dim(y)<-c(35,4)
dim(se)<-c(35,4)
ns<-35
nt<-23
data<-list("t","y","se","na","ns","nt")

#Set Initial Values
inits<-function(){ 
#Initial Values 
#chain 1  
list(d=c( NA, 0,0,0,0,0,0), sd=1, mu=c(0, 0, 0, 0, 0, 0, 0, 0 , 0, 0,  
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,  
0, 0, 0))

#chain 2  
list(d=c( NA,  -1, -3, -1,1,3,-1), sd=4, mu=c(-3, -3, -3, -3, -3, -3, -3,     -3, -3, -3,  
-3, -3, -3, -3, -3, -3, -3, -3, -3, -3,  
-3, -3, -3))

#chain 3  
list(d=c( NA, 2,2,2,2,2,2), sd=2, mu=c( -3, 5, -1, -3, 7,  -3, -4, -3, 5, -1,  
-3, 5, -1, -3, 7, -3, -4, -3, 5, -1,  
-3, 5, -1))
}

REmodel_continuous.sim<-    bugs(data,inits,model.file="D:/REmodel_continuous.bug",
                  parameters=c("diff","totresdev"),
                  n.chains=3,n.iter=40000,n.burnin=10000,
                  bugs.directory="C:/Program Files (x86)/WinBUGS14")

print(REmodel_continuous.sim, digits.summary=4)

plot(REmodel_continuous.sim)

0 个答案:

没有答案