dataxchn.src

来自「没有说明」· SRC 代码 · 共 1,159 行 · 第 1/3 页

SRC
1,159
字号
#ifDLLCALL

/*
** dataxchn.src
**
**
** (C) Copyright 1997-1999  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.
**
**-------------------**------------------**-------------------**-----------**
**-------------------**------------------**-------------------**-----------**
**
**  Format                                       Purpose             Line
** -----------------------------------------------------------------------
**    y = export(x,fname,namelist);              matrix export        35
**    y = exportf(dataset,fname,namelist);       data set export      35
**    {x,namelist} = import(fname,range,sheet);  matrix import       243
**    y = importf(fname,dataset,range,sheet);    data set import     243
*/

#include dataxchn.ext

/*
**> export/f
**
**  Purpose:  Exports a matrix or GAUSS data set to a spreadsheet, database,
**            or ASCII formatted file.
**
**  Format:   y = export(x, fname, namelist);
**  Format:   y = exportf(dataset, fname, namelist);
**
**  Input:   x          NxK matrix of data to be exported.
**           dataset    string, name of GAUSS data set to be exported.
**           fname      string, path and filename of target file
**           namelist   Kx1 character vector of names,
**                      or scalar 0 (for defaults).
**
**  Output:  y          scalar, 1 if successful,
**                              0 if not.
**
**  Globals: _dxftype   string, file type. The file type is normally
**                      taken from the filename extension; this can be
**                      overridden by specifying one of the file extensions
**                      listed below. Set to "" (empty string) to use
**                      file extensions.
**
**           _dxtype    scalar or Kx1 vector, column data type flags:
**                      1's for numeric data, 0's for character data.
**                      Use scalar if all columns are the same type.
**                      Default is scalar 1--all columns numeric.
**
**           _dxwidth   scalar or Kx1 vector of spreadsheet column widths
**                      in characters. Use scalar if all columns have the
**                      same width. Default is scalar 12.
**
**           _dxprcn    scalar or Kx1 vector of spreadsheet column precision
**                      (number of digits after the decimal). Use scalar if
**                      all columns have the same precision. Default is 4.
**
**           _dxtxdlim  scalar, ASCII value for character that delimits
**                      fields in ASCII files. (Tab = 9, comma = 44,
**                      space = 32 (default))
**
**           _dxaschdr  scalar, ASCII file column headers flag: 1 - write
**                      column names as headers, 0 - don't write. Default
**                      is 0.
**
**           _dxwkshdr  scalar, spreadsheet file column headers flag: 1 -
**                      write column names as headers, 0 - don't write.
**                      Default is 1.
**
**           _dxmiss    scalar, missing value representation. Default is
**                      standard GAUSS missing value (indefinite NaN).
**
**           _dxprint   scalar, 1 - print progress messages,
**                              0 - quiet. Default 1.
**
**  Remarks:
**       The following file types are supported:
**
**         "WKS"                  Lotus v1.0
**         "XLS"                  Excel v2.1
**         "WQ1"                  Quattro v1.0
**         "WRK"                  Symphony v1.0
**         "DB2"                  dBase II
**         "DBF"                  dBase III
**         "DB"                   Paradox v3.0
**         "CSV" "TXT" "ASC"      ASCII character delimited
**         "PRN"                  ASCII formatted
**         "DAT"                  GAUSS data set
**
**       The number of elements in namelist should conform to the number
**    of columns in X for a matrix transfer.
**
**       For a data set, if namelist = 0, all the vectors will be exported;
**     otherwise the subset of vectors named in namelist will be exported.
**
**       The elements of namelist will be inserted in the first row of each
**    column, unless _dxaschdr (ASCII files) or _dxwkshdr (spreadsheet files)
**    is set to 0.
**
**       Missing values will be written as blank cells to spreadsheets,
**    and as _dxmiss to ASCII files.
**
**   Examples:
**            fname = "c:\\temp\\tstdta.xls";
**            let names = gnp invest consump exports;
**            call export(x,fname,names);
**
**            fname = "c:\\temp\\tstdta.dbf";
**            dname = "c:\\gauss\\dat\\mydata.dat";
**            call exportf(dname,fname,0);
**
**      The first example exports a four column matrix (x) to an
**      Excel file. The second example takes a GAUSS data set and
**      creates a Dbase file.
**
*/

proc export(x, filename, namelist);
    local info, ftype, fmt, ncases, nvars, ret, errstr, names, _dxcolhdr, msg;

    if (type(x) == 13) ;    /* GAUSS data set */
        retp(exportf(x,filename,namelist));
    endif;

    call dx_header("GAUSS Data Export Facility");
    { ftype,_dxcolhdr } = dx_filetype(filename,1);
    if ismiss(ftype);
        retp(0);
    endif;
    ncases = rows(x);
    nvars = cols(x);
    info = ncases | nvars | ftype | _dxtxdlim | _dxcolhdr | _dxmiss;
    fmt = dx_makefmt(nvars,namelist);
    names = 0;

    if (ftype == 99) ;      /* GAUSS data set */
        if saved(x,filename,namelist);
            retp(1);
        else;
            errorlog "Error in creating GAUSS data set";
            retp(0);
        endif;
    endif;

    call dx_print("Begin export... " );
    if not dx_cmnd("open_w",x,info,fmt,filename,names);
        retp(0);
    endif;
    if not dx_cmnd("write",x,info,fmt,filename,names);
        retp(0);
    endif;
    if not dx_cmnd("close_w",x,info,fmt,filename,names);
        retp(0);
    endif;
    call dx_print("Export completed ");

    retp(1);

endp;

/**********************************************************************
**                   GAUSS data set export
***********************************************************************/

proc exportf(dataset,filename,namelist);

    local info, ftype, fmt, ncases, nvars, ret,nobs, errstr;
    local x, fixedasc, f1, dtalist, indx, nr, _dxcolhdr;

    call dx_header("GAUSS Data Export Facility");
    clear x, fixedasc;
    { ftype,_dxcolhdr } = dx_filetype(filename,1);
    if ismiss(ftype);
        retp(0);
    endif;
    if ftype == 91;
        fixedasc = 1;
    endif;
    if not dx_fileexist(dataset);
        retp(0);
    endif;
    open f1 = ^dataset;
    dtalist = getname(dataset);

    if namelist == 0;
        namelist = dtalist;
    elseif ismiss(indcv(upper(namelist),dtalist));
        errorlog "Elements of namelist do not exist on the GAUSS data set";
        retp(0);
    endif;

    ncases = rowsf(f1);
    nvars = rows(namelist);
    indx = indcv(upper(namelist),dtalist);
    fmt = dx_makefmt(nvars,namelist);
    info = ncases | nvars | ftype | _dxtxdlim | _dxcolhdr | _dxmiss;
    nobs = 0;

    call dx_print("Begin export... " );
    if not dx_cmnd("open_w",x, info, fmt, filename,0);
        retp(0);
    endif;
    nr = getnr(3,colsf(f1));
    do until eof(f1);
        x = readr(f1,nr);
        x = x[.,indx] ;
        info[1] = rows(x);
        nobs = nobs + rows(x);
        if not dx_cmnd("write",x,info,fmt,filename,0);
            retp(0);
        endif;
    endo;

    f1 = close(f1);
    if not dx_cmnd("close_w",x,info,fmt,filename,0);
        retp(0);
    endif;
    call dx_print("Export completed ");
    if _dxprint;
        print "Number of cases in GAUSS data set:             " ncases;
        print "Number of cases written to foreign file :     " nobs;
        print "Number of variables written to foreign file : " nvars;
    endif;

    retp(1);

endp;

/*
**> import/f
**
**  Purpose:  Copy data from a spreadsheet, database or ASCII file to
**            a GAUSS matrix or data set.
**
**  Format:   {x,namelist} = import(fname, range, sheet);
**                      y  = importf(fname,dataset,range, sheet);
**
**  Input:   fname      string, path and filename of source file.
**           dataset    string, path and filename of GAUSS data set.
**           range      string, range of cells for spreadsheets,
**                      descriptor for packed ASCII files, or scalar 0.
**                      Default is 0.
**           sheet      scalar, page or sheet number. Default is 1.
**
**  Output:  x          NxK matrix of data from spreadsheet.
**           namelist   Kx1 character vector of column names.
**           y          scalar, 1 if successful, 0 if not.
**
**  Globals: _dxftype   string, file type. The file type is normally
**                      taken from the filename extension; this can be
**                      overridden by specifying one of the file extensions
**                      listed below. Set to "" (empty string) to use
**                      file extensions.
**
**           _dxbuffer  Import buffer size in Mbytes. 1 Mbyte is approx
**                      131000 elements. If the data size exceeds
**                      this, you should increase _dxbuffer.
**
**           _dxtxdlim  For delimited ASCII files, scalar ASCII value
**                      of the character that delimits fields. (Tab = 9,
**                      comma = 44, space = 32 (default)). Not used
**                      in packed ASCII files.
**
**           _dxaschdr  scalar, ASCII file column headers flag: 1 - read
**                      column names as headers, 0 - don't read. Default
**                      is 0.
**
**           _dxwkshdr  scalar, row number of spreadsheet file column
**                      headers: 0 - no headers. Default is 1.
**
**           _dxmiss    scalar, missing value representation. Default is
**                      standard GAUSS missing value (indefinite NaN).
**
**           _dxprint   scalar, 1 - print progress messages (default),
**                              0 - quiet.
**
**  Remarks:
**       The following file types are supported:
**
**         "WKS" "WK1" "WK2"      Lotus v1-v2
**         "WK3" "WK4" "WK5"      Lotus v3-v5
**         "XLS"                  Excel v2.1-v7.0
**         "WQ1" "WQ2" "WB1"      Quattro v1-v6
**         "WRK"                  Symphony v1.0-1.1
**         "DB2"                  dBase II
**         "DBF"                  dBase III/IV, Foxpro, Clipper
**         "DB"                   Paradox
**         "CSV" "TXT" "ASC"      ASCII character delimited
**         "PRN"                  ASCII packed
**         "DAT"                  GAUSS data set
**
**       For spreadsheets, _dxwkshdr indicates the row to use for column
**       names; for no column names, set _dxwkshdr to 0.
**
**       For ASCII files, column names are assumed to exist if _dxaschdr is
**       set to 1.
**
**       Column names will be returned in namelist.
**
**       For spreadsheets, range indicates the columns to be imported, and
**       can be specified in the form "A1..X27" or "A1:X27". A range of 0
**       imports all data.
**
**       For packed ASCII files, range is a descriptor that defines field
**       name, type, width, and optionally precision. It is a single string
**       of the form:
**
**               name [type] fldspec [name [type] fldspec ...]
**
**       where:  name is the column name for the field. You can specify a
**                  set (e.g., x01-x09); the subsequent type and fldspec
**                  are applied to all columns in the set.
**               type is $ for a character field, and blank for a numeric
**                  field.
**               fldspec is either a column range (e.g., 5-8), a start
**                  column and field width (e.g., 5,4 or 5,4.2), or just a
**                  field width (e.g., 4 or 4.2). If only a field width is
**                  given, the start column is imputed from the previous
**                  field. If the field width is specified with a decimal
**                  (e.g., 4.2) then a decimal point will be inserted that
**                  many places in from the right edge of the field.
**
**       sheet is the spreadsheet page number, and is only supported
**       for spreadsheet formats. If sheet = 0, the first (possibly only)
**       page will be imported.
**
**       Spreadsheet cells that are #ERR or #N/A will be imported as GAUSS
**       missing values. Elements (from any format) that have the value
**       _dxmiss will be imported as GAUSS missing values.
**
**   Examples:
**            fname = "c:\\temp\\tstdta.xls";
**            range = "a2..g51";
**            {x,names} = import(fname,range,1);
**
**            fname = "c:\\temp\\tstdta.asc";
**            dname = "c:\\gauss\\dat\\mydata.dat";
**            call importf(fname,dname,0,0);
**
**            fname = "c:\\temp\\tstdta.asc";
**            schema = "var1 $ 6,2 var2 8-15 var3 18,4.1 gnp 7 cons 6.2
**                           xs1-xs20 2";
**            {x,names} = import(fname,schema,0);
**
**   The first example shows the creation of a GAUSS matrix x from an
**   Excel file, using the specified range. In the second example, a
**   GAUSS data set is created from a space delineated ASCII data set.
**   In the third example, a GAUSS matrix (x) is created from a packed
**   ASCII data set, using the descriptor shown.
**
*/

proc 2 = import(filename,range,sheet);
    local info, ftype, fmt, ncases, nvars, names, x, ret, errstr, srange,
        rngtype, bufsz, eofflag, actnobs, nobs, nmiss, ntot, _dxcolhdr,
        _dxascdlim, retcode;

    { ftype,srange,info,retcode } = dx_setimport(filename,sheet,range);
    if (retcode == 0);
        retp(0,0);
    endif;

    if (ftype == 99);       /* GAUSS data set */
        x = loadd(filename);
        x = miss(x,_dxmiss);
        names = getname(filename);
        call dx_print("Import completed ");
        retp(x,names);
    endif;

    bufsz = _dxbuffer*131072;
    names = zeros(255,1);
    fmt = srange;
    nmiss = 0;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?