NEW;

  /*  Program:      XPOutFmt.GP                                 */
  /*  Created:      11 July 1995 by Felix from FmtToQp.GP       */
  /*                                                            */
  /*  Last modified:                                            */
  /*    16 Oct 96   FJR Prints in short-line blocks - 20 years  */
  /*                    exceeds QPW import-line length limit    */
  /*                                                            */
  /*  Program to write out the output files from a XPRegxx.GP   */
  /*  run in a format readable to Quattro Pro (ie with text in  */
  /*  double quotes and numbers separated by commas).  Files    */
  /*  are written out with the .PRN extension so that QPro can  */
  /*  pick them up more easily.                                 */
  /*  This program produces files in a separate format to the   */
  /*  older program FmtToQp.GP,  which just formatted results   */
  /*  matrices.  This program groups all the names,  means,     */
  /*  coeffs,  tstats etc for each period in a multiperiod run  */
  /*  and displays them in blocks to save all that silly        */
  /*  re-arranging in QPW.                                      */


  /*  Column locations                                          */

  #DEFINECS NameCol 1
  #DEFINECS MeanCol 3
  #DEFINECS CoeffCol 4
  #DEFINECS ErrCol 5
  #DEFINECS StatCol 6
  #DEFINECS ProbCol 7


  /*  Format for names with added quote marks                   */

  LET NameFmt[2, 3] =  "\"-*lf\"," 8 8   "\"-*lf\"," 8 8;
  LET NameMask[1, 2] = 0 0;

  LET NumFmt[1, 3] = "*.*lf,", 8, 4;

  LET NameTop[1, 2] = "Group" "Variable";
  LET NumTop[1, 5] = "Mean" "Coeff" "Error" "T-stat" "T-prob";



  PROC (0) = PrintOut (names, means, coeffs, errors, tStats, tProbs);

    /*  Print out the various blocks                            */
    /*  In:                                                     */
    /*    names     Character matrix of variable names          */
    /*    means,  coeffs etc    Numeric matrices of results     */

    LOCAL nPeriods;
    LOCAL mask;
    LOCAL fmt;
    LOCAL years;


      nPeriods = COLS(means);
      years = SEQA(1,1,nPeriods)';
      mask = 0~0~ONES(1, nPeriods);
      fmt = ONES(nPeriods+2, 1) * NumFmt;
      fmt[1:2,.] = NameFmt;


      FORMAT /RDC 8, 0;

      PRINT "\"Means\",";
      PRINT " \"Group\", \"Variable\", " years;
      CALL PRINTFM(names~means, mask, fmt);
      PRINT;

      PRINT "\"Coefficients\",";
      PRINT " \"Group\", \"Variable\", " years;
      CALL PRINTFM(names~coeffs, mask, fmt);
      PRINT;

      PRINT "\"Standard errors\",";
      PRINT " \"Group\", \"Variable\", " years;
      CALL PRINTFM(names~errors, mask, fmt);
      PRINT;

      PRINT "\"T-stats\",";
      PRINT " \"Group\", \"Variable\", " years;
      CALL PRINTFM(names~tstats, mask, fmt);
      PRINT;

      PRINT "\"T-probabilities\",";
      PRINT " \"Group\", \"Variable\", " years;
      CALL PRINTFM(names~tprobs, mask, fmt);
      PRINT;


/************
      title = NameTop ~ (NumTop.*.ONES(1,nPeriods));
      CALL PRINTFM(title, NameMask[1], NameFmt[1,.]);
      PRINT;


      mask = ONES(1, COLS(title));
      mask[1:2] = 0~0;
      fmt = ONES(COLS(title), 1) * NumFmt;
      fmt[1:2,.] = NameFmt;

      CALL PRINTFM(names~means~coeffs~errors~tStats~tProbs, mask, fmt);
      PRINT;
      PRINT;
**************/


    ENDP;                                       /*  PrintOut    */



  PROC (0) = Go;

    /*  Main control procedure                                  */

    LOCAL inName;
    LOCAL rStart;
    LOCAL rEnd;
    LOCAL newData;
    LOCAL data;
    LOCAL breaks;
    LOCAL names;
    LOCAL means;
    LOCAL coeffs;
    LOCAL errors;
    LOCAL tStats;
    LOCAL tProbs;


      PRINT "Data file name: ";;
      inName = CONS;

      LOAD data = ^inName;
      inName = inName $+ ".PRN";
      PRINT "Data will be reformatted into " $inName;
      OUTPUT FILE = ^inName RESET;
      OUTWIDTH 256;


      /*  look for blank rows separating runs                   */

      breaks = data[.,NameCol].==data[.,StatCol];
      names = 0;


      rStart = 1;
      DO WHILE breaks[rStart];      /*  Move to first item      */
        rStart = rStart + 1;
      ENDO;


      DO WHILE rStart <= ROWS(breaks);

        rEnd = rStart+1;
        DO WHILE (rEnd<ROWS(breaks)) AND NOT breaks[rEnd];
          rEnd = rEnd + 1;
        ENDO;
        IF rEnd<ROWS(breaks);
          rEnd = rEnd-1;        /*  found zeros;  move back one */
        ENDIF;

        newData = 1;
        IF ROWS(names)==(rEnd-rStart+1);
          newData = names $/= data[rStart:rEnd,(NameCol):(NameCol+1)];
        ENDIF;

        IF newData;

          /*  New set of data - print out old lot (if any)      */

          IF names /= 0;
            CALL PrintOut (names, means, coeffs, errors, tStats, tProbs);
          ENDIF;

          names = data[rStart:rEnd,(NameCol):(NameCol+1)];
          means = data[rStart:rEnd,MeanCol];
          coeffs = data[rStart:rEnd,CoeffCol];
          errors = data[rStart:rEnd,ErrCol];
          tStats = data[rStart:rEnd,StatCol];
          tProbs = data[rStart:rEnd,ProbCol];

        ELSE;

          means = means ~ data[rStart:rEnd,MeanCol];
          coeffs = coeffs ~ data[rStart:rEnd,CoeffCol];
          errors = errors ~ data[rStart:rEnd,ErrCol];
          tStats = tStats ~ data[rStart:rEnd,StatCol];
          tProbs = tProbs ~ data[rStart:rEnd,ProbCol];

        ENDIF;

        rStart = rEnd + 2;      /*  skip any zero row           */

      ENDO;

      IF names /= 0;
        CALL PrintOut (names, means, coeffs, errors, tStats, tProbs);
      ENDIF;

      OUTPUT OFF;

    ENDP;                                       /*  Go          */



  /*                    M a i n   P r o g r a m                 */
  /*                    = = = = = = = = = = = =                 */



    CLOSEALL;
    DISABLE;

    Go;

    ENABLE;
    CLOSEALL;

 END;