Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!mach1!torn!spool.mu.edu!howland.reston.ans.net!zaphod.mps.ohio-state.edu!wupost!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: Cumulative Normal Distribution & LinkJ : An example
Message-ID: <1993Apr24.101931.29745@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
Date: Sat, 24 Apr 1993 10:19:31 GMT
Lines: 113


Here are 
 1. a makefile
 2. a LinkJ main.c program
 4. a tacit verb of the C program and a performance comparison.
(If you try this yourself, note that LINKJ must be set to one in
 both lj.h and js.h)

Emmett
-----------------------
# J Makefile for Unix

CC     = gcc
CFLAGS = -g 
HDR    = a.h io.h j.h jc.h je.h js.h jt.h p.h v.h x.h lj.h
OBJ    = main.o a.o ai.o ap.o au.o \
	c.o cc.o cd.o cf.o cg.o cp.o cr.o ct.o cx.o \
	f.o i.o io.o j.o k.o lj.o m.o  p.o pc.o pv.o \
	r.o rl.o rt.o s.o t.o ta.o u.o ut.o \
	v.o ve.o vg.o vi.o vm.o vp.o vs.o vx.o vz.o \
	w.o wn.o x.o xa.o xf.o xl.o

OB2    = vh.o vb.o xs.o

j      : $(OBJ) $(OB2)
	$(CC) -g $(OBJ) $(OB2) -lm -o j

$(OBJ) : $(HDR)

$(OB2): $(@:.o=.c) $(HDR)
	$(CC) -g -c $<


-----------------------
#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/23/93 */
static F1(norm){A z; 
int i;
long num,rank,type;
double d,r,s,t,*py,*pz,
C0 =  0.231641900,
C1 =  0.319381530,
C2 = -0.356563782,
C3 =  1.781477937,
C4 = -1.821255978,
C5 =  1.330274429,
PI =  3.141592654;
num  = AN(y);
rank = AR(y);
type = AT(y);
ASSERT(rank<=1L,EVRANK);
ASSERT(type==FL||type==INT||type==BOOL,EVDOMAIN);
if(FL!=type)y=(A)cvt(FL,y);
py=(double*)AV(y);
RZ(z=jma(FL,num,rank));
pz=(double*)AV(z);
for(i=0;i<num;i++){
d=*py;
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)*pz++=(r*t);      
 else *pz++=(1.-r*t);
  py++;
}
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);
}}

-----------------------
   NB. sample J session.
 
   C0 =. 0.231642
   C12345 =. '0.319382 _0.356564 1.781478 _1.821256 1.330274':11
   xt =. ^@-@-:@*: % %:@+:@o.@1:
   yt =. %@>:@(C0"_ * |)
   zt =. +/@(C12345 * 1 2 3 4 5&(^~)@yt)
   Ntacit0 =. (1: - xt * zt)`(xt * zt)@.(0&>) "0

   test =. 6!:2 , 7!:2@]
   norm =. 10!:0
   somenumbers =. ( %~ (-: - ( ? ]))) 2000
   (5) test 'norm somenumbers'
0.794 16384
   (5) test 'Ntacit0 somenumbers'
20.238 656724
   
