Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!mach1!torn!howland.reston.ans.net!darwin.sura.net!wupost!decwrl!decwrl!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: Re: Cumulative Normal Distribution & LinkJ : An example
Message-ID: <1993Apr27.050044.24751@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
References: <1993Apr24.101931.29745@csus.edu>
Date: Tue, 27 Apr 1993 05:00:44 GMT
Lines: 77

/* Here is the cumulative normal distribution example revisited.
In this implementation the monad 10!:0 has infinite rank. */

#include <stdio.h>
#include <string.h>
#include "lj.h"
#include <math.h>

/* norm() implements   10!:0 y; the cumulative normal distribution of y.  
/* originally coded by Joseph Allotta 
   LinkJ interface is Emmett Mclean 4/26/93 */
static F1(norm){A z; 
int i;
I num,rank,*psy,*psz;
double d,r,s,t,*pvy,*pvz,
C0 =  0.231641900,
C1 =  0.319381530,
C2 = -0.356563782,
C3 =  1.781477937,
C4 = -1.821255978,
C5 =  1.330274429,
PI =  3.141592654;

/* if y is not a numeric type signal error */
ASSERT((BOOL+INT+FL)&AT(y),EVDOMAIN);

/* get number of atoms and rank of y */
num  = AN(y);
rank = AR(y);

/* allocate z then define it's shape  */
RZ(z=jma(FL,num,rank));
psz = (long*)AS(z);
psy = (long*)AS(y);
for(i=0;i<rank;i++)
*psz++= *psy++;

/* convert y to FL (double) if it is INT or BOOL */
if(FL!=AT(y))y=(A)cvt(FL,y);
/* initialize pointer to values of y  */
pvy=(double*)AV(y);

/* initialize pointers to values of z */
pvz=(double*)AV(z);

/* assign values of z                 */
for(i=0;i<num;i++){
d=*pvy++;
r=exp(-pow(d,2)/2.)/sqrt(2.*PI);
s=1./((C0*fabs(d))+1.);
t=C1*s+C2*pow(s,2.)+C3*pow(s,3.)+C4*pow(s,4.)+C5*pow(s,5.);
if(d<0) *pvz++ = (r*t);      
 else *pvz++ =(1.-r*t);
}
R z;
}

static F2(ntr){}

C jc(k,f1,f2)I k;AF*f1,*f2;{
 switch(k){
  case 0:
   *f1=norm;                    /* monad of 10!:0                          */
   *f2=NULL;                     /* dyad  of 10!:0                          */
   R 1;                         /* indicate no error                       */
  default:
   ASSERT(0,EVNONCE);           /* 10!:k where k is not 0. error for now.  */
}}

main(){A t;C s[456];
 jinit();
 while(1){
  printf("   ");
  if(NULL==gets(s)||'\004'==*(s+strlen(s)-1))exit(0);
  t=jx(s);
  if(jerr)printf("jerr: %d\n",jerr); else if(!asgn)jpr(t);
}}
