nametype.src

来自「没有说明」· SRC 代码 · 共 66 行

/*
** nametype.src
** (C) Copyright 1990-1998 by Aptech Systems, Inc.
** All Rights Reserved.
**
** This Software Product is PROPRIETARY SOURCE CODE OF APTECH
** SYSTEMS, INC.    This File Header must accompany all files using
** any portion, in whole or in part, of this Source Code.   In
** addition, the right to create such files is strictly limited by
** Section 2.A. of the GAUSS Applications License Agreement
** accompanying this Software Product.
**
** If you wish to distribute any portion of the proprietary Source
** Code, in whole or in part, you must first obtain written
** permission from Aptech Systems.
**
**> nametype
**
**  Purpose:    Returns a vector of names and types.  The case of the
**              names will reflect the types.
**
**  Format:     { vname,vtype } = nametype(vname,vtype);
**
**  Input:      vname    Nx1 character vector of variable names.
**
**              vtype    scalar or Nx1 vector of 1's and 0's to determine the
**                       type and therefore the case of the output vname. If
**                       this is scalar 0 or 1 it will be expanded to Nx1.  If
**                       -1 nametype will assume that vname follows the upper/
**                       lower case convention.
**
**  Output:     vname    Nx1 character vector of variable names of the correct
**                       case.
**
**              vtype    Nx1 vector of ones and zeros, 1 if variable is numeric,
**                       0 if character.
**
**  Globals:    None
*/

proc (2) = nametype(vname,vtype);
    local i,n;
    if rows(vtype) == 1;
        if vtype == -1;
            retp(vname,vartype(vname));
        elseif vtype;
            vname = upper(vname);
        else;
            vname = lower(vname);
        endif;
        vtype = zeros(rows(vname),1)+vtype;
    else;
        n = rows(vname);
        i = 1;
        do while i <= n;
            if vtype[i];
                vname[i] = upper(vname[i]);
            else;
                vname[i] = lower(vname[i]);
            endif;
            i = i+1;
        endo;
    endif;
    retp(vname,vtype);
endp;