Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!mach1!torn!spool.mu.edu!wupost!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: Cholesky
Message-ID: <1993May15.232154.19212@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
References: <1993May15.231328.18776@csus.edu>
Date: Sat, 15 May 1993 23:21:54 GMT
Lines: 91

This Cholesky routine assumes the argument is a symmetric 
PD matrix. As it is set up, it is the programmers responsibility to
check that this is the case. Accept for the macro, index, this hack 
is Christopher Browne's. As an aside, this program provides an
example of how arrays can be dynamically allocated at run time.

Emmett


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

#define toosmall ((double) 1.0e-14)
#define index(y,i,j) *((D*)(AV(y)+CHAR*((i*(AS(y)[1]))+j)))
F1(cholesky){A z; I N,row,i,j,k,nullity;D sum,**U,**A;

  /* if y is not numeric, square, with rank 2 signal error */
  ASSERT((BOOL+INT+FL)&AT(y),EVDOMAIN);
  ASSERT(AS(y)[0]==AS(y)[1],EVDOMAIN);
  ASSERT(2==AR(y),EVRANK);

  N = (I) sqrt(AN(y));
  A = (D**) malloc(N * sizeof(D*));
  U = (D**) malloc(N * sizeof(D*));
  for (i = 0 ; i < N; i++){
    U[i]=(D*) malloc(N * sizeof(D));
    for (j = 0 ; j < N ; j++)
      U[i][j] = 0.0;	/* Need to zero it out, otherwise there's     
			 * garbage in the section that should be      
			 * "zero" */                                  
  }

  /* make y a double */ 
  if(FL!=AT(y))
    y = cvt (FL,y);

  for (i = 0 ; i < N; i++){
    A[i] = (D**) (AV(y)+CHAR*((i*(AS(y)[1]))));
  }
  
  N = (I) sqrt(AN(y));
  nullity = 0;
  U[0][0] = sqrt(A[0][0]);
  for (row = 1; row < N; row++) {
    U[0][row] = A[0][row] / U[0][0];
  }
  
  for (row = 1; row < N; row ++) {
    /* Compute U[row][row] */
    sum = A[row][row];
    for (j = 0; j < row; j++)
      sum -= U[j][row]*U[j][row];
    if (sum > toosmall) {
      U[row][row] = sqrt(sum);
    }
    
    /* Now find elements U[k][row], k > row. */
    
    for (k = row+1; k < N; k++) {
      sum = A[row][k];
      for (j = 0; j < row; j++)
	sum -= U[j][k] * U[j][row];
      U[row][k] = sum/U[row][row];
    }
  }
  
  ASSERT(nullity==0,EVILNUM);	
  
  RZ(z=jma(FL,(N*N),2L));
  AS(z)[0]=AS(z)[1]=N;
  
  /* I haven't figured out a better way of doing this */
  for (i = 0 ; i < N; i++) {
    for (j = 0 ; j < N; j++)
      index(z,i,j)= U[i][j];
    free(U[i]);       /* Then throw the row away */
  }
  free(U);	      /* Free up U altogether */
  
/* **** Anything that gets malloc()ed for holding interim results
        really ought to get free()ed at the end, just so that RAM
        doesn't get thrown away needlessly.  It doesn't cost much
        time, and certainly would be important for large matrices.
   ***** */
  /* Free up the extra array, A */
  free(A);
  R z;
}

