CI of Non-Centrality Parameter (ncp)

RMSEA= $\sqrt{\frac{ncp_{\chi^2}}{(N-1)df}}$

Cohen's $\delta$ = $\frac{ncp_t}{SD/SE}$

Cohen's $\tilde{f}^2$ = $\frac{ncp_F}{N}$

$\eta^2$ = $\frac{ncp_F}{ncp_F+N}$

* Steiger (2004, Eq. 48-51) and Smithson (2003, Eq. 5.17-5.19) used different definitions for Cohen's partial $\tilde{f}^2$ ( and partial $\eta^2$ ). This post adopted Steiger's definition divided by the total sample size $N$ , rather than by Smithson's denominator $(df_1 + df_2 + 1)$ .

## Parameters of the tested statistic ##
test  <-     'chisq';   ##$1, the statistic name -- 't', 'chisq', or 'f';
x <-         15;   ##$2, the statistic value;
df <-         5;   ##$3, the df, or the 1st df of F;
df2 <-         4;   ##$4, if the statistic is F, the 2nd df;
conf.level<- .95;   ##$5, confidence interval;
ND <-          3;   ##$6, number of decimal places, 0~7;

### Sample size(s) to calculate Effect Sizes from ncp
N=100; ## the sample size, for RMSEA, regression ( including ANOVA as a special case), and t-test (of the 1st group or the single group)
N2=50; ## the sample size of the 2nd group for independent two-sample (student's) t-test
###

### R codes for developers, not for common users ###
sND=paste("%1.",ifelse(ND>=0 & ND<8,floor(ND),3),"f",sep="");
ncpt<-function(x,q,df,confirm=FALSE) ##<!--
{
  .f<-function(ncp,x,df,q)abs(q-pt(x,df=df,ncp=ncp))
  .n<-1;
  while  (
    (
      (pt(x,df=df,ncp=-.n) < q+(1-q)/2 )
      |
        (pt(x,df=df,ncp=.n) > q/2)
    )
    &
      (.n < Inf)
  )
    .n <- .n *2 ;
  if (confirm)
    optimize(f=.f,x=x,df=df,q=q,interval=c(-.n,.n))
  else
    optimize(f=.f,x=x,df=df,q=q,interval=c(-.n,.n))$minimum
}

ncpchisq<-function(x,q,df,confirm=FALSE){
  .f<-function(ncp,x,df,q)abs(q - pchisq(x,df=df,ncp=ncp))
  if (pchisq(x,df=df)<=q){
    if (confirm) {
      minimum <-0;
      objective <- pchisq(x,df=df)-q;
      data.frame(minimum,objective)
    }else
      0
  }else {
    .n<- 1;
    while  (
      (pchisq(x,df=df,ncp=.n) > q/2)
      &
        (.n < Inf)
    )
      .n <- .n *2 ;
    if (confirm)
      optimize(f=.f,x= x,df=df,q=q,interval=c(0,.n))
    else
      optimize(f=.f,x= x,df=df,q=q,interval=c(0,.n))$minimum
  }
};
ncpf<-function(x,q,df1,df2,confirm=FALSE){
  .f<-function(ncp,x,df1,df2,q)abs(q - pf(x,df1=df1,df2=df2,ncp=ncp))
  if (pf(x,df1=df1,df2=df2)<=q){
    if (confirm) {
      minimum <-0;
      objective <- pf(x,df1=df1,df2=df2)-q;
      data.frame(minimum,objective)
    }else
      0
  }else {
    .n<- 1;
    while	(
      (pf(x,df1=df1,df2=df2,ncp=.n) > q/2)
      &
        (.n < Inf)
    )
      .n <- .n *2 ;
    if (confirm)
      optimize(f=.f,x= x,df1=df1,df2=df2,q=q,interval=c(0,.n))
    else
      optimize(f=.f,x= x,df1=df1,df2=df2,q=q,interval=c(0,.n))$minimum
  }
};## -->

test <- tolower(substring(test,1,1));
if (test=='c') {
  LB<-ncpchisq(x=x,q=conf.level+(1-conf.level)/2,df=df,confirm=TRUE);
  RB<-ncpchisq(x=x,q=(1-conf.level)/2,df=df,confirm=TRUE);
}else if (test=='f'){
  LB<-ncpf(x=x,q=conf.level+(1-conf.level)/2,df1=df,df2=df2,confirm=TRUE);
  RB<-ncpf(x=x,q=(1-conf.level)/2,df1=df,df2=df2,confirm=TRUE);
}else {
  LB<-ncpt(x=x,q=conf.level+(1-conf.level)/2,df=df,confirm=TRUE);
  RB<-ncpt(x=x,q=(1-conf.level)/2,df=df,confirm=TRUE);
}
LB
RB
LB<-LB$minimum;RB<-RB$minimum;##
HRed;
HBlue;

To view density plots

test  <-     'chisq';   ##the statistic name -- 't', 'chisq', or 'f';
ncp_H0 <- 4.5;
ncp_H1 <- 0;
df <-         5;   ##the df, or the 1st df of F;
df2 <-         4;   ##if the statistic is F, the denominator df;
q<- .95;            ##$5, the cumulative probability;
x <-         15;     ##the critical statistic;
ND <-          3;   ##number of decimal places, 0~7;

#####
sND=paste("%1.",ifelse(ND>=0 & ND<8,floor(ND),3),"f",sep="");
ncpt<-function(x,q,df,confirm=FALSE) ##<!--
{
  .f<-function(ncp,x,df,q)abs(q-pt(x,df=df,ncp=ncp))
  .n<-1;
  while  (
    (
      (pt(x,df=df,ncp=-.n) < q+(1-q)/2 )
      |
        (pt(x,df=df,ncp=.n) > q/2)
    )
    &
      (.n < Inf)
  )
    .n <- .n *2 ;
  if (confirm)
    optimize(f=.f,x=x,df=df,q=q,interval=c(-.n,.n))
  else
    optimize(f=.f,x=x,df=df,q=q,interval=c(-.n,.n))$minimum
}

test1 <- tolower(substring(test,1,1));

if (test1=='c') {
  ncp <-ncpchisq(x=x,q=q,df=df,confirm=TRUE)$minimum;
  qncp <- pchisq(x,df=df,ncp=ncp);
  xq <- qchisq(q,df=df,ncp=ncp_H0);
  vx <- seq(0,(max(ncp,ncp_H0,ncp_H1,x,xq)+df)*2+1,0.02);
  vy <- dchisq(vx,df=df,ncp=ncp);
  vy_H0 <- dchisq(vx,df=df,ncp=ncp_H0);
  vy_H1 <- dchisq(vx,df=df,ncp=ncp_H1);
  qx_H0 <- pchisq(x,df=df,ncp=ncp_H0);
  qx_H1 <- pchisq(x,df=df,ncp=ncp_H1);

}else if (test1=='f'){
  ncp <-ncpf(x=x,q=q,df1=df,df2=df2,confirm=TRUE)$minimum;
  qncp <- pf(x,df1=df,df2=df2,ncp=ncp);
  xq <- qf(q,df1=df,df2=df2,ncp=ncp_H0);
  vx <- seq(0,max(ncp,ncp_H0,ncp_H1,x,xq)+5,0.02);
  vy <- df(vx,df1=df,df2=df2,ncp=ncp);
  vy_H0 <- df(vx,df1=df,df2=df2,ncp=ncp_H0);
  vy_H1 <- df(vx,df1=df,df2=df2,ncp=ncp_H1);
  qx_H0 <- pf(x,df=df,df2=df2,ncp=ncp_H0);
  qx_H1 <- pf(x,df=df,df2=df2,ncp=ncp_H1);
}else {
  ncp <-ncpt(x=x,q=q,df=df,confirm=TRUE)$minimum;
  qncp <- pt(x,df=df,ncp=ncp);
  xq <- qt(q,df=df,ncp=ncp_H0);
  vx <- seq(min(ncp,ncp_H0,ncp_H1,x,xq)-5,max(ncp,ncp_H0,ncp_H1,x,xq)+5,0.02);
  vy <- dt(vx,df=df,ncp=ncp);
  vy_H0 <- dt(vx,df=df,ncp=ncp_H0);
  vy_H1 <- dt(vx,df=df,ncp=ncp_H1);
  qx_H0 <- pt(x,df=df,ncp=ncp_H0);
  qx_H1 <- pt(x,df=df,ncp=ncp_H1);
}
##-->
dfs=ifelse(test1=='f',paste(df,'/',df2,sep=''),as.character(df));
plot(rep(vx,3),c(vy,vy_H0,vy_H1),type='n',xlab=test,ylab=paste(test,'density'),
     main=paste("Pr(",test,"< ",sprintf(sND,xq),"; df=",dfs,", ncp=",ncp_H0,")=",q,"    ",
                "Pr(",test,"< ",x,"; df=",dfs,", ncp=",ncp_H0,")=",sprintf(sND,qx_H0),"(black curve)\n",
                "Pr(",test,"< ",x,"; df=",dfs,", ncp=",ncp_H1,")=",sprintf(sND,qx_H1),"(blue curve, red dash)\n",
                "Pr(",test,"< ",x,"; df=",dfs,", ncp=",sprintf(sND,ncp),
                ifelse(round(qncp-q,ND)==0,")=",")<"),q,"(red curve, red dash)\n"));
lines(vx,vy,col='red');
lines(vx,vy_H0,col='black');
lines(vx,vy_H1,col='blue');
abline(h=0);
abline(v=x,col='red',lty=2);
abline(v=xq,col='black',lty=2);
paste("<","hr/><","br/>Result","<","h1><","font color=blue><","/font><","br/>",
      "<","font color=black>Pr(",test,"< ",sprintf(sND,xq),";df=",dfs,", ncp=",ncp_H0,")=",q," <","br/> <","/font><","br/>",
      "<","font color=black>Pr(",test,"< ",x,";df=",dfs,", ncp=",ncp_H0,")=",sprintf(sND,qx_H0)," <","br/> <","/font><","br/>",
      "<","font color=blue>Pr(",test,"< ",x,";df=",dfs,", ncp=",ncp_H1,")=",sprintf(sND,qx_H1)," <","br/> <","/font><","br/>",
      "<","font color=red>Pr(",test,"< ",x,";df=",dfs,", ncp=",sprintf(sND,ncp),")=",sprintf(sND,qncp)," <","br/> <","/font><","br/>",
      "<","/h1>","<","hr/>",sep='')

Refereces:

Smithson, M. (2003). Confidence Intervals. Thousand Oaks, CA: Sage Publications.

Steiger, J. H. (2004). Beyond the F test: Effect size confidence intervals and tests of close fit in the analysis of variance and contrast analysis. Psychological Methods, 9(2), 164-182.

10001036

Xiaoxu's Teaching Notes

CI of Non-Centrality Parameter (ncp)

Leave a Reply Cancel reply