c_cpp/etc/calc/cal/gvec.cal

   1 /*
   2  * gvec - vectorize any single-input function or trailing operator
   3  *
   4  * This version accepts arbitrary number of arguments, but of course
   5  * they must all be same length vectors.
   6  *
   7  * The gvec function is for use in either a two-arg function or a two-arg
   8  * operation "function" must be first; calc doesn't care how many more
   9  * arguments there actually are.
  10  *
  11  * @(#) $Revision: 30.3 $
  12  * @(#) $Id: gvec.cal,v 30.3 2011/05/23 23:00:55 chongo Exp $
  13  * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/gvec.cal,v $
  14  *
  15  * Under source code control:   2011/03/31 17:54:55
  16  * File existed as early as:    2010
  17  *
  18  * By Carl Witthoft carl at witthoft dot com
  19  */
  20
  21 define gvec(function, vector)
  22 {
  23     local xlen,y,foo;
  24     local precx = 1e-50;        /* default for now */
  25     local argc = param(0)-1;
  26     local old_tilde;            /* previous config("tilde") */
  27
  28     /*
  29      * parse args
  30      */
  31     local plist = mat[argc];
  32     if (config("resource_debug") & 8) {
  33         print "plist=", plist;
  34         print "argc=", argc;
  35     }
  36     for(local i = 0; i< argc; i++) {
  37         local ii = i + 2;
  38         if (config("resource_debug") & 8) {
  39             print "ii=", ii;
  40             print "param(" : ii : "}=", param(ii);
  41             print "size(param(" : ii : ")=", size(param(ii));
  42         }
  43         plist[i] = size(param(ii));
  44     }
  45     local slist=sort(plist);
  46     if (config("resource_debug") & 8) {
  47         print "plist=", plist;
  48     }
  49     local argm = argc-1;
  50     if (config("resource_debug") & 8) {
  51         print "argm=", argm;
  52     }
  53     if (slist[0] != slist[argm]) {
  54         quit "lengths don't match";
  55     }
  56     xlen = size(vector);
  57     y = mat[xlen];
  58
  59     /*
  60      * We can't do str(vector[j]) outside loop, eval() petulantly refuses to
  61      * look at local variables.
  62      *
  63      * Also we need to config("tilde",0) to turn off lead tilde
  64      * (so str(vector[j]) looks like a number.
  65      */
  66     old_tilde = config("tilde",0);
  67
  68     /*
  69      * Ok, now check to see if "function" is a function.  If not, it's an
  70      * operation and it's up to user to make it valid
  71      */
  72     if (isdefined(function)) {
  73
  74         /* yep, it's a function, either builtin or user-defined */
  75         for (local j=0; j<xlen; j++) {
  76
  77             /* build the function call */
  78             foo = strcat(function, "(");
  79             for (local jj = 0; jj<argc; jj++) {
  80                 foo = strcat(foo , str(param(jj+2)[j]), ",");
  81             }
  82             foo = strcat(foo, str(precx), ")");
  83             if (config("resource_debug") & 8) {
  84                 print "foo=", foo;
  85             }
  86             y[j] = eval(foo);
  87         }
  88
  89     /*
  90      * it is an operator --  multi-argument operator makes no sense
  91      */
  92     } else {
  93         if (argc > 1) {
  94             quit "Error: operator can accept only one argument";
  95         }
  96         for (j=0; j<xlen; j++) {
  97             foo = strcat(str(vector[j]), function);
  98             y[j] = eval(foo);
  99         }
 100     }
 101
 102     /* restore tilde mode if needed */
 103     config("tilde", old_tilde);
 104
 105     /* return result */
 106     return y;
 107 }