plogy.src

没有说明

/*
** plogy.src - Publication Quality Graphics Support.
** (C) Copyright 1988-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.
**
**> logy
**
**  Purpose:    Graphs x vs y using log coordinates for the Y axis.
**
**  Format:     logy(x,y);
**
**  Inputs:     x    NxM or Nx1 matrix. Each column represents the
**                   x values for a particular line.
**
**              y    NxM or Nx1 matrix. Each column represents the
**                   y values for a particular line.
**
**  See Also:   xy, logx, logy, loglog, scale, xtics, ytics
*/

#include pgraph.ext

proc 0 = logy(x,y);
    local symbol,colorq,xformat,yformat,frame,msgstr,psym,psymnum,
        msgnum,n,k,sca,gcode,linenum,arrownum,arrow,c,t1,t2, msx,xlab,ylab,
        gridflag,errbnum,fontnum,pstype,pcolor,pltype,islog, psymsiz,
        plctrl,xinc,yinc,pline,pmsgctl,mem,fntsize,plwidth,plegctl,pnum,
        paxes,gpcpath;
    /* ------------------------------------------------------ */
    local minx,maxx,miny,maxy,qxsig,qxfield,qxprec,qxpow,qxorig,qxstep,
        qxmax,qxmint,qxlab,qypow,qymint;

    clear xlab,ylab;

    _pqgtype = { 3, 1 };    /* graph type logy, 2d */
    { frame,paxes,pnum,gpcpath } = _cmnfilt;

    qypow = 0;
    yformat = "";
    msgstr = "";

    /* ---- test input variables and take appropriate action ---- */

    /* create x variable if 0 */
    if rows(y) > 1 and rows(x)==1 and cols(x)==1;
        x = seqa(1,1,rows(y));
    endif;

    /* test x and y for rows */
    if rows(x) /= rows(y);
        errorlog "X and Y matrices must have the same number of rows.";
        end;
    endif;

    /* test x and y for cols */
    if cols(x) /= cols(y) and cols(x) /= 1 and cols(y) /= 1;
        errorlog "X and Y matrices not conformable.";
        end;
    endif;

    xinc = cols(x) /= 1;
    yinc = cols(y) /= 1;

    /* test for missings in x or y */
    if ismiss(x) or ismiss(y);
        errorlog "ERROR: There are missing values in the data.";
        end;
    endif;

    goto g00;

makestru:

        pop msx;
    c = 1;
    t1 = 1|0|0|0|0|0|0|0|0|0;
    do while c<=rows(msx);
        if strlen(msx[c,1]);
            t2 = vals(""$+msx[c,1]);
            t1 = t1|t2|zeros(10-rows(t2),1);
        else;
            t1 = t1|zeros(10,1);
        endif;
        c = c+1;
    endo;
    return(chrs(t1));

g00:

    /* Dimensions of data matrices. */
    if rows(y)==1 and cols(y)==1;
        n = 0;
        k = 0;
    else;
        n = rows(x);
        k = maxc(cols(x)|cols(y));
    endif;

    { minx,maxx } = _pcartx(_pworld,x);
    { miny,maxy } = _pcarty(_pworld,y);

    { qxsig,qxfield,qxprec,qxpow,qxorig,qxstep,qxmax,qxmint,qxlab } =
        _paxnum(pnum[1],minx,maxx,_pxsci,_pxscale,_pxpmax);

    if qxpow;
        x = x * 10^(-qxpow);
    endif;

    if not(_pascx $== 0);
        gosub makestru(_pascx);
            pop xlab;
        xformat = 0;
    elseif strlen(_pxfmt) < 2;
        xformat = "%1." $+ ftos(qxprec,"%*.*lf",1,0) $+ "lf";
    else;
        xformat = lower(_pxfmt);
    endif;

    islog = 2;

    /* put min, max into exponential representation */
    sca = qxorig|qxstep|qxmax | log(miny) | log(maxy);

    /* if YTICS or SCALE is used for log y axis, use _PSCALE min, max. */
    if rows(_pyscale) > 1;
        sca = qxorig|qxstep|qxmax | log(_pyscale[1]) | log(_pyscale[2]);
    endif;

    _setpage();

    if _pstype == 0;
        pstype = _pssel;
    else;
        pstype = _pstype;
    endif;

    if _pltype == 0;
        pltype = _plsel;
    else;
        pltype = _pltype;
    endif;

    if rows(_pcolor) == 1 and cols(_pcolor) == 1 and _pcolor == 0;
        pcolor = _pcsel;
    else;
        pcolor = _pcolor;
    endif;

    pstype = reshape(pstype,k,1)-1;
    psymsiz = reshape(_psymsiz,k,1);
    pltype = reshape(pltype,k,1);
    pcolor = reshape(pcolor,k,1);
    plctrl = reshape(_plctrl,k,1);
    plwidth = reshape(_plwidth,k,1);

    symbol = pstype~psymsiz~pltype~pcolor~plctrl~plwidth;

    { msgstr,msgnum,colorq } = _txtfilt;
    { pline,linenum,arrow,arrownum,psym,psymnum } = _linfilt;

    qymint = 2;

    if _pgrid $== 0;
        gridflag = 0|2|qxmint|qymint;
    else;
        gridflag = _pgrid[1 2]|qxmint|qymint;
    endif;

    /* Transpose data matrices */
    x = x';
    y = y';

    if cols(pline) > 1;
        linenum = rows(_pline);
        pline = _pline;
        c = 1;
        do until c > linenum;
            if pline[c,1] == 7;
                pline[c,4 6] = log(pline[c,4 6]);
            endif;
            c = c+1;
        endo;
    endif;

    if rows(_perrbar) == 1 and cols(_perrbar) == 1;
        errbnum = 0;
    elseif cols(_perrbar) /= 9;
        errorlog "Error bar matrix invalid";
        end;
    else;
        errbnum = rows(_perrbar);
    endif;

    plegctl = _plegctl;
    if plegctl[1] == 3;
        if qxpow;
            plegctl[3] = plegctl[3] * 10^(-qxpow);
        endif;
    endif;

    pmsgctl = _pmsgctl;
    if qxpow;
        { pline,pmsgctl,psym } = _pwrscal(qxpow,qypow,pline,pmsgctl,psym);
    endif;

    { fontnum,mem,fntsize } = _fontsiz();

#ifDLLCALL

    /* plog <=> 5 */

    GraphSEv3(x,y,k,n,xinc,yinc,sca,_ptitle,_pxlabel,_pylabel,_ptek,
        symbol,_pfonts,fontnum,fntsize,_pcross,gridflag,xformat,yformat,
        _pbox,paxes,msgstr,pmsgctl,msgnum,psym,psymnum,_paxht,_pnumht,
        _ptitlht, _pagesiz,_pageshf,_plotsiz,_plotshf,_protate,frame,pline,
        linenum, arrow,arrownum,xlab,ylab,colorq,_pdate,_perrbar,errbnum,
        qxpow,qypow, islog,pnum,_plegctl,_plegstr,_pnotify,_pappend,
        _pmargin, _pcwin,_pncwin,_pcrop,_pticout,gpcpath,5);

#ELSE

    /* load .GXE code */
    gcode = zeros(_pxmem+14710,1);
    loadexe gcode = plog.rex;

    /* call graphics code */
    ndpclex;
    callexe /r gcode(x,y,k,n,xinc,yinc,sca,_ptitle,_pxlabel,_pylabel,_ptek,
        symbol,_pfonts,fontnum,fntsize,_pcross,gridflag,xformat,yformat,
        _pbox,paxes,msgstr,pmsgctl,msgnum,psym,psymnum,_paxht,_pnumht,
        _ptitlht,_pagesiz,_pageshf,_plotsiz,_plotshf,_protate,frame,pline,
        linenum,arrow,arrownum,xlab,ylab,colorq,_pdate,_perrbar,errbnum,
        qxpow,qypow,islog,pnum,plegctl,_plegstr,_pnotify,_pappend,
        _pmargin,_pcwin,_pncwin,_pcrop,_pticout,gpcpath);

#ENDIF

    clear x,y,gcode;

    if _pscreen and _pnotify /= 2;
        _endgrph;
    endif;
endp;