/* ----------------------------------------------------- */
/*                  SPSS-Macro r_bis                     */
/*                                                       */
/*          (Version 2.0; D. Enzmann, 2002)              */
/*                                                       */
/* r_bis computes the biserial correlation of a dicho-   */
/* tomous variable with a continuous variable and its    */
/* significance. The biserial correlation computed is    */
/* restricted to upper and lower bounds of 1.0 and -1.0, */
/* respectively.                                         */
/*                                                       */
/* The dichotomous variable need not to be coded as 0/1. */
/* If one of the variable is a constant or if both       */
/* variables have more than two valid categories r_bis   */
/* will issue an error message. If both variables are    */
/* dichotomous, r_bis  may produce meaningless results   */
/* (a tetrachoric correlation coefficient should be      */
/* computed, instead).                                   */
/*                                                       */
/* If the number of cases is more than 12,0000 you have  */
/* to increase the default value of MXLOOPS to the       */
/* the number of cases in your current working file      */
/* after you installed the macro via INCLUDE.            */
/*                                                       */
/* Example:                                              */
/* One variable x is coded '1' for 'no/false' and '2'    */
/* for 'yes/true', the other variable y is continuous.   */
/* Your data file consists of about 22800 cases. First,  */
/* use the SET MXLOOP command once to increase the       */
/* default value of 12000 to at least 22800:             */
/* SET MXLOOP=23000.                                     */
/* Next, you can call r_bis with x and y as parameters   */
/* r_bis x y .                                           */
/*                                                       */
/* A full example can be found in the file EXAMP_R.SPS . */
/*                                                       */
/* ----------------------------------------------------- */.

set printback on
   /mxloops=120000.
PRESERVE.
set printback off.

define r_bis ( !positional !tokens(1)
              /!positional !tokens(1))

matrix.
get raw
   /file=*
   /variables=!1 !2
   /names = vname
   /missing omit.
compute tmpvars=make(1,5,0).
compute errmsg={' '}.
compute minmaxx=0.
compute minmaxy=0.

compute min=mmin(raw(:,1)).
compute max=mmax(raw(:,1)).
compute x0=0.
compute x1=0.
loop #i=1 to nrow(raw).
do if (raw(#i,1)=min).
+ compute x0=x0+1.
else if (raw(#i,1)=max).
+ compute x1=x1+1.
end if.
end loop.
compute xn = x0+x1.
do if min=max.
+ compute minmaxx=1.
end if.

compute min=mmin(raw(:,2)).
compute max=mmax(raw(:,2)).
compute tmpvars(1,1) = nrow(raw).
compute y0=0.
compute y1=0.
loop #i=1 to nrow(raw).
do if (raw(#i,2)=min).
+ compute y0=y0+1.
else if (raw(#i,2)=max).
+ compute y1=y1+1.
end if.
end loop.
compute yn = y0+y1.
do if min=max.
+ compute minmaxy=1.
end if.

do if yn=tmpvars(1,1).
+ compute tmpvars(1,2)=y0.
+ compute tmpvars(1,3)=y1.
else if xn=tmpvars(1,1).
+ compute tmpvars(1,2)=x0.
+ compute tmpvars(1,3)=x1.
end if.
do if minmaxx or minmaxy.
+ compute tmpvars(1,2)=0.
+ compute tmpvars(1,3)=0.
end if.
do if (xn=yn).
+ compute tmpvars(1,5)=1.
end if.

do if (tmpvars(1,2) > 0) and (tmpvars(1,3) > 0)
      and not(minmaxx or minmaxy).
+ compute SSCPMat=SSCP(raw-(make(tmpvars(1,1),1,1))
                            *csum(raw)/tmpvars(1,1)).
+ compute tmpvars(1,4) = SSCPMat(1,2)/sqrt(SSCPMat(1,1)*SSCPMat(2,2)).

/* compute idfnormal(n0/n,0,1) */
compute probn0n = tmpvars(1,2)/tmpvars(1,1).
compute pest=0.
compute neg=0.
compute flag=0.
do if probn0n > .5.
+ compute neg=1.
+ compute probn0n = 1-probn0n.
end if.
compute incr = 0.1251.
compute crit=0.0000001.
do if probn0n > .40130.
+ compute zpn0n = -0.25.
else if probn0n > .30854.
+ compute zpn0n = -0.50.
else if probn0n > .22663.
+ compute zpn0n = -0.75.
else if probn0n > .15866.
+ compute zpn0n = -1.00.
else if probn0n > .10565.
+ compute zpn0n = -1.25.
else if probn0n > .066808.
+ compute zpn0n = -1.50.
else if probn0n > .040060.
+ compute zpn0n = -1.75.
else if probn0n > .022751.
+ compute zpn0n = -2.00.
else if probn0n > .012225.
+ compute zpn0n = -2.25.
else if probn0n > .0062097.
+ compute zpn0n = -2.50.
else if probn0n > .0029798.
+ compute zpn0n = -2.75.
else if probn0n > .0013499.
+ compute zpn0n = -3.00.
+ compute crit=crit/2.
else if probn0n > .00023263.
+ compute zpn0n = -3.50.
else if probn0n > .000031672.
+ compute zpn0n = -4.00.
+ compute crit=crit/10.
else if probn0n > .0000033978.
+ compute zpn0n = -4.50.
+ compute crit=crit/100.
else if probn0n >= .0000002868.
+ compute zpn0n = -5.00.
end if.
do if probn0n >= .0000002868.
loop #i = 1 to 1000.
+ compute pest = cdfnorm(zpn0n).
+ do if (abs(probn0n-pest) > crit).
-   do if (probn0n > pest) and flag=1.
+     compute incr=-incr/2.
+     compute flag = 0.
-   else if (probn0n < pest) and flag=0.
+     compute incr=-incr/3.
+     compute flag = 1.
-   end if.
-   compute zpn0n = zpn0n + incr.
+ end if.
end loop if (abs(probn0n-pest) < crit).
else.
+ compute zpn0n = -5.0.
end if.
do if neg = 1.
+ compute zpn0n = -zpn0n.
+ compute probn0n = (1-probn0n).
end if.

+ COMPUTE d = EXP(-.5 * zpn0n**2)/sqrt(8*artan(1)).
+ compute rb = sqrt(tmpvars(1,2)*tmpvars(1,3))*tmpvars(1,4)/
              (d*tmpvars(1,1)).
+ do if rb > 1.0.
-   compute rb = 1.0.
+ end if.
+ do if rb < -1.0.
-   compute rb = -1.0.
+ end if.
+ compute sigm_rb=sqrt(tmpvars(1,2)*tmpvars(1,3))/
                  (d*tmpvars(1,1)*sqrt(tmpvars(1,1))).
+ compute z = rb/sigm_rb.
+ compute p = (1-cdfnorm(abs(z)))*2.
+ print {vname(1),' with ',vname(2)}
       /title 'Biseral correlation:'
       /format A8.
+ print {tmpvars(1,1),rb,p}
       /title ' '
       /clabels = 'N','r','p(2-sided)'
       /formats F13.5.
+ do if tmpvars(1,5)=1.
-   print errmsg
         /title '> warning: both variables are dichotomous'
         /format A1.
+ end if.
else if (tmpvars(1,2)=0) and (tmpvars(1,3)=0)
    and not(minmaxx or minmaxy).
+ print {vname(1),' with ',vname(2)}
       /title 'Biseral correlation:'
       /format A8.
+ print {tmpvars(1,1)}
       /title ' '
       /rlabels = 'N = '
       /formats F8.0.
+ print errmsg
       /title '> error: there is no dichotomous variable'
       /format A1.
else.
+ print {vname(1),' with ',vname(2)}
       /title 'Biseral correlation:'
       /format A8.
+ print {tmpvars(1,1)}
       /title ' '
       /rlabels = 'N = '
       /formats F8.0.
+ print errmsg
       /title '> error: at least one variable is a constant'
       /format A1.
end if.
end matrix.

!enddefine.
restore.

/* ---------------------------------------------- */.
/* r_bis is called by:                            */.
/*                                                */.
/* R_BIS var1 var2.                               */.
/*                                                */.
/* Remember to set the MXLOOP setting to the      */.
/* number of cases in your data file the first    */.
/* time you call R_BIS by using                   */.
/* SET MXLOOP=nnn.                                */.
/* (with nnn >= number of cases)                  */.
/* ---------------------------------------------- */.