Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!torn!howland.reston.ans.net!noc.near.net!uunet!wupost!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: Improved svd
Message-ID: <1993May17.050310.19488@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
References: <1993May17.045847.19218@csus.edu>
Date: Mon, 17 May 1993 05:03:10 GMT
Lines: 155

 
(Ug. Another post I posted cancelled and then reposted with 
fewer type-o's.)
 
I've cleaned up the LinkJ interface on svd routine I started on and
posted about a few weeks ago. (BTW, thanks to Lewis Robinson who provided
some inspiration and help.)

Attached are :

1. A sample session
2. A J verb, s, used for testing factorizations.
3. A J verb rm, used to create random real matrices, inputs to s.

I expect to review this program again in the next few weeks and
possible improve it.

If anyone missed my earlier post which includes the code from 
Bob Craig's svd program, email me and I'll send you a copy.

s =. i. 0 0
s =. s,'indices=. (<0 1)&|:@i.@$@]'
s =. s,'1!:2&2 y.'
s =. s,'svd=:10!:0 y.'
s =. s,'u =:>&(0&{) svd'
s =. s,'vt=:|:@>&(2&{) svd'
s =. s,'m=:(,~@#@|:)`(,~@#) @. (''''&$@({. >: }.)@$@|:@]) vt'
s =. s,'w=:(,@:>&(1&{)svd) indices}(m $ 0) '
s =. s,'1!:2&2 u;w;vt'
s =. s,'y. =. u +/ .* w +/ .* vt'
s =. s : ''

rm=.(2&+@(?,?)@4:) $ ?@(15"_ # 90"_)


   9!:3(5)

NB. See how rm works :
   rm ('')
11 68 41 47
19  4 61 61
   rm ('')
34  6
37 61
53 83
76 47

NB. Assign a as a random matrix and factor :
   10!:0 a =. rm ('')
+------------------------------+-------+------------------------------+
|_0.595286   0.651256 _0.470639|215.798|_0.159635  0.288235 0.00830455|
| _0.65376 _0.0520285  0.754911|45.7938|_0.542301 _0.229382   0.549545|
|_0.467154  _0.757073 _0.456737|26.3839|_0.555515 _0.412833  _0.720757|
|                              |       | _0.50044  0.792818  _0.086017|
|                              |       | _0.34841 _0.255565   0.413573|
+------------------------------+-------+------------------------------+

NB. Look at a :
   a
29 56 68 89 32
22 88 65 67 58
 6 56 79 24 39

NB. Lets print, factor, and remultiply:
   s a
29 56 68 89 32
22 88 65 67 58
 6 56 79 24 39
+------------------------------+-----------------------+--------------------------------------------------+
|_0.595286   0.651256 _0.470639|215.798       0       0| _0.159635 _0.542301 _0.555515  _0.50044  _0.34841|
| _0.65376 _0.0520285  0.754911|      0 45.7938       0|  0.288235 _0.229382 _0.412833  0.792818 _0.255565|
|_0.467154  _0.757073 _0.456737|      0       0 26.3839|0.00830455  0.549545 _0.720757 _0.086017  0.413573|
+------------------------------+-----------------------+--------------------------------------------------+
29 56 68 89 32
22 88 65 67 58
 6 56 79 24 39

NB. Run s with rm :
   s rm ('')
21 24
32 14
43 80
81  5
81 45
+--------------------+---------------+-------------------+
| _0.20726   0.140038|148.355       0|_0.834538 _0.550951|
|_0.232001 _0.0984511|      0 60.4045|_0.550951  0.834538|
|_0.538984   0.713062|               |                   |
|_0.474215  _0.669723|               |                   |
|_0.622764  _0.117091|               |                   |
+--------------------+---------------+-------------------+
21 24
32 14
43 80
81  5
81 45
   
#include <stdio.h>
#include <string.h>
#include "lj.h"
#include <math.h>
typedef enum boolean { false, true } boolean;

static  F1(realsvd){A u,v,w,z,*pvz;I m,n,t=0,mn;
  int svd();
  ASSERT((BOOL+INT+FL)&AT(y),EVDOMAIN);
  ASSERT(2==AR(y),EVRANK);
  if(FL!=AT(y))y=(A)cvt(FL,y);
  if((I)AS(y)[0]<(I)AS(y)[1]){y=(A)cant1(y);t=1;}
  mn=m= (I)AS(y)[0];
  n=(I)AS(y)[1];
  RZ(u=jma(FL,(n*mn),2L));
  RZ(v=jma(FL,(n*mn),2L));
  RZ(w=jma(FL,m,2L));
  ASSERT(!svd(m,n,mn,AV(y),AV(w),true,AV(u),true,AV(v)), EVDOMAIN);
  u=(A)reshape(v2(m,n),u);
  w=(A)reshape(v2(n,1),w);
  v=(A)reshape(v2(n,n),v);
  RZ(z=jma(BOX,3L,1L));
  z=(A)reshape(sc(3L),z);
  pvz=(A*)AV(z);
  if(!t){*pvz++=u;*pvz++=w;*pvz++=v; }
    else{*pvz++=v;*pvz++=w;*pvz++=u;}
  R z;
}

C jc (k, f1, f2) I k;
AF * f1, *f2;
{
  switch (k) {
    case 0: 
      *f1 = realsvd;		/* 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);
  }
}
