10001036 : Study 6

5%缺失率的影响

###### 5% missingness effect on \mu and \sigma #####
mr=.05; ##missing rate
mc=(-500:500)*.01;
v=mc*0+NA;
m=v;
f1<-function(x) x * dnorm(x);
f2<-function(x) x^2 * dnorm(x);

for (i in 1:length(mc)) {
if ((pnorm(mc[i]) > mr/2) & (pnorm(-mc[i]) > mr/2)){
c.l = qnorm(pnorm(mc[i]) - mr/2);
c.r = qnorm(pnorm(mc[i]) + mr/2);
m[i]= ( - integrate(f1,lower=c.l,upper=c.r)$value) /(1-mr);
v[i]= (1 - integrate(f2,lower=c.l,upper=c.r)$value) /(1-mr)-m[i]^2;
}
}
op<-par(mfrow=c(2,1));
plot(mc[!is.na(v)],sqrt(v[!is.na(v)]),
type="l",
xlab=paste("position of the ",mr*100,"% missing interval"),
ylab=expression( ~sigma)
);
abline(h=1,col='grey');
plot(mc[!is.na(v)],m[!is.na(v)],type="l",
xlab=paste("position of the ",mr*100,"% missing interval"),
ylab=expression( ~mu)
);
abline(h=0,col='grey');
par(op);
##

#### 5% missing data on tail or in centre #####
op<- par(mfrow=c(2,1))
x= (-500:500)/100;
xp=(x<=qnorm(.05));
plot(x,y_1<-dnorm(x),type="h",ylab="freq");
points(x[xp],dnorm(x[xp]),type="h",col="grey");
xp=((x<=qnorm(.5+.05/2)) & (x>=qnorm(.5-.05/2)));
points(x[xp],dnorm(x[xp]),type="h",col="blue");

plot(x,x*.8,ylab="y(complete)",xlab="x(MNAR)",type="n");
x<-rnorm(500);
y<-rnorm(500)*.6+.8*x;
points(x,y);
xp=(x<=qnorm(.05));
points(x[xp],y[xp],col="grey");
xp=(x<=qnorm(.5+.05/2)) & (x>=qnorm(.5-.05/2))
points(x[xp],y[xp],col="blue");
points(x[order(x)],predict(loess(y~x))[order(x)],type="l",col="red");
par(op);

任意缺失率的影响

##### missing rate vs mu & sigma bounds #####
mark.rv=.075; ##Input missing rate here
mrv=0.0001*(1:2000); ##missing rate varies from 0001 to .2000
mrv=c(mark.rv,mrv);
m=mrv*0+NA;
v.max=m;
v.min=m;
f1<-function(x) x * dnorm(x);
f2<-function(x) x^2 * dnorm(x);

for (i in 1:length(mrv))
{
mr = mrv[i];
c.l = -Inf;	c.r = qnorm(mr);##missing at one side
m[i]= ( - integrate(f1,lower=c.l,upper=c.r)$value) /(1-mr);
c.l = qnorm(mr/2);c.r=-c.l;##missing at both sides
v.min[i]= (integrate(f2,lower=c.l,upper=c.r)$value) /(1-mr)-m[i]^2;
c.l = qnorm(.5 - mr/2);
c.r = qnorm(.5 + mr/2);##missing at center
v.max[i]= (1 - integrate(f2,lower=c.l,upper=c.r)$value) /(1-mr);
}
op<-par(mfrow=c(2,1));
plot(rbind(mrv[-1],mrv[-1]),sqrt(rbind(v.min[-1],v.max[-1])),
type="n",
xlab=paste("missing rate=",mark.rv),
ylab=expression(~sigma),
main=paste(sqrt(v.min[1]),sqrt(v.max[1]))
);
points(mrv[-1],sqrt(v.min[-1]),type="l");
points(mrv[-1],sqrt(v.max[-1]),type="l");
abline(v=mark.rv,col='grey');
plot(mrv[-1],m[-1],type="l",
xlab=paste("missing rate=",mark.rv),
ylab=expression( ~mu),
main=paste(m[1])
);
abline(v=mark.rv,col='grey');
par(op);

10001036

Study 6

Categories

Meta

Blog Search

Recent Comments

链接表

Recent Posts

Archives

Pages