File: gvec.cal

package info (click to toggle)
calc 2.15.1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 7,848 kB
  • sloc: ansic: 62,147; makefile: 7,664; sh: 503; awk: 74; sed: 7
file content (103 lines) | stat: -rw-r--r-- 2,899 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
/*
 * gvec - vectorize any single-input function or trailing operator
 *
 * This version accepts arbitrary number of arguments, but of course
 * they must all be same length vectors.
 *
 * The gvec function is for use in either a two-arg function or a two-arg
 * operation "function" must be first; calc doesn't care how many more
 * arguments there actually are.
 *
 * Under source code control:   2011/03/31 17:54:55
 * File existed as early as:    2010
 *
 * By Carl Witthoft carl at witthoft dot com
 */

define gvec(function, vector)
{
    local xlen,y,foo;
    local precx = 1e-50;        /* default for now */
    local argc = param(0)-1;
    local old_tilde;            /* previous config("tilde") */

    /*
     * parse args
     */
    local plist = mat[argc];
    if (config("resource_debug") & 8) {
        print "plist=", plist;
        print "argc=", argc;
    }
    for(local i = 0; i< argc; i++) {
        local ii = i + 2;
        if (config("resource_debug") & 8) {
            print "ii=", ii;
            print "param(" : ii : "}=", param(ii);
            print "size(param(" : ii : ")=", size(param(ii));
        }
        plist[i] = size(param(ii));
    }
    local slist=sort(plist);
    if (config("resource_debug") & 8) {
        print "plist=", plist;
    }
    local argm = argc-1;
    if (config("resource_debug") & 8) {
        print "argm=", argm;
    }
    if (slist[0] != slist[argm]) {
        quit "lengths don't match";
    }
    xlen = size(vector);
    y = mat[xlen];

    /*
     * We can't do str(vector[j]) outside loop, eval() petulantly refuses to
     * look at local variables.
     *
     * Also we need to config("tilde",0) to turn off lead tilde
     * (so str(vector[j]) looks like a number.
     */
    old_tilde = config("tilde",0);

    /*
     * Ok, now check to see if "function" is a function.  If not, it's an
     * operation and it's up to user to make it valid
     */
    if (isdefined(function)) {

        /* yep, it's a function, either builtin or user-defined */
        for (local j=0; j<xlen; j++) {

            /* build the function call */
            foo = strcat(function, "(");
            for (local jj = 0; jj<argc; jj++) {
                foo = strcat(foo , str(param(jj+2)[j]), ",");
            }
            foo = strcat(foo, str(precx), ")");
            if (config("resource_debug") & 8) {
                print "foo=", foo;
            }
            y[j] = eval(foo);
        }

    /*
     * it is an operator --  multi-argument operator makes no sense
     */
    } else {
        if (argc > 1) {
            quit "Error: operator can accept only one argument";
        }
        for (j=0; j<xlen; j++) {
            foo = strcat(str(vector[j]), function);
            y[j] = eval(foo);
        }
    }

    /* restore tilde mode if needed */
    config("tilde", old_tilde);

    /* return result */
    return y;
}